openid-connect 0.1.2 → 0.2.0

raw patch · 10 files changed

+107/−34 lines, 10 filesdep ~aesondep ~josedep ~lens

Dependency ranges changed: aeson, jose, lens

Files

• CHANGES.md +16/−0
• LICENSE +1/−1
• openid-connect.cabal +16/−16
• src/OpenID/Connect/Authentication.hs +23/−2
• src/OpenID/Connect/Client/Authentication.hs +1/−2
• src/OpenID/Connect/Client/Flow/AuthorizationCode.hs +24/−7
• src/OpenID/Connect/Discovery.hs +8/−0
• src/OpenID/Connect/JSON.hs +1/−0
• test/Client/AuthorizationCodeTest.hs +2/−2
• test/HttpHelper.hs +15/−4

@@ -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.

@@ -1,4 +1,4 @@-Copyright (c) 2020-2022 Peter J. Jones <pjones@devalot.com>+Copyright (c) 2020-2023 Peter J. Jones <pjones@devalot.com> All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -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 <pjones@devalot.com> maintainer:         Peter Jones <pjones@devalot.com>-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:

@@ -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)

@@ -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

@@ -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

@@ -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

@@ -27,6 +27,7 @@   , URI(..)   , Aeson.ToJSON   , Aeson.FromJSON+  , aesonOptions   ) where  --------------------------------------------------------------------------------

@@ -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

@@ -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" })