oauth2-jwt-bearer (empty) → 0.0.1

raw patch · 13 files changed

+836/−0 lines, 13 filesdep +Spock-coredep +aesondep +asyncsetup-changed

Dependencies added: Spock-core, aeson, async, base, bytestring, cryptonite, hedgehog, http-client, http-client-tls, http-types, jose, lens, mmorph, network, oauth2-jwt-bearer, streaming-commons, text, time, transformers, transformers-bifunctors, unordered-containers, warp, x509, x509-store

Files

• ChangeLog.md +5/−0
• LICENSE +30/−0
• README.md +80/−0
• Setup.hs +2/−0
• oauth2-jwt-bearer.cabal +78/−0
• src/Network/OAuth2/JWT/Client.hs +71/−0
• src/Network/OAuth2/JWT/Client/AuthorizationGrant.hs +147/−0
• src/Network/OAuth2/JWT/Client/Data.hs +115/−0
• src/Network/OAuth2/JWT/Client/Example.hs +23/−0
• src/Network/OAuth2/JWT/Client/Serial.hs +40/−0
• test/Test/Network/OAuth2/JWT/Client/AuthorizationGrant.hs +138/−0
• test/Test/Network/OAuth2/JWT/Client/TestServer.hs +90/−0
• test/test.hs +17/−0

@@ -0,0 +1,5 @@+# Revision history for oauth2-jwt-bearer++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2018, HotelKilo++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mark Hibberd nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,80 @@+# oauth2-jwt-bearer++This is an implementation of the jwt-bearer authorization grant flow+that is specified by the OAuth2 JWT profile in+[rfc7523](https://tools.ietf.org/html/rfc7523).++The goal is to implement a portable implementation of this flow that+can be used against multiple servers. Its goal is to be pretty+general, and has been tested against the [Google Cloud Platform OAuth2+implementation](https://developers.google.com/identity/protocols/OAuth2ServiceAccount),+and the [Smith implementation](http://smith.st/) as well as a generic+test server, but there may be a way to go. If you find a server that+this implementation doesn't work with, let me know and I will add a+test and address it.++### Why?++OAuth2 / OIDC flows are complicated enough that it warrants having an+implementation to fall back on. The scope of this library is one+specific flow to make the implementation manageable. It would be nice+to have a complete set of flow implentations, but the reality is that+OAuth2 doesn't really offer much in the terms of interoperability - it+is about consistency/security, not about interchangable+implementations - this means that implementing everything at once is a+somewhat lost battle. Restricting ourselves to this specific flow+allows us to provide something useful and possible.++### Stability++This library is new, and should have the disclaimers that normally+comes with that, but the API should be stable and is currently in+production level usage. The library will be maintained going forward.+++### Example++A crude example:++```+{-# LANGUAGE OverloadedStrings #-}+module Network.OAuth2.JWT.Client.Example where++import           Crypto.JWT (JWK)+import           Network.OAuth2.JWT.Client+import           Network.HTTP.Client (Manager)+++example :: Manager -> JWK -> IO (Either GrantError AccessToken)+example manager key =  do+  let+    endpoint = TokenEndpoint "https://www.googleapis.com/oauth2/v4/token"+    iss = Issuer "example@example.org"+    scopes = [Scope "profile"]+    aud = Audience "https://www.googleapis.com/oauth2/v4/token"+    expiry = ExpiresIn 3600+    claims = Claims iss Nothing aud scopes expiry []+  store <- newStore manager endpoint claims key+  grant store+```++The key function here is the `grant` function which is what you call+to get your access token.++The `grant` function obtains an access token, if we have already+aquired one (and it is still valid) we will re-use that token, if we+don't already have a token or the token has expired, we go and ask for+a new one.++This operation is safe to call from multiple threads. If we are using+a current token reads will happen concurrently, If we have to go to+the network the request will be serialised so that only one request is+made for a new token.++The access token can be used as a bearer token in an `Authorization`+header. See the specification for more details but it would be+something like:++```+Authorization: Bearer ${ACCESS_TOKEN}+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,78 @@+name: oauth2-jwt-bearer+version: 0.0.1+synopsis: OAuth2 jwt-bearer client flow as per rfc7523+homepage: https://github.com/smith-security/oauth2-jwt-bearer+license:  BSD3+license-file: LICENSE+author: Mark Hibberd+maintainer: mth@smith.st+bug-reports: https://github.com/smith-security/oauth2-jwt-bearer/issues+copyright: (c) 2018, HotelKilo+category: Network+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >= 1.10+description:+  This is an implementation of the jwt-bearer authorization grant flow+  that is specified by the OAuth2 JWT profile in+  <https://tools.ietf.org/html/rfc7523 rfc7523>.+source-repository head+  type:     git+  location: git@github.com:smith-security/oauth2-jwt-bearer.git++library+  default-language: Haskell2010+  build-depends:+      aeson >= 1.0 && < 1.5+    , base >= 4.10 && < 5+    , bytestring == 0.10.*+    , http-client >= 0.5 && < 0.6+    , http-client-tls >= 0.2 && < 0.4+    , http-types == 0.*+    , lens == 4.*+    , text == 1.*+    , time == 1.*+    , transformers >= 0.4 && < 0.6+    , transformers-bifunctors == 0.*+    , unordered-containers == 0.2.*+    , jose == 0.7.*++  hs-source-dirs:+    src++  exposed-modules:+    Network.OAuth2.JWT.Client+    Network.OAuth2.JWT.Client.Data+    Network.OAuth2.JWT.Client.Example+    Network.OAuth2.JWT.Client.Serial+    Network.OAuth2.JWT.Client.AuthorizationGrant++test-suite test+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: test.hs+  hs-source-dirs: test+  build-depends:+      aeson+    , async+    , base >= 4.10 && < 5+    , bytestring+    , cryptonite+    , hedgehog == 0.6.*+    , http-client+    , http-client-tls+    , http-types+    , jose+    , mmorph == 1.*+    , network+    , oauth2-jwt-bearer+    , Spock-core+    , streaming-commons+    , text+    , warp+    , x509+    , x509-store++  other-modules:+    Test.Network.OAuth2.JWT.Client.TestServer+    Test.Network.OAuth2.JWT.Client.AuthorizationGrant

