diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for oauth2-jwt-bearer + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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} +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/oauth2-jwt-bearer.cabal b/oauth2-jwt-bearer.cabal new file mode 100644 --- /dev/null +++ b/oauth2-jwt-bearer.cabal @@ -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 + . +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 diff --git a/src/Network/OAuth2/JWT/Client.hs b/src/Network/OAuth2/JWT/Client.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/JWT/Client.hs @@ -0,0 +1,71 @@ +-- | +-- +-- This is an implementation of the jwt-bearer authorization grant +-- flow that is specified by the OAuth2 JWT profile in +-- . +-- +-- 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 diff --git a/src/Network/OAuth2/JWT/Client/AuthorizationGrant.hs b/src/Network/OAuth2/JWT/Client/AuthorizationGrant.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/JWT/Client/AuthorizationGrant.hs @@ -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 of +-- . +-- +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 +-- . +-- +-- The specific of the claims are defined by the OAuth2 +-- JWT Profile . +-- +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 diff --git a/src/Network/OAuth2/JWT/Client/Data.hs b/src/Network/OAuth2/JWT/Client/Data.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/JWT/Client/Data.hs @@ -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 diff --git a/src/Network/OAuth2/JWT/Client/Example.hs b/src/Network/OAuth2/JWT/Client/Example.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/JWT/Client/Example.hs @@ -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 diff --git a/src/Network/OAuth2/JWT/Client/Serial.hs b/src/Network/OAuth2/JWT/Client/Serial.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/JWT/Client/Serial.hs @@ -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'." diff --git a/test/Test/Network/OAuth2/JWT/Client/AuthorizationGrant.hs b/test/Test/Network/OAuth2/JWT/Client/AuthorizationGrant.hs new file mode 100644 --- /dev/null +++ b/test/Test/Network/OAuth2/JWT/Client/AuthorizationGrant.hs @@ -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) diff --git a/test/Test/Network/OAuth2/JWT/Client/TestServer.hs b/test/Test/Network/OAuth2/JWT/Client/TestServer.hs new file mode 100644 --- /dev/null +++ b/test/Test/Network/OAuth2/JWT/Client/TestServer.hs @@ -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 " forcing inet above.") diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -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