Add Credentials to decodeIdentityToken for future JWE support

src/OpenID/Connect/Authentication.hs

@@ -22,16 +22,19 @@ module OpenID.Connect.Authentication
   , ClientID
   , ClientRedirectURI
   , AuthenticationRequest(..)
+  , clientSecretAsJWK
   ) where
 
 --------------------------------------------------------------------------------
 -- Imports:
 import Control.Applicative ((<|>))
 import Crypto.JOSE.JWK (JWK)
+import qualified Crypto.JOSE.JWK as JWK
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 import Data.ByteString (ByteString)
 import Data.Text (Text)
+import qualified Data.Text.Encoding as Text
 import GHC.Generics (Generic)
 import Network.HTTP.Types (QueryItem)
 import qualified Network.URI as Network
@@ -71,6 +74,16 @@ data ClientSecret
 -- @since 0.1.0.0
 type ClientID = Text
 
+--------------------------------------------------------------------------------
+-- | Get credentials as a JWK, if applicable
+clientSecretAsJWK :: ClientSecret -> Maybe JWK
+clientSecretAsJWK (AssertionPrivateKey jwk) =
+  Just jwk
+-- Use the @client_secret@ as a /key/ to sign a JWT.
+clientSecretAsJWK (AssignedAssertionText keyBytes) =
+  Just $ JWK.fromOctets $ Text.encodeUtf8 keyBytes
+clientSecretAsJWK _ = Nothing
+
 --------------------------------------------------------------------------------
 -- | The client (relying party) redirection URL previously registered
 -- with the OpenID Provider (i.e. a URL to an endpoint on your web

src/OpenID/Connect/Client/Authentication.hs

@@ -61,8 +61,9 @@ applyRequestAuthentication creds methods uri now body =
       | ClientSecretPost  `elem` methods -> pure . Just . useBody secret
       | None              `elem` methods -> pure . Just . pass body
       | otherwise                        -> pure . const Nothing
-    AssignedAssertionText key
-      | ClientSecretJwt `elem` methods   -> hmacWithKey key
+    s@(AssignedAssertionText _)
+      | ClientSecretJwt `elem` methods
+      , Just key <- clientSecretAsJWK s  -> signWithKey key
       | None            `elem` methods   -> pure . Just . pass body
       | otherwise                        -> pure . const Nothing
     AssertionPrivateKey key
@@ -85,11 +86,6 @@ applyRequestAuthentication creds methods uri now body =
         (Text.encodeUtf8 (assignedClientId creds))
         (Text.encodeUtf8 secret) . pass body
 
-    -- Use the @client_secret@ as a /key/ to sign a JWT.
-    hmacWithKey :: Text -> HTTP.Request -> m (Maybe HTTP.Request)
-    hmacWithKey keyBytes =
-      signWithKey (JWK.fromOctets (Text.encodeUtf8 keyBytes))
-
     -- Use the given key to /sign/ a JWT.  May create an actual
     -- digital signature or in the case of 'hmacWithKey', create an
     -- HMAC for the header.

src/OpenID/Connect/Client/Flow/AuthorizationCode.hs

@@ -427,7 +427,7 @@ exchangeCodeForIdentityToken https now disco creds user = do
     processResponse res =
       parseResponse res
       & bimap InvalidProviderTokenResponseError fst
-      >>= (decodeIdentityToken >>> first TokenDecodingError)
+      >>= (decodeIdentityToken creds >>> first TokenDecodingError)
 
     authMethods :: [ClientAuthentication]
     authMethods = maybe [ClientSecretPost] NonEmpty.toList

src/OpenID/Connect/Client/TokenResponse.hs

@@ -38,7 +38,7 @@ import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text.Encoding as Text
 import Data.Time.Clock (UTCTime)
-import OpenID.Connect.Authentication (ClientID)
+import OpenID.Connect.Authentication
 import OpenID.Connect.Client.Provider
 import OpenID.Connect.TokenResponse
 
@@ -51,13 +51,23 @@ import qualified Data.HashMap.Strict as Map
 --------------------------------------------------------------------------------
 -- | Decode the compacted identity token into a 'SignedJWT'.
 decodeIdentityToken
-  :: TokenResponse Text
+  :: Credentials        -- ^ Decoding JWE requires decrypting as well
+  -> TokenResponse Text
   -> Either JOSE.Error (TokenResponse SignedJWT)
-decodeIdentityToken token
-  = JOSE.decodeCompact (LChar8.fromStrict (Text.encodeUtf8 (idToken token)))
-  & runExceptT
-  & runIdentity
-  & fmap (<$ token)
+decodeIdentityToken creds token = fmap (<$ token) $ runIdentity $ runExceptT $ do
+  -- First attempt it as a JWS
+  case JOSE.decodeCompact token' of
+    Right x -> pure x
+    -- Looks like a JWE
+    Left (JOSE.CompactDecodeError (JOSE.CompactInvalidNumberOfParts
+                                   (JOSE.InvalidNumberOfParts 3 5))) -> do
+      _ <- maybe (throwError JOSE.NoUsableKeys) pure $
+        clientSecretAsJWK $ clientSecret creds
+      -- Crypto.JOSE has no JWE support yet
+      throwError JOSE.AlgorithmNotImplemented
+    Left err -> throwError err
+  where
+    token' = LChar8.fromStrict (Text.encodeUtf8 (idToken token))
 
 --------------------------------------------------------------------------------
 -- | Identity token verification and claim validation.