diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,21 @@ # Revision History for `openid-connect` +## Version 0.2.0 (February 17, 2023) + + * Due to breaking changes in the `jose` package: + + - Versions before 0.10 are no longer supported + + - Orphan instances of `MonadRandom` were removed from `jose` so + you may need to create your own `Monad` that implements + `MonadRandom` + + * Tolerate non-standard client authentication methods in discovery + documents via a new constructor (@ondrap) + + * Allow access to the ID token (JWT) so you can log out of a session + (`authenticationSuccessWithJwt`) (@ondrap) + ## Version 0.1.0 (March 25, 2020) Initial release. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2020-2022 Peter J. Jones +Copyright (c) 2020-2023 Peter J. Jones All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/openid-connect.cabal b/openid-connect.cabal --- a/openid-connect.cabal +++ b/openid-connect.cabal @@ -1,15 +1,15 @@ cabal-version: 2.2 name: openid-connect -version: 0.1.2 +version: 0.2.0 license: BSD-2-Clause license-file: LICENSE author: Peter Jones maintainer: Peter Jones -copyright: Copyright (c) 2020-2022 Peter Jones +copyright: Copyright (c) 2020-2023 Peter Jones homepage: https://github.com/pjones/openid-connect bug-reports: https://github.com/pjones/openid-connect/issues category: Network -tested-with: GHC ==8.10.7 || ==9.0.2 +tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.5 || ==9.4.4 synopsis: An OpenID Connect library that does all the heavy lifting for you @@ -79,22 +79,22 @@ -------------------------------------------------------------------------------- common dependencies build-depends: - , aeson >=1.3 && <2.1 - , base >=4.9 && <5.0 - , bytestring >=0.10 && <0.12 + , aeson >=1.3 && <2.2 + , base >=4.9 && <5.0 + , bytestring >=0.10 && <0.12 , case-insensitive ^>=1.2 , containers ^>=0.6 , cookie ^>=0.4 - , cryptonite >=0.25 && <1.0 - , http-client >=0.6 && <0.8 + , cryptonite >=0.25 && <1.0 + , http-client >=0.6 && <0.8 , http-types ^>=0.12 - , jose >=0.8 && <0.10 - , lens >=4.0 && <5.2 - , memory >=0.14 && <1.0 - , mtl >=2.2 && <2.4 - , network-uri >=2.6 && <2.8 - , text >=1.2 && <2.1 - , time >=1.8 && <2.0 + , jose >=0.10 && <0.11 + , lens >=4.0 && <5.3 + , memory >=0.14 && <1.0 + , mtl >=2.2 && <2.4 + , network-uri >=2.6 && <2.8 + , text >=1.2 && <2.1 + , time >=1.8 && <2.0 , unordered-containers ^>=0.2 -------------------------------------------------------------------------------- @@ -151,7 +151,7 @@ main-is: Main.hs build-depends: , openid-connect - , tasty >=1.1 && <1.5 + , tasty >=1.1 && <1.5 , tasty-hunit ^>=0.10 other-modules: diff --git a/src/OpenID/Connect/Authentication.hs b/src/OpenID/Connect/Authentication.hs --- a/src/OpenID/Connect/Authentication.hs +++ b/src/OpenID/Connect/Authentication.hs @@ -26,13 +26,16 @@ -------------------------------------------------------------------------------- -- Imports: +import Control.Applicative ((<|>)) import Crypto.JOSE.JWK (JWK) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson import Data.ByteString (ByteString) import Data.Text (Text) import GHC.Generics (Generic) import Network.HTTP.Types (QueryItem) import qualified Network.URI as Network -import OpenID.Connect.JSON +import OpenID.Connect.JSON (FromJSON, ToJSON, aesonOptions) import OpenID.Connect.Scope -------------------------------------------------------------------------------- @@ -181,5 +184,23 @@ -- does not use the Token Endpoint) or because it is a Public -- Client with no Client Secret or other authentication mechanism. + | UnsupportedAuthentication Text + -- ^ Other unsupported possible ways to autenticate the client. + -- + -- @since 0.2.0 + deriving stock (Generic, Eq, Show) - deriving (ToJSON, FromJSON) via GenericJSON ClientAuthentication + +clientAuthAesonOptions :: Aeson.Options +clientAuthAesonOptions = aesonOptions{ Aeson.sumEncoding = Aeson.UntaggedValue } + +instance ToJSON ClientAuthentication where + toJSON (UnsupportedAuthentication txt) = Aeson.String txt + toJSON a = Aeson.genericToJSON clientAuthAesonOptions a + +instance FromJSON ClientAuthentication where + parseJSON v@(Aeson.String txt) = + Aeson.genericParseJSON clientAuthAesonOptions v + <|> pure (UnsupportedAuthentication txt) + parseJSON v = + Aeson.prependFailure "parsing ClientAuthentication failed, " (Aeson.typeMismatch "String" v) diff --git a/src/OpenID/Connect/Client/Authentication.hs b/src/OpenID/Connect/Client/Authentication.hs --- a/src/OpenID/Connect/Client/Authentication.hs +++ b/src/OpenID/Connect/Client/Authentication.hs @@ -24,7 +24,6 @@ -------------------------------------------------------------------------------- -- Imports: import Control.Lens ((&), (?~), (.~), (^?), (#)) -import Control.Monad.Except import qualified Crypto.JOSE.Compact as JOSE import qualified Crypto.JOSE.Error as JOSE import Crypto.JOSE.JWK (JWK) @@ -97,7 +96,7 @@ signWithKey :: JWK -> HTTP.Request -> m (Maybe HTTP.Request) signWithKey key req = do claims <- makeClaims <$> makeJti - res <- runExceptT $ do + res <- JWT.runJOSE $ do alg <- JWK.bestJWSAlg key JWT.signClaims key (JWT.newJWSHeader ((), alg)) claims case res of diff --git a/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs b/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs --- a/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs +++ b/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs @@ -37,6 +37,7 @@ -- * Flow authenticationRedirect , authenticationSuccess + , authenticationSuccessWithJwt , RedirectTo(..) -- * Authentication settings @@ -88,7 +89,7 @@ import OpenID.Connect.Client.Provider import OpenID.Connect.JSON import OpenID.Connect.Scope -import OpenID.Connect.TokenResponse (TokenResponse) +import OpenID.Connect.TokenResponse (TokenResponse (idToken)) import Web.Cookie (SetCookie) import qualified Web.Cookie as Cookie @@ -315,10 +316,27 @@ -> Credentials -> UserReturnFromRedirect -> m (Either FlowError (TokenResponse ClaimsSet)) -authenticationSuccess https time (Provider disco keys) creds user = runExceptT $ do +authenticationSuccess https time provider creds user = + fmap (fmap fst) <$> authenticationSuccessWithJwt https time provider creds user + +-- | Same as 'authenticationSuccess' but return also the original id_token as SignedJWT. +-- +-- Some endpoints (e.g. the end_session_endpoint) may require the original +-- id_token; this functions allows an application to save it for later use. +-- +-- @since 0.2.0 +authenticationSuccessWithJwt + :: MonadRandom m + => HTTPS m + -> UTCTime + -> Provider + -> Credentials + -> UserReturnFromRedirect + -> m (Either FlowError (TokenResponse (ClaimsSet, SignedJWT))) +authenticationSuccessWithJwt https time (Provider disco keys) creds user = runExceptT $ do _ <- ExceptT (pure (verifyPostRedirectRequest user)) token <- ExceptT (exchangeCodeForIdentityToken https time disco creds user) - ExceptT (pure (extractClaimsSetFromTokenResponse disco creds token keys time user)) + ExceptT (pure (fmap (, idToken token) <$> extractClaimsSetFromTokenResponse disco creds token keys time user)) -------------------------------------------------------------------------------- -- | Create the provider authorization redirect URI for the end-user. @@ -399,10 +417,9 @@ req <- maybe (throwError (InvalidProviderTokenEndpointError (uriToText (getURI uri)))) pure (requestFromURI (Right (getURI uri))) - applyRequestAuthentication creds authMethods - uri now body req >>= \case - Nothing -> throwError NoAuthenticationMethodsAvailableError - Just r -> lift (https r) + lift (applyRequestAuthentication creds authMethods uri now body req) >>= \case + Nothing -> throwError NoAuthenticationMethodsAvailableError + Just r -> lift (https r) processResponse :: HTTP.Response LByteString.ByteString diff --git a/src/OpenID/Connect/Discovery.hs b/src/OpenID/Connect/Discovery.hs --- a/src/OpenID/Connect/Discovery.hs +++ b/src/OpenID/Connect/Discovery.hs @@ -209,6 +209,14 @@ -- registering the Client to read about OpenID Provider's terms of -- service. The registration process SHOULD display this URL to -- the person registering the Client if it is given. + + , endSessionEndpoint :: Maybe URI + -- ^ URL at the OP to which an RP can perform a redirect to + -- request that the End-User be logged out at the OP. This URL MUST + -- use the https scheme and MAY contain port, path, and query + -- parameter components. + -- + -- @since 0.2.0 } deriving stock (Generic, Show) deriving (ToJSON, FromJSON) via GenericJSON Discovery diff --git a/src/OpenID/Connect/JSON.hs b/src/OpenID/Connect/JSON.hs --- a/src/OpenID/Connect/JSON.hs +++ b/src/OpenID/Connect/JSON.hs @@ -27,6 +27,7 @@ , URI(..) , Aeson.ToJSON , Aeson.FromJSON + , aesonOptions ) where -------------------------------------------------------------------------------- diff --git a/test/Client/AuthorizationCodeTest.hs b/test/Client/AuthorizationCodeTest.hs --- a/test/Client/AuthorizationCodeTest.hs +++ b/test/Client/AuthorizationCodeTest.hs @@ -24,7 +24,7 @@ -------------------------------------------------------------------------------- -- Imports: import Control.Lens ((&), (?~), (#), (.~), (^?)) -import Control.Monad.Except +import Control.Monad (join) import Crypto.JOSE (JWK, JWKSet(..)) import Crypto.JOSE.Compact import Crypto.JWT (ClaimsSet) @@ -211,7 +211,7 @@ -> UserReturnFromRedirect -> IO (Either FlowError (TokenResponse ClaimsSet), HTTP.Request) makeRequest_ time disco key claims keyset browser = do - claims' <- runExceptT + claims' <- JWT.runJOSE (do algo <- JWT.bestJWSAlg key JWT.signClaims key (JWT.newJWSHeader ((), algo)) claims) >>= \case diff --git a/test/HttpHelper.hs b/test/HttpHelper.hs --- a/test/HttpHelper.hs +++ b/test/HttpHelper.hs @@ -26,6 +26,8 @@ -------------------------------------------------------------------------------- import Control.Monad.State.Strict +import Crypto.JWT (MonadRandom(..)) +import GHC.Generics (Generic) import qualified Data.ByteString.Lazy.Char8 as LChar8 import qualified Network.HTTP.Client.Internal as HTTP import qualified Network.HTTP.Types as HTTP @@ -66,12 +68,21 @@ ] -------------------------------------------------------------------------------- +newtype HttpSt m a = HttpSt + { _unHttpSt :: StateT HTTP.Request m a } + deriving stock (Generic) + deriving newtype (Functor, Applicative, Monad, MonadTrans) + +instance MonadRandom m => MonadRandom (HttpSt m) where + getRandomBytes = lift . getRandomBytes + +-------------------------------------------------------------------------------- mkHTTPS :: MonadIO m => FakeHTTPS -> HTTP.Request - -> StateT HTTP.Request m (HTTP.Response LChar8.ByteString) -mkHTTPS FakeHTTPS{..} request = do + -> HttpSt m (HTTP.Response LChar8.ByteString) +mkHTTPS FakeHTTPS{..} request = HttpSt $ do put request body <- liftIO fakeData @@ -89,6 +100,6 @@ -------------------------------------------------------------------------------- runHTTPS - :: StateT HTTP.Request m a + :: HttpSt m a -> m (a, HTTP.Request) -runHTTPS = (`runStateT` (HTTP.defaultRequest { HTTP.method = "NONE" })) +runHTTPS (HttpSt s) = runStateT s (HTTP.defaultRequest { HTTP.method = "NONE" })