@@ -0,0 +1,71 @@+-- |+--+-- This is an implementation of the jwt-bearer authorization grant+-- flow that is specified by the OAuth2 JWT profile in+-- <https://tools.ietf.org/html/rfc7523 rfc7523>.+--+-- This module includes everything you should need to implement an+-- integration and obtain an access token.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import           Crypto.JWT (JWK)+-- > import           Network.OAuth2.JWT.Client+-- > import           Network.HTTP.Client (Manager)+--+-- The key function here is the 'grant' function which is what you call+-- to get your access token.+--+-- The 'grant' function obtains an access token, if we have already+-- aquired one (and it is still valid) we will re-use that token, if we+-- don't already have a token or the token has expired, we go and ask for+-- a new one.+--+-- > example :: Manager -> JWK -> IO (Either GrantError AccessToken)+-- > example manager key =  do+-- >   let+-- >     endpoint = TokenEndpoint "https://www.googleapis.com/oauth2/v4/token"+-- >     iss = Issuer "example@example.org"+-- >     scopes = [Scope "profile"]+-- >     aud = Audience "https://www.googleapis.com/oauth2/v4/token"+-- >     expiry = ExpiresIn 3600+-- >     claims = Claims iss Nothing aud scopes expiry []+-- >   store <- newStore manager endpoint claims key+-- >   grant store+--+-- This operation is safe to call from multiple threads. If we are using+-- a current token reads will happen concurrently, If we have to go to+-- the network the request will be serialised so that only one request is+-- made for a new token.+--+-- The access token can be used as a bearer token in an @Authorization@+-- header. See the specification for more details but it would be something+-- like:+--+-- @+-- Authorization: Bearer ${ACCESS_TOKEN}+-- @+--+--+module Network.OAuth2.JWT.Client (+  -- * Obtain an access token+    GrantError (..)+  , AccessToken (..)+  , grant++  -- * Claims+  , Issuer (..)+  , Scope (..)+  , Audience (..)+  , Subject (..)+  , ExpiresIn (..)+  , Claims (..)++  -- * Configuration+  , TokenEndpoint (..)+  , Store+  , newStore+  ) where++import Network.OAuth2.JWT.Client.Data+import Network.OAuth2.JWT.Client.AuthorizationGrant

@@ -0,0 +1,147 @@+-- |+-- Authorization grant flow implementation. You probably want 'Network.OAuth2.JWT.Client'.+--+{-# LANGUAGE OverloadedStrings #-}+module Network.OAuth2.JWT.Client.AuthorizationGrant (+    GrantError (..)+  , sign+  , refresh+  , local+  , grant+  ) where+++import qualified Control.Concurrent.MVar as MVar+import           Control.Lens ((.~), (&))+import           Control.Monad.IO.Class (MonadIO (..))+import           Control.Monad.Trans.Bifunctor (BifunctorTrans (..))+import           Control.Monad.Trans.Except (ExceptT (..), runExceptT)++import           Crypto.JWT (JWK, JWTError)+import qualified Crypto.JWT as JWT++import qualified Data.Aeson as Aeson+import           Data.Bifunctor as X (Bifunctor(..))+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.HashMap.Strict as HashMap+import           Data.String (IsString (..))+import           Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import           Data.Time (UTCTime)+import qualified Data.Time as Time++import           Network.OAuth2.JWT.Client.Data+import qualified Network.OAuth2.JWT.Client.Serial as Serial++import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types as HTTP++data GrantError =+    SerialisationGrantError Text+  | JWTGrantError JWT.JWTError+  | EndpointGrantError Text+  | StatusGrantError Int Text+    deriving (Eq, Show)++-- |+-- Obtain an access token, if we have already aquired one (and+-- it is still valid) we will re-use that token, if we don't+-- already have a token or the token has expired, we go and+-- ask for a new one.+--+-- This operation is safe to call from multiple threads. If we are+-- using a current token reads will happen concurrently, If we have to+-- go to the network the request will be serialised so that only one+-- request is made for a new token.+--+grant :: Store -> IO (Either GrantError AccessToken)+grant (Store manager endpoint claims jwk store) = do+  now <- Time.getCurrentTime+  t <- local now <$> MVar.readMVar store+  case t of+    Just token ->+      pure . Right $ token+    Nothing -> do+      MVar.modifyMVar store $ \state -> do+        case local now state of+          Just token ->+            pure (state, Right token)+          Nothing ->+            runExceptT (refresh now manager endpoint claims jwk) >>= \e -> case e of+               Left err ->+                 pure (state, Left err)+               Right (Response token expiry) ->+                 pure (HasToken token (Time.addUTCTime (getExpiresIn expiry) now), Right token)++-- |+-- Obtain an already aquired access token iff it is still valid.+--+local :: UTCTime -> TokenState -> Maybe AccessToken+local now state =+  case state of+    HasToken token time | now < time ->+      Just token+    HasToken _ _ ->+      Nothing+    NoToken ->+      Nothing++-- |+-- Request a new access token as per the specified claims.+--+-- This request is defined in <https://tools.ietf.org/html/rfc7523#section-2.1 2.1> of+-- <https://tools.ietf.org/html/rfc7523#section-2.1 rfc7523>.+--+refresh :: UTCTime -> HTTP.Manager -> TokenEndpoint -> Claims -> JWK -> ExceptT GrantError IO Response+refresh now manager endpoint claims jwk = do+  assertion <- firstT JWTGrantError $+    sign now claims jwk+  req <- ExceptT . pure . first (EndpointGrantError . Text.pack . show) $+    HTTP.parseRequest (Text.unpack . getTokenEndpoint $ endpoint)+  res <- liftIO $ flip HTTP.httpLbs manager $+    HTTP.urlEncodedBody [+        ("grant_type", "urn:ietf:params:oauth:grant-type:jwt-bearer")+      , ("assertion", getAssertion assertion)+      ] $ req { HTTP.requestHeaders = [+        ("Accept", "application/json")+      ] }+  case HTTP.statusCode . HTTP.responseStatus $ res of+    200 ->+      ExceptT . pure . first SerialisationGrantError $+        Serial.response (HTTP.responseBody res)+    status ->+      ExceptT . pure . Left $ StatusGrantError status (Text.decodeUtf8 . LazyByteString.toStrict . HTTP.responseBody $ res)++-- |+-- Sign a JWT with the specified claims and key.+--+-- The format and signature of the JWT are defined by+-- <https://tools.ietf.org/html/rfc7519 rfc7519>.+--+-- The specific of the claims are defined by the OAuth2+-- JWT Profile <https://tools.ietf.org/html/rfc7523 rfc7523>.+--+sign :: UTCTime -> Claims -> JWK -> ExceptT JWTError IO Assertion+sign now (Claims issuer subject audience scopes expires custom) jwk = do+  let+    format =+      fromString . Text.unpack++    header =+      JWT.newJWSHeader ((), JWT.RS256)+        & JWT.typ .~ Just (JWT.HeaderParam () "JWT")++    claims =+      JWT.emptyClaimsSet+        & JWT.claimIss .~ Just (format . getIssuer $ issuer)+        & JWT.claimSub .~ fmap (format . getSubject) subject+        & JWT.claimAud .~ Just (JWT.Audience [format . getAudience $ audience])+        & JWT.claimIat .~ Just (JWT.NumericDate now)+        & JWT.claimExp .~ Just (JWT.NumericDate $ Time.addUTCTime (getExpiresIn expires) now)+        & JWT.unregisteredClaims .~ (HashMap.fromList $ [+            ("scope", Aeson.toJSON . Text.intercalate " " $ getScope <$> scopes)+          ] ++ custom)++  signed <- JWT.signClaims jwk header claims+  pure . Assertion . LazyByteString.toStrict . JWT.encodeCompact $ signed

@@ -0,0 +1,115 @@+-- |+-- Data types. You probably want 'Network.OAuth2.JWT.Client'.+--+module Network.OAuth2.JWT.Client.Data (+  -- * Claims+    Issuer (..)+  , Scope (..)+  , Audience (..)+  , Subject (..)+  , Claims (..)++  -- * Configuration+  , TokenEndpoint (..)++  -- * Protocol+  , Assertion (..)+  , AccessToken (..)+  , ExpiresIn (..)+  , Response (..)++  -- * Client State+  , TokenState (..)+  , Store (..)+  , newStore+  ) where++import           Crypto.JWT (JWK)+import           Control.Concurrent.MVar (MVar)+import qualified Control.Concurrent.MVar as MVar++import qualified Data.Aeson as Aeson+import           Data.ByteString (ByteString)+import           Data.Text (Text)+import           Data.Time (NominalDiffTime, UTCTime)++import qualified Network.HTTP.Client as HTTP+++-- Claims --++newtype Issuer =+  Issuer {+      getIssuer :: Text+    } deriving (Eq, Ord, Show)++newtype Scope =+  Scope {+      getScope :: Text+    } deriving (Eq, Ord, Show)++newtype Audience =+  Audience {+      getAudience :: Text+    } deriving (Eq, Ord, Show)++newtype Subject =+  Subject {+      getSubject :: Text+    } deriving (Eq, Ord, Show)++data Claims =+  Claims {+      claimsIssuer :: Issuer+    , claimsSubject :: Maybe Subject+    , claimsAudience :: Audience+    , claimsScopes :: [Scope]+    , claimsExpires :: ExpiresIn+    , claimsCustom :: [(Text, Aeson.Value)]+    } deriving (Eq, Show)+++-- Configuration --++newtype TokenEndpoint =+  TokenEndpoint {+      getTokenEndpoint :: Text+    } deriving (Eq, Ord, Show)+++-- Protocol --++newtype Assertion =+  Assertion {+      getAssertion :: ByteString+    } deriving (Eq, Ord, Show)++newtype AccessToken =+  AccessToken {+      renderAccessToken :: Text+    } deriving (Eq, Ord, Show)++newtype ExpiresIn =+  ExpiresIn {+      getExpiresIn :: NominalDiffTime+    } deriving (Eq, Ord, Show)++data Response =+  Response {+      responseToken :: AccessToken+    , responseExpiry :: ExpiresIn+    } deriving (Eq, Ord, Show)+++-- Client State --++data TokenState =+    NoToken+  | HasToken AccessToken UTCTime++data Store =+  Store HTTP.Manager TokenEndpoint Claims JWK (MVar TokenState)++newStore :: HTTP.Manager -> TokenEndpoint -> Claims -> JWK -> IO Store+newStore manager endpoint claims jwk =+  Store manager endpoint claims jwk <$> MVar.newMVar NoToken

@@ -0,0 +1,23 @@+-- |+-- Example, this is mainly for ensuring example compiles. You probably+-- want 'Network.OAuth2.JWT.Client'.+--+{-# LANGUAGE OverloadedStrings #-}+module Network.OAuth2.JWT.Client.Example where++import           Crypto.JWT (JWK)+import           Network.OAuth2.JWT.Client+import           Network.HTTP.Client (Manager)+++example :: Manager -> JWK -> IO (Either GrantError AccessToken)+example manager key =  do+  let+    endpoint = TokenEndpoint "https://www.googleapis.com/oauth2/v4/token"+    iss = Issuer "example@example.org"+    scopes = [Scope "profile"]+    aud = Audience "https://www.googleapis.com/oauth2/v4/token"+    expiry = ExpiresIn 3600+    claims = Claims iss Nothing aud scopes expiry []+  store <- newStore manager endpoint claims key+  grant store

@@ -0,0 +1,40 @@+-- |+-- Serialisation of token response. You probably want 'Network.OAuth2.JWT.Client'.+--+{-# LANGUAGE OverloadedStrings #-}+module Network.OAuth2.JWT.Client.Serial (+    response+  , parser+  ) where++import           Control.Monad (when)++import           Data.Aeson ((.:))+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import           Data.Bifunctor as X (Bifunctor(..))+import qualified Data.ByteString.Lazy as LazyByteString+import           Data.Text (Text)+import qualified Data.Text as Text++import           Network.OAuth2.JWT.Client.Data+++response :: LazyByteString.ByteString -> Either Text Response+response bytes =+  first Text.pack (Aeson.eitherDecode bytes) >>= \a' -> case Aeson.parse parser a' of+    Aeson.Success a -> pure a+    Aeson.Error msg -> Left . Text.pack $ msg++parser :: Aeson.Value -> Aeson.Parser Response+parser =+  Aeson.withObject "Response" $ \o ->+    Response+      <$> (fmap AccessToken $ o .: "access_token")+      <*> (fmap ExpiresIn $ o .: "expires_in")+      <* (o .: "token_type" >>= tokenType)++tokenType :: Text -> Aeson.Parser ()+tokenType t =+  when (t /= "Bearer") $+    fail "Unknown 'token_type' expected: 'Bearer'."

@@ -0,0 +1,138 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Test.Network.OAuth2.JWT.Client.AuthorizationGrant where++import           Control.Monad.IO.Class (MonadIO (..))++import qualified Crypto.JWT as JWT+import qualified Crypto.PubKey.RSA as Cryptonite++import           Data.Aeson ((.:))+import qualified Data.Aeson as Aeson+import qualified Data.ByteString as ByteString+import qualified Data.Maybe as Maybe+import           Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Text.IO as Text+import qualified Data.X509 as X509+import qualified Data.X509.Memory as X509++import           Hedgehog++import           Network.OAuth2.JWT.Client+import qualified Network.HTTP.Client.TLS as HTTP+import qualified Network.HTTP.Client as HTTP++import           System.IO (IO)+import qualified System.Environment as Environment++import qualified Test.Network.OAuth2.JWT.Client.TestServer as TestServer+++prop_success :: Property+prop_success =+  withTests 1 . property $ do+    token <- TestServer.withServer [] $ \endpoint -> do+      (_public, private) <- Cryptonite.generate 512 0x10001+      manager <- HTTP.newManager HTTP.tlsManagerSettings+      let+        iss = Issuer "iss"+        scopes = [Scope "profile"]+        aud = Audience "aud"+        expiry = ExpiresIn 3600+        claims = Claims iss Nothing aud scopes expiry []+        jwk = JWT.fromRSA private+      store <- newStore manager endpoint claims jwk+      grant store+    token === Right (AccessToken "default-token-3600")++prop_cache :: Property+prop_cache =+  withTests 1 . property $ do+    (token1, token2) <- TestServer.withServer [TestServer.good 3600 "a", TestServer.good 3600 "b"] $ \endpoint -> do+      (_public, private) <- Cryptonite.generate 512 0x10001+      manager <- HTTP.newManager HTTP.tlsManagerSettings+      let+        iss = Issuer "iss"+        scopes = [Scope "profile"]+        aud = Audience "aud"+        expiry = ExpiresIn 3600+        claims = Claims iss Nothing aud scopes expiry []+        jwk = JWT.fromRSA private+      store <- newStore manager endpoint claims jwk+      (,) <$> grant store <*> grant store+    token1 === Right (AccessToken "a")+    token1 === token2++prop_refresh :: Property+prop_refresh =+  withTests 1 . property $ do+    (token1, token2) <- TestServer.withServer [TestServer.good 0 "a", TestServer.good 3600 "b"] $ \endpoint -> do+      (_public, private) <- Cryptonite.generate 512 0x10001+      manager <- HTTP.newManager HTTP.tlsManagerSettings+      let+        iss = Issuer "iss"+        scopes = [Scope "profile"]+        aud = Audience "aud"+        expiry = ExpiresIn 0+        claims = Claims iss Nothing aud scopes expiry []+        jwk = JWT.fromRSA private+      store <- newStore manager endpoint claims jwk+      (,) <$> grant store <*> grant store+    token1 === Right (AccessToken "a")+    token2 === Right (AccessToken "b")++data ServiceAccountKey =+  ServiceAccountKey {+      clientEmail :: Text+    , clientId :: Text+    , privateKeyId :: Text+    , privateKey :: Text+    } deriving (Eq, Ord, Show)++instance Aeson.FromJSON ServiceAccountKey where+  parseJSON =+    Aeson.withObject "ServiceAccountKey" $ \o ->+      ServiceAccountKey+        <$> o .: "client_email"+        <*> o .: "client_id"+        <*> o .: "private_key_id"+        <*> o .: "private_key"++prop_google :: Property+prop_google =+  withTests 1 . property $ do+    e <- liftIO $ Environment.lookupEnv "GOOGLE_CREDENTIALS_JSON"+    case e of+      Nothing ->+        success+      Just file -> do+        manager <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings+        blob <- liftIO $ ByteString.readFile file+        key <- evalEither  $ Aeson.eitherDecodeStrict blob+        jwk <- case Maybe.listToMaybe . X509.readKeyFileFromMemory . Text.encodeUtf8 . privateKey $ key of+          Just (X509.PrivKeyRSA k) ->+            pure $ JWT.fromRSA k+          _ ->+            failure+        let+          endpoint = TokenEndpoint "https://www.googleapis.com/oauth2/v4/token"+          iss = Issuer (clientEmail key)+          scopes = [Scope "profile"]+          aud = Audience "https://www.googleapis.com/oauth2/v4/token"+          expiry = ExpiresIn 3600+          claims = Claims iss Nothing aud scopes expiry []+        store <- liftIO $ newStore manager endpoint claims jwk+        token <- liftIO (grant store) >>= evalEither+        liftIO $+          Text.putStrLn "=== BEGIN TOKEN ==="+        liftIO $+          Text.putStrLn . Text.pack . show $ token+        liftIO $+          Text.putStrLn "=== END TOKEN ==="+++tests :: IO Bool+tests =+  checkParallel $$(discover)

@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Test.Network.OAuth2.JWT.Client.TestServer (+    good+  , good3600+  , bad+  , withServer+  , withServerIO+  ) where++import           Control.Exception (bracket)+import qualified Control.Concurrent.Async as Async+import           Control.Monad.IO.Class (MonadIO (..))++import           Data.IORef (IORef)+import qualified Data.IORef as IORef+import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Aeson ((.=))+import qualified Data.Aeson as Aeson+import qualified Data.Streaming.Network as Network++import           Hedgehog++import           Network.OAuth2.JWT.Client+import qualified Network.Socket as Socket+import qualified Network.Wai.Handler.Warp as Warp++import qualified Network.HTTP.Types as HTTP++import qualified Web.Spock.Core as Spock++good :: Int -> Text -> (HTTP.Status, Aeson.Value)+good expires token =+  (HTTP.status200, Aeson.object [+      "token_type" .= ("Bearer" :: Text)+    , "expires_in" .= expires+    , "access_token" .= token+    ])++good3600 :: (HTTP.Status, Aeson.Value)+good3600 =+  good 3600 "default-token-3600"++bad :: (HTTP.Status, Aeson.Value)+bad =+  (HTTP.status400, Aeson.object [+      "error" .= ("invalid_grant" :: Text)+    ])++routes :: IORef [(HTTP.Status, Aeson.Value)] -> Spock.SpockT IO ()+routes responses = do+  Spock.post "oauth/token" $ do+    mflow <- Spock.param "grant_type"+    massertion <- Spock.param "assertion"+    case (massertion, mflow) of+      (Just _assertion, Just "urn:ietf:params:oauth:grant-type:jwt-bearer") -> do+        (status, response) <- liftIO $ IORef.atomicModifyIORef responses $ \rs -> case rs of+          [] ->+            ([], good3600)+          (x:xs) ->+            (xs, x)+        Spock.setStatus status+        Spock.json response+      (_ :: Maybe Text, _ :: Maybe Text) -> do+        Spock.setStatus HTTP.status400+        Spock.json $ Aeson.object [+            "error" .= ("invalid_grant" :: Text)+          ]++withServer :: (MonadIO m, MonadTest m) => [(HTTP.Status, Aeson.Value)] -> (TokenEndpoint -> IO a) -> m a+withServer responses =+  evalIO . withServerIO responses++withServerIO :: [(HTTP.Status, Aeson.Value)] -> (TokenEndpoint -> IO a) -> IO a+withServerIO responses testing = do+  r <- IORef.newIORef responses+  app <- Spock.spockAsApp $ Spock.spockConfigT Spock.defaultSpockConfig id (routes r)+  Socket.withSocketsDo $+    bracket+      (Network.bindPortTCP 0 "127.0.0.1")+      Socket.close+      (\socket -> do+        name <- Socket.getSocketName socket+        case name of+          Socket.SockAddrInet port _ -> do+            Async.withAsync (Warp.runSettingsSocket Warp.defaultSettings socket app) $ \_ -> do+              testing . TokenEndpoint . mconcat $ ["http://localhost:", Text.pack . show $ port, "/oauth/token"]+          _ -> do+            error "<invariant> forcing inet above.")

@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-}++import           Control.Monad ((>>=), (>>), when, mapM)++import           Prelude (($), (.), not, all, id)++import qualified System.Exit as Exit+import           System.IO (IO)+import qualified System.IO as IO++import qualified Test.Network.OAuth2.JWT.Client.AuthorizationGrant++main :: IO ()+main =+  IO.hSetBuffering IO.stdout IO.LineBuffering >> mapM id [+      Test.Network.OAuth2.JWT.Client.AuthorizationGrant.tests+    ] >>= \rs -> when (not . all id $ rs) Exit.exitFailure