diff --git a/openid-connect.cabal b/openid-connect.cabal index 5cad9cf..419aab6 100644 --- a/openid-connect.cabal +++ b/openid-connect.cabal @@ -85,10 +85,10 @@ common dependencies , case-insensitive ^>=1.2 , containers ^>=0.6 , cookie ^>=0.4 - , cryptonite >=0.25 && <1.0 + , crypton >=0.25 && <1.0 , http-client >=0.6 && <0.8 , http-types ^>=0.12 - , jose >=0.10 && <0.11 + , jose >=0.10 && <0.12 , lens >=4.0 && <5.3 , memory >=0.14 && <1.0 , mtl >=2.2 && <2.4 diff --git a/src/OpenID/Connect/Client/Authentication.hs b/src/OpenID/Connect/Client/Authentication.hs index dbfcd94..1867acc 100644 --- a/src/OpenID/Connect/Client/Authentication.hs +++ b/src/OpenID/Connect/Client/Authentication.hs @@ -36,6 +36,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as Char8 import qualified Data.ByteString.Lazy.Char8 as LChar8 import Data.Functor ((<&>)) +import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import qualified Data.Text.Encoding as Text import Data.Time.Clock (UTCTime, addUTCTime) @@ -49,12 +50,13 @@ applyRequestAuthentication :: forall m. MonadRandom m => Credentials -- ^ Client credentials. -> [ClientAuthentication] -- ^ Available authentication methods. + -> NonEmpty JWT.Alg -- ^ Available JWS signing algorithms. -> URI -- ^ Token Endpoint URI -> UTCTime -- ^ The current time. -> [(ByteString, ByteString)] -- ^ Headers to include in the post. -> HTTP.Request -- ^ The request to modify. -> m (Maybe HTTP.Request) -- ^ The final request. -applyRequestAuthentication creds methods uri now body = +applyRequestAuthentication creds methods algs uri now body = case clientSecret creds of AssignedSecretText secret | ClientSecretBasic `elem` methods -> pure . Just . useBasic secret @@ -97,7 +99,7 @@ applyRequestAuthentication creds methods uri now body = signWithKey key req = do claims <- makeClaims <$> makeJti res <- JWT.runJOSE $ do - alg <- JWK.bestJWSAlg key + alg <- JWK.negotiateJWSAlg key $ Just algs JWT.signClaims key (JWT.newJWSHeader ((), alg)) claims case res of Left (_ :: JOSE.Error) -> pure Nothing diff --git a/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs b/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs index 3e8db7e..9406dfa 100644 --- a/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs +++ b/src/OpenID/Connect/Client/Flow/AuthorizationCode.hs @@ -64,6 +64,7 @@ import Control.Exception (Exception) import Control.Monad.Except import qualified Crypto.Hash as Hash import qualified Crypto.JOSE.Error as JOSE +import Crypto.JOSE.JWA.JWS (Alg) import Crypto.JOSE.JWK (JWKSet) import Crypto.JWT (SignedJWT, ClaimsSet, JWTError) import Crypto.Random (MonadRandom(..)) @@ -417,7 +418,7 @@ exchangeCodeForIdentityToken https now disco creds user = do req <- maybe (throwError (InvalidProviderTokenEndpointError (uriToText (getURI uri)))) pure (requestFromURI (Right (getURI uri))) - lift (applyRequestAuthentication creds authMethods uri now body req) >>= \case + lift (applyRequestAuthentication creds authMethods signingAlgs uri now body req) >>= \case Nothing -> throwError NoAuthenticationMethodsAvailableError Just r -> lift (https r) @@ -433,6 +434,9 @@ exchangeCodeForIdentityToken https now disco creds user = do authMethods = maybe [ClientSecretPost] NonEmpty.toList (tokenEndpointAuthMethodsSupported disco) + signingAlgs :: NonEmpty.NonEmpty Alg + signingAlgs = idTokenSigningAlgValuesSupported disco + body :: [ (ByteString, ByteString) ] body = [ ("grant_type", "authorization_code") , ("code", afterRedirectCodeParam user) diff --git a/src/OpenID/Connect/Discovery.hs b/src/OpenID/Connect/Discovery.hs index e511105..8e3d2bf 100644 --- a/src/OpenID/Connect/Discovery.hs +++ b/src/OpenID/Connect/Discovery.hs @@ -22,6 +22,7 @@ module OpenID.Connect.Discovery -------------------------------------------------------------------------------- -- Imports: +import Crypto.JOSE.JWA.JWS import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import GHC.Generics (Generic) @@ -91,7 +92,7 @@ data Discovery = Discovery -- ^ JSON array containing a list of the Subject Identifier types -- that this OP supports. - , idTokenSigningAlgValuesSupported :: NonEmpty Text + , idTokenSigningAlgValuesSupported :: NonEmpty Alg -- ^ JSON array containing a list of the JWS signing algorithms -- (alg values) supported by the OP for the ID Token to encode the -- Claims in a JWT. @@ -106,7 +107,7 @@ data Discovery = Discovery -- (enc values) supported by the OP for the ID Token to encode the -- Claims in a JWT. - , userinfoSigningAlgValuesSupported :: Maybe (NonEmpty Text) + , userinfoSigningAlgValuesSupported :: Maybe (NonEmpty Alg) -- ^ JSON array containing a list of the JWS signing algorithms -- (alg values). @@ -118,7 +119,7 @@ data Discovery = Discovery -- ^ JSON array containing a list of the JWE encryption algorithms -- (enc values). - , requestObjectSigningAlgValuesSupported :: Maybe (NonEmpty Text) + , requestObjectSigningAlgValuesSupported :: Maybe (NonEmpty Alg) -- ^ JSON array containing a list of the JWS signing algorithms -- (alg values) supported by the OP for Request Objects, which are -- described in Section 6.1 of OpenID Connect Core 1.0. @@ -139,7 +140,7 @@ data Discovery = Discovery -- ^ JSON array containing a list of Client Authentication methods -- supported by this Token Endpoint. - , tokenEndpointAuthSigningAlgValuesSupported :: Maybe (NonEmpty Text) + , tokenEndpointAuthSigningAlgValuesSupported :: Maybe (NonEmpty Alg) -- ^ JSON array containing a list of the JWS signing algorithms -- (alg values) supported by the Token Endpoint for the signature -- on the JWT used to authenticate the Client at the Token