oauthenticated 0.1.3.4 → 0.2.0.0

raw patch · 9 files changed

+218/−123 lines, 9 filesdep +hspecdep +hspec-expectationsdep +http-client-tlsdep −eitherdep ~aesondep ~basedep ~base64-bytestringnew-uploader

Dependencies added: hspec, hspec-expectations, http-client-tls, oauthenticated

Dependencies removed: either

Dependency ranges changed: aeson, base, base64-bytestring, blaze-builder, bytestring, case-insensitive, crypto-random, cryptohash, exceptions, http-client, http-types, mtl, network, network-uri, text, time

Files

• oauthenticated.cabal +111/−80
• src/Network/OAuth/MuLens.hs +0/−1
• src/Network/OAuth/Signing.hs +17/−6
• src/Network/OAuth/Simple.hs +8/−18
• src/Network/OAuth/ThreeLegged.hs +15/−17
• src/Network/OAuth/Types/Params.hs +0/−1
• test/Config.hs +27/−0
• test/SigningSpec.hs +30/−0
• test/Spec.hs +10/−0

@@ -1,87 +1,118 @@-name:                oauthenticated-version:             0.1.3.4-synopsis:            Simple OAuth for http-client--description:         -  /Warning/: This software is pre 1.0 and thus its API may change very-  dynamically while updating only minor versions. This package will follow the-  PVP once it reaches version 1.0.-  .-  OAuth is a popular protocol allowing servers to offer resources owned by some-  user to a series of authorized clients securely. For instance, OAuth lets-  Twitter provide access to a user's private tweets to the Twitter client-  registered on their phone.-  . -  @oauthenticated@ is a Haskell library implementing OAuth protocols atop the-  minimalistic @http-client@ HTTP client library extracted from @http-conduit@.-  "Network.OAuth" offers simple functions for signing -  'Network.HTTP.Client.Request's along with tools for 'Network.OAuth.Cred'ential-  management and 'Network.OAuth.Server' configuration. "Network.OAuth.Simple" -  provides a slightly more heavy-weight interface which manages the necessary state-  and configuration using a monad transformer stack.-  .-  There's also an implementation of OAuth's three-legged credential acquisition-  protocol built atop the "Network.OAuth" API. This can be handled in both-  conformant and old-style modes: conformant will reject server responses which-  are not conformant with RFC 5849 (which builds atop community version OAuth-  1.0a) while old-style better allows for less-than-compliant servers. See-  'Network.OAuth.Types.Params.Version' for more details.-  .-  Currently @oauthenticated@ only supports OAuth 1.0 and is in alpha. OAuth 2.0-  support is a potential goal, but it's unclear if it can be transparently-  supported at a similar level of abstraction.+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 17b79e47a3f7b1729531b411a7a3e56766102b8aeb5e6ba09cdabd55c17d5d88 -license:             MIT-license-file:        LICENSE-author:              Joseph Abrahamson-maintainer:          me@jspha.com-copyright:           2013 (c) Joseph Abrahamson-category:            Network, Web-build-type:          Simple-cabal-version:       >=1.10+name:           oauthenticated+version:        0.2.0.0+synopsis:       Simple OAuth for http-client+description:    /Warning/: This software is pre 1.0 and thus its API may change very+                dynamically while updating only minor versions. This package will follow the+                PVP once it reaches version 1.0.+                .+                OAuth is a popular protocol allowing servers to offer resources owned by some+                user to a series of authorized clients securely. For instance, OAuth lets+                Twitter provide access to a user's private tweets to the Twitter client+                registered on their phone.+                .+                @oauthenticated@ is a Haskell library implementing OAuth protocols atop the+                minimalistic @http-client@ HTTP client library extracted from @http-conduit@.+                "Network.OAuth" offers simple functions for signing+                'Network.HTTP.Client.Request's along with tools for 'Network.OAuth.Cred'ential+                management and 'Network.OAuth.Server' configuration. "Network.OAuth.Simple"+                provides a slightly more heavy-weight interface which manages the necessary state+                and configuration using a monad transformer stack.+                .+                There's also an implementation of OAuth's three-legged credential acquisition+                protocol built atop the "Network.OAuth" API. This can be handled in both+                conformant and old-style modes: conformant will reject server responses which+                are not conformant with RFC 5849 (which builds atop community version OAuth+                1.0a) while old-style better allows for less-than-compliant servers. See+                'Network.OAuth.Types.Params.Version' for more details.+                .+                Currently @oauthenticated@ only supports OAuth 1.0 and is in alpha. OAuth 2.0+                support is a potential goal, but it's unclear if it can be transparently+                supported at a similar level of abstraction.+category:       Network, Web+homepage:       https://github.com/tel/oauthenticated.git#readme+bug-reports:    https://github.com/tel/oauthenticated.git/issues+author:         Joseph Abrahamson+maintainer:     me@jspha.com+copyright:      2013 (c) Joseph Abrahamson+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 -flag network-uri-  description: Get Network.URI from the network-uri package-  default: True+source-repository head+  type: git+  location: https://github.com/tel/oauthenticated.git  library+  hs-source-dirs:+      src+  ghc-options: -Wall -fwarn-tabs+  build-depends:+      aeson+    , base >=4.10 && <5+    , base64-bytestring+    , blaze-builder+    , bytestring+    , case-insensitive+    , crypto-random+    , cryptohash+    , exceptions+    , http-client+    , http-types+    , mtl+    , network+    , network-uri+    , text+    , time+    , transformers   exposed-modules:-    Network.OAuth-    Network.OAuth.Simple-    Network.OAuth.Signing-    Network.OAuth.ThreeLegged-    Network.OAuth.Types.Credentials-    Network.OAuth.Types.Params+      Network.OAuth+      Network.OAuth.Signing+      Network.OAuth.Simple+      Network.OAuth.ThreeLegged+      Network.OAuth.Types.Credentials+      Network.OAuth.Types.Params   other-modules:-    Network.OAuth.MuLens-    Network.OAuth.Util-  build-depends:       base                >= 4.6      && < 4.8-                     , aeson               >= 0.6.2    && < 0.9-                     , base64-bytestring   >= 1.0      && < 1.1-                     , blaze-builder       >= 0.3-                     , bytestring          >= 0.9-                     , case-insensitive    >= 1.0      && < 1.3-                     , crypto-random       >= 0.0.7-                     , cryptohash          >= 0.11     && < 0.12-                     , either              >= 4.0      && < 5.0-                     , exceptions          >= 0.4-                     , http-client         >= 0.2.0-                     , http-types          >= 0.8-                     , mtl                 >= 2.0-                     , time                >= 1.2-                     , text                >= 0.11     && < 1.3-                     , transformers--  if flag(network-uri)-    build-depends: network-uri >= 2.6, network >= 2.6-  else-    build-depends: network-uri < 2.6 , network < 2.6---  hs-source-dirs:      src         -  ghc-options:         -Wall-  default-language:    Haskell2010+      Network.OAuth.MuLens+      Network.OAuth.Util+  default-language: Haskell2010 -source-repository head-  type: git-  location: git://github.com/tel/oauthenticated.git+test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -Wall -fwarn-tabs+  build-depends:+      aeson+    , base >=4.10 && <5+    , base64-bytestring+    , blaze-builder+    , bytestring+    , case-insensitive+    , crypto-random+    , cryptohash+    , exceptions+    , hspec+    , hspec-expectations+    , http-client+    , http-client-tls+    , http-types+    , mtl+    , network+    , network-uri+    , oauthenticated+    , text+    , time+    , transformers+  other-modules:+      Config+      SigningSpec+      Paths_oauthenticated+  default-language: Haskell2010

@@ -21,7 +21,6 @@   (<&>), (&), (^.), (.~), (%~),   ) where -import           Control.Applicative import           Data.Functor.Identity import           Data.Functor.Constant 

@@ -36,7 +36,6 @@   ) where  import qualified Blaze.ByteString.Builder        as Blz-import           Control.Applicative import           Crypto.Hash.SHA1                (hash) import           Crypto.MAC.HMAC                 (hmac) import           Crypto.Random@@ -143,18 +142,29 @@     infix 8 -:     s -: v = (s, H.toQueryValue v) +    -- **NOTE** dfithian: It worked for my use case to move oauth_token into these params. From the+    -- PR:+    --+    -- I presume one very controversial thing I did was to move `oauth_token` into `workflowParams`.+    -- I came to this conclusion by skimming through the [RFC](https://tools.ietf.org/html/rfc5849)+    -- and deciding that since I only ever saw `oauth_token` in conjunction with either+    -- `oauth_callback` or `oauth_verifier` that they should go together. I'd be perfectly happy to+    -- instead pass in some function of the settings telling it whether or not to include+    -- `oauth_token` for a given request. Whatever the conclusion, the service I'm integrating to+    -- specifically does NOT want the `oauth_token` so that was the motivation.     workflowParams Standard = []     workflowParams (TemporaryTokenRequest callback) =-      [ "oauth_callback" -: callback ]+      [ "oauth_callback" -: callback+      , "oauth_token" -: (getResourceTokenDef credentials ^. key) ]     workflowParams (PermanentTokenRequest verifier) =-      [ "oauth_verifier" -: verifier ]+      [ "oauth_verifier" -: verifier+      , "oauth_token" -: (getResourceTokenDef credentials ^. key) ]    in      [ "oauth_version"          -: oAuthVersion     , "oauth_consumer_key"     -: (credentials ^. clientToken . key)     , "oauth_signature_method" -: signatureMethod-    , "oauth_token"            -: (getResourceTokenDef credentials ^. key)     , "oauth_timestamp"        -: timestamp     , "oauth_nonce"            -: nonce     ] ++ workflowParams workflow@@ -174,8 +184,8 @@  -- | Queries a 'C.Request' body and tries to interpret it as a set of OAuth -- valid parameters. It makes the assumption that if the body type is a--- streaming variety then it is /not/ a set of OAuth parameters---dropping this--- assumption would prevent this from being pure.+-- streaming variety or impure then it is /not/ a set of OAuth parameters---+-- dropping this assumption would prevent this from being pure. bodyParams :: C.Request -> H.Query bodyParams = digestBody . C.requestBody where   digestBody :: C.RequestBody -> H.Query@@ -184,6 +194,7 @@   digestBody (C.RequestBodyBuilder _ b) = H.parseQuery (Blz.toByteString b)   digestBody (C.RequestBodyStream  _ _) = []   digestBody (C.RequestBodyStreamChunked _) = []+  digestBody (C.RequestBodyIO _) = []    -- digestBody (Left (_, builder)) = H.parseQuery (Blz.toByteString builder)   -- digestBody (Right _) = []

@@ -59,11 +59,10 @@    ) where -import           Control.Applicative import qualified Control.Monad.Catch             as E import           Control.Monad.Reader import           Control.Monad.State-import           Control.Monad.Trans.Either+import           Control.Monad.Trans.Except import qualified Crypto.Random                   as R import qualified Data.ByteString.Lazy            as SL import qualified Network.HTTP.Client             as C@@ -186,29 +185,20 @@   :: (Functor m, MonadIO m, E.MonadCatch m) =>      C.Manager -> (URI -> m O.Verifier) ->      OAuthT O.Client m (Either TokenRequestFailure (O.Cred O.Permanent))-requestTokenProtocol man getVerifier = runEitherT $ do+requestTokenProtocol man getVerifier = runExceptT $ do   -- Most of the code here is very simple, except that it does a LOT of   -- exception lifting. Try to ignore the EitherT noise on the left side   -- of each line.-  tempResp <- liftE OnTemporaryRequest $ E.try (requestTemporaryToken man)-  ttok     <- upE BadTemporaryToken $ C.responseBody tempResp+  tempResp <- withExceptT OnTemporaryRequest $ ExceptT $ E.try (requestTemporaryToken man)+  ttok     <- withExceptT BadTemporaryToken $ ExceptT $ pure $ C.responseBody tempResp   upgradeE ttok $ do     verifier <- lift $ buildAuthorizationUrl >>= lift . getVerifier-    permResp <- liftE OnPermanentRequest $ E.try (requestPermanentToken man verifier)-    ptok     <- upE BadPermanentToken $ C.responseBody permResp +    permResp <- withExceptT OnPermanentRequest $ ExceptT $ E.try (requestPermanentToken man verifier)+    ptok     <- withExceptT BadPermanentToken $ ExceptT $ pure $ C.responseBody permResp     lift $ upgradeCred ptok   where-    -- These functions explain most of the EitherT noise. They're largely-    -- useful for lifting default EitherT responses up into the error type-    -- we want.-    mapE     :: Functor m => (e -> f) -> EitherT e m b -> EitherT f m b-    mapE f = bimapEitherT f id-    liftE    :: Functor m => (e -> f) -> m (Either e b) -> EitherT f m b-    liftE f = mapE f . EitherT-    upE      :: (Monad m, Functor m) => (e -> f) -> Either e b -> EitherT f m b-    upE f = liftE f . return     -- This is just 'upgrade' played out in the EitherT monad.     upgradeE :: (Monad m, Cred.ResourceToken ty') =>                 Cred.Token ty'-                -> EitherT e (OAuthT ty' m) a -> EitherT e (OAuthT ty m) a-    upgradeE tok = EitherT . upgrade tok . runEitherT+                -> ExceptT e (OAuthT ty' m) a -> ExceptT e (OAuthT ty m) a+    upgradeE tok = ExceptT . upgrade tok . runExceptT

@@ -30,8 +30,6 @@   requestTokenProtocol, requestTokenProtocol'   ) where -import           Control.Applicative-import           Control.Exception               as E import qualified Crypto.Random                   as R import qualified Data.ByteString.Lazy            as SL import           Data.Data@@ -78,9 +76,9 @@ -- callback URLs could not be parsed correctly. parseThreeLegged :: String -> String -> String -> P.Callback -> Maybe ThreeLegged parseThreeLegged a b c d =-  ThreeLegged <$> C.parseUrl a-              <*> C.parseUrl b-              <*> C.parseUrl c+  ThreeLegged <$> C.parseRequest a+              <*> C.parseRequest b+              <*> C.parseRequest c               <*> pure d  -- | Request a 'Temporary' 'Token' based on the parameters of@@ -171,18 +169,18 @@      -> IO (Maybe (O.Cred O.Permanent)) requestTokenProtocol' mset cr srv tl getVerifier = do   entropy <- R.createEntropyPool-  E.bracket (C.newManager mset) C.closeManager $ \man -> do-    let gen = (R.cprgCreate entropy :: R.SystemRNG)-    (respTempToken, gen') <- requestTemporaryToken cr srv tl man gen -    case C.responseBody respTempToken of-      Left _ -> return Nothing-      Right tok -> do-        let tempCr = O.temporaryCred tok cr-        verifier <- getVerifier $ buildAuthorizationUrl tempCr tl-        (respPermToken, _) <- requestPermanentToken tempCr srv verifier tl man gen'-        case C.responseBody respPermToken of-          Left _ -> return Nothing-          Right tok' -> return (Just $ O.permanentCred tok' cr)+  man <- C.newManager mset+  let gen = (R.cprgCreate entropy :: R.SystemRNG)+  (respTempToken, gen') <- requestTemporaryToken cr srv tl man gen +  case C.responseBody respTempToken of+    Left _ -> return Nothing+    Right tok -> do+      let tempCr = O.temporaryCred tok cr+      verifier <- getVerifier $ buildAuthorizationUrl tempCr tl+      (respPermToken, _) <- requestPermanentToken tempCr srv verifier tl man gen'+      case C.responseBody respPermToken of+        Left _ -> return Nothing+        Right tok' -> return (Just $ O.permanentCred tok' cr)  -- | Performs an interactive token request provided credentials, -- configuration, and a way to convert a user authorization 'URI' into

@@ -19,7 +19,6 @@  module Network.OAuth.Types.Params where -import           Control.Applicative import           Crypto.Random import qualified Data.ByteString                 as S import qualified Data.ByteString.Base64          as S64

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}++module Config where++import Crypto.Random (SystemRNG, cprgCreate, createEntropyPool)+import Network.HTTP.Client (Manager, newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.OAuth (Client, Cred, Server, Token (Token), clientCred, defaultServer)++data Config = Config+  { rng  :: SystemRNG+  , man  :: Manager+  , ser  :: Server+  , cred :: Cred Client+  , url  :: String+  }++loadConfig :: IO Config+loadConfig = do+  -- these are on the public internet so they're okay+  let cred = clientCred $ Token "RKCGzna7bv9YD57c" "D+EdQ-gs$-%@2Nu7"+      url = "https://postman-echo.com/oauth1"+      ser = defaultServer+  rng <- cprgCreate <$> createEntropyPool+  man <- newManager tlsManagerSettings+  pure $ Config {..}

@@ -0,0 +1,30 @@+{-# LANGUAGE RecordWildCards #-}++module SigningSpec where++import Control.Monad+import Network.HTTP.Client (httpLbs, parseRequest, responseStatus)+import Network.HTTP.Types (status200)+import Network.OAuth (oauth)+import Test.Hspec (Spec, describe, example, it)+import Test.Hspec.Expectations (shouldBe)++import Config (Config (Config, cred, man, rng, ser, url))++spec :: Config -> Spec+spec Config {..} = describe "signing" $ do+  it "authorizes a request" $ do+    req <- parseRequest url+    (signedReq, _) <- oauth cred ser req rng+    resp <- httpLbs signedReq man+    responseStatus resp `shouldBe` status200++  it "authorizes many requests" $ do+    req <- parseRequest url+    (_, resps) <- foldM (\ (gen, acc) next -> do+                            (signedReq, newGen) <- oauth cred ser next gen+                            resp <- httpLbs signedReq man+                            pure (newGen, resp:acc)+                        ) (rng, []) (replicate 100 req)+    forM_ resps $ \ resp ->+      example $ responseStatus resp `shouldBe` status200

@@ -0,0 +1,10 @@+import Test.Hspec (hspec)++import Config (loadConfig)+import qualified SigningSpec++main :: IO ()+main = do+  config <- loadConfig+  hspec $ do+    SigningSpec.spec config