Use best available JWS alg for identity token fetch

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

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

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)

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