diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.4.2 +----- + +* Fix in the code for finding suitable JWKs for encoding/decoding. + 0.4.1.1 ------- diff --git a/Jose/Jwk.hs b/Jose/Jwk.hs --- a/Jose/Jwk.hs +++ b/Jose/Jwk.hs @@ -7,14 +7,14 @@ , KeyId , Jwk (..) , JwkSet (..) - , validateForJws - , findMatchingJwsKeys - , findMatchingJweKeys + , canDecodeJws + , canDecodeJwe + , canEncodeJws + , canEncodeJwe ) where import Control.Applicative (pure) -import Control.Monad (when) import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.Types.PubKey.ECC as ECC @@ -28,7 +28,7 @@ import qualified Jose.Internal.Base64 as B64 import Jose.Jwa -import Jose.Types (JwtError(..), KeyId, JwsHeader(..), JweHeader(..)) +import Jose.Types (KeyId, JwsHeader(..), JweHeader(..)) data KeyType = Rsa | Ec @@ -55,42 +55,71 @@ { keys :: [Jwk] } deriving (Show, Eq, Generic) -validateForJws :: JwsAlg -> Jwk -> Either JwtError () -validateForJws a jwk = do - when (jwkUse jwk == Just Enc) $ Left (KeyError "JWK is for encryption only") - either (Left . KeyError) (const $ Right ()) $ case a of - HS256 -> mustBeSymmetric - HS384 -> mustBeSymmetric - HS512 -> mustBeSymmetric - RS256 -> mustBeRsa - RS384 -> mustBeRsa - RS512 -> mustBeRsa - ES256 -> mustBeEc - ES384 -> mustBeEc - ES512 -> mustBeEc - None -> Left "JWS with alg 'None' does not require a key" - where - mustBeRsa = case jwk of - RsaPrivateJwk {} -> Right () - RsaPublicJwk {} -> Right () - _ -> Left "JWK must be an RSA key" - mustBeSymmetric = case jwk of - SymmetricJwk {} -> Right () - _ -> Left "JWK must be symmetric" - mustBeEc = case jwk of - EcPrivateJwk {} -> Right () - EcPublicJwk {} -> Right () - _ -> Left "JWK must be an EC key" +canDecodeJws :: JwsHeader -> Jwk -> Bool +canDecodeJws hdr jwk = jwkUse jwk /= Just Enc && + keyIdCompatible (jwsKid hdr) jwk && + algCompatible (Signed (jwsAlg hdr)) jwk && + case (jwsAlg hdr, jwk) of + (RS256, RsaPublicJwk {}) -> True + (RS384, RsaPublicJwk {}) -> True + (RS512, RsaPublicJwk {}) -> True + (RS256, RsaPrivateJwk {}) -> True + (RS384, RsaPrivateJwk {}) -> True + (RS512, RsaPrivateJwk {}) -> True + (HS256, SymmetricJwk {}) -> True + (HS384, SymmetricJwk {}) -> True + (HS512, SymmetricJwk {}) -> True + (ES256, EcPublicJwk {}) -> True + (ES384, EcPublicJwk {}) -> True + (ES512, EcPublicJwk {}) -> True + (ES256, EcPrivateJwk {}) -> True + (ES384, EcPrivateJwk {}) -> True + (ES512, EcPrivateJwk {}) -> True + _ -> False -canDecodeJws :: JwsAlg -> Jwk -> Bool -canDecodeJws al jwk = either (const False) (const True) $ validateForJws al jwk +canEncodeJws :: JwsAlg -> Jwk -> Bool +canEncodeJws a jwk = jwkUse jwk /= Just Enc && + algCompatible (Signed a) jwk && + case (a, jwk) of + (RS256, RsaPrivateJwk {}) -> True + (RS384, RsaPrivateJwk {}) -> True + (RS512, RsaPrivateJwk {}) -> True + (HS256, SymmetricJwk {}) -> True + (HS384, SymmetricJwk {}) -> True + (HS512, SymmetricJwk {}) -> True + (ES256, EcPrivateJwk {}) -> True + (ES384, EcPrivateJwk {}) -> True + (ES512, EcPrivateJwk {}) -> True + _ -> False -canDecodeJwe :: JweAlg -> Jwk -> Bool -canDecodeJwe _ jwk = jwkUse jwk /= Just Sig && - case jwk of - RsaPrivateJwk {} -> True - _ -> False +canDecodeJwe :: JweHeader -> Jwk -> Bool +canDecodeJwe hdr jwk = jwkUse jwk /= Just Sig && + keyIdCompatible (jweKid hdr) jwk && + algCompatible (Encrypted (jweAlg hdr)) jwk && + case (jweAlg hdr, jwk) of + (RSA1_5, RsaPrivateJwk {}) -> True + (RSA_OAEP, RsaPrivateJwk {}) -> True + _ -> False +canEncodeJwe :: JweAlg -> Jwk -> Bool +canEncodeJwe a jwk = jwkUse jwk /= Just Sig && + algCompatible (Encrypted a) jwk && + case (a, jwk) of + (RSA1_5, RsaPublicJwk {}) -> True + (RSA_OAEP, RsaPublicJwk {}) -> True + (RSA1_5, RsaPrivateJwk {}) -> True + (RSA_OAEP, RsaPrivateJwk {}) -> True + _ -> False + +keyIdCompatible :: Maybe KeyId -> Jwk -> Bool +keyIdCompatible Nothing _ = True +keyIdCompatible id' jwk = id' == jwkId jwk + +algCompatible :: Alg -> Jwk -> Bool +algCompatible a k' = case jwkAlg k' of + Nothing -> True + Just ka -> a == ka + curve :: EcCurve -> ECC.Curve curve c = ECC.getCurveByName $ case c of P_256 -> ECC.SEC_p256r1 @@ -105,7 +134,6 @@ EcPrivateJwk _ keyId _ _ _ -> keyId SymmetricJwk _ keyId _ _ -> keyId - jwkUse :: Jwk -> Maybe KeyUse jwkUse key = case key of RsaPublicJwk _ _ u _ -> u @@ -114,25 +142,15 @@ EcPrivateJwk _ _ u _ _ -> u SymmetricJwk _ _ u _ -> u -findKeyById :: [Jwk] -> KeyId -> Maybe Jwk -findKeyById [] _ = Nothing -findKeyById (key:ks) keyId = case jwkId key of - Nothing -> findKeyById ks keyId - Just v -> if v == keyId - then Just key - else findKeyById ks keyId +jwkAlg :: Jwk -> Maybe Alg +jwkAlg key = case key of + RsaPublicJwk _ _ _ a -> a + RsaPrivateJwk _ _ _ a -> a + EcPublicJwk _ _ _ a _ -> a + EcPrivateJwk _ _ _ a _ -> a + SymmetricJwk _ _ _ a -> a --- TODO filter by key use -findMatchingJwsKeys :: [Jwk] -> JwsHeader -> [Jwk] -findMatchingJwsKeys jwks hdr = filter (canDecodeJws (jwsAlg hdr)) $ filterById (jwsKid hdr) jwks -filterById :: Maybe KeyId -> [Jwk] -> [Jwk] -filterById keyId jwks = case keyId of - Just i -> maybe jwks (:[]) $ findKeyById jwks i - Nothing -> jwks - -findMatchingJweKeys :: [Jwk] -> JweHeader -> [Jwk] -findMatchingJweKeys jwks hdr = filter (canDecodeJwe (jweAlg hdr)) $ filterById (jweKid hdr) jwks newtype JwkBytes = JwkBytes {bytes :: ByteString} deriving (Show) diff --git a/Jose/Jwt.hs b/Jose/Jwt.hs --- a/Jose/Jwt.hs +++ b/Jose/Jwt.hs @@ -66,12 +66,12 @@ Nested _ -> left BadClaims Signed a -> do unless (isNothing enc) $ left (BadAlgorithm "Enc cannot be set for a JWS") - case findMatchingJwsKeys jwks (defJwsHdr { jwsAlg = a }) of + case filter (canEncodeJws a) jwks of [] -> left (KeyError "No matching key found for JWS algorithm") (k:_) -> hoistEither =<< state (\g -> Jws.jwkEncode g a k msg) Encrypted a -> do e <- hoistEither $ note (BadAlgorithm "Enc must be supplied for a JWE") enc - case findMatchingJweKeys jwks (defJweHdr { jweAlg = a, jweEnc = e }) of + case filter (canEncodeJwe a) jwks of [] -> left (KeyError "No matching key found for JWE algorithm") (k:_) -> hoistEither =<< state (\g -> Jwe.jwkEncode g a e k msg) where @@ -91,13 +91,13 @@ let components = BC.split '.' jwt when (length components < 3) $ left $ BadDots 2 hdr <- B64.decode (head components) >>= hoistEither . parseHeader - ks <- findKeys hdr keySet + ks <- findDecodingKeys hdr keySet -- Now we have one or more suitable keys (or none for the unsecured case). -- Try each in turn until successful decodings <- case hdr of UnsecuredH -> B64.decode (components !! 1) >>= \p -> return [Just (Unsecured p)] JwsH _ -> mapM decodeWithJws ks - _ -> mapM decodeWithJwe ks + JweH _ -> mapM decodeWithJwe ks maybe (left $ KeyError "None of the keys was able to decode the JWT") (return . fromJust) $ find isJust decodings where decodeWithJws :: CPRG g => Jwk -> EitherT JwtError (State g) (Maybe JwtContent) @@ -133,10 +133,10 @@ parseClaims bs = maybe (Left BadClaims) Right $ decodeStrict' bs -findKeys :: Monad m => JwtHeader -> [Jwk] -> EitherT JwtError m [Jwk] -findKeys hdr jwks = case hdr of - JweH h -> checkKeys $ findMatchingJweKeys jwks h - JwsH h -> checkKeys $ findMatchingJwsKeys jwks h +findDecodingKeys :: Monad m => JwtHeader -> [Jwk] -> EitherT JwtError m [Jwk] +findDecodingKeys hdr jwks = case hdr of + JweH h -> checkKeys $ filter (canDecodeJwe h) jwks + JwsH h -> checkKeys $ filter (canDecodeJws h) jwks UnsecuredH -> return [] where -- TODO Move checks to JWK and support better error messages diff --git a/jose-jwt.cabal b/jose-jwt.cabal --- a/jose-jwt.cabal +++ b/jose-jwt.cabal @@ -1,5 +1,5 @@ Name: jose-jwt -Version: 0.4.1.1 +Version: 0.4.2 Synopsis: JSON Object Signing and Encryption Library Homepage: http://github.com/tekul/jose-jwt Bug-Reports: http://github.com/tekul/jose-jwt/issues diff --git a/tests/Tests/JwkSpec.hs b/tests/Tests/JwkSpec.hs --- a/tests/Tests/JwkSpec.hs +++ b/tests/Tests/JwkSpec.hs @@ -11,6 +11,7 @@ import Crypto.Types.PubKey.ECDSA import Crypto.Types.PubKey.ECC +import Jose.Jwt (defJwsHdr, JwsHeader(..)) import Jose.Jwk import Jose.Jwa @@ -34,11 +35,11 @@ spec :: Spec -spec = - describe "JWK encoding and decoding" $ +spec = do + let Success s@(JwkSet _) = fromJSON (Object keySet) :: Result JwkSet + describe "JWK encoding and decoding" $ do it "decodes and encodes an entire key set successfully" $ do - let Success s@(JwkSet _) = fromJSON (Object keySet) :: Result JwkSet - Just s' = decode' (encode s) :: Maybe JwkSet + let Just s' = decode' (encode s) :: Maybe JwkSet kss = keys s' RsaPublicJwk _ key0Id key0Use a0 = head kss RsaPublicJwk _ key1Id key1Use _ = kss !! 1 @@ -67,3 +68,23 @@ a6 @?= Just (Signed RS256) a8 @?= Just (Signed RS256) + describe "JWK Algorithm matching" $ do + let jwks = keys s + it "finds one key for RS256 encoding" $ do + -- Only the RSA Private key + let jwks' = filter (canEncodeJws RS256) jwks + length jwks' @?= 1 + + it "finds 3 keys for RS256 decoding with no kid" $ do + -- All RSA keys are valid except for the "enc" one + let jwks' = filter (canDecodeJws (defJwsHdr {jwsAlg = RS256})) jwks + length jwks' @?= 3 + + it "finds one key for RS256 decoding with kid specified" $ do + let jwks' = filter (canDecodeJws (defJwsHdr {jwsAlg = RS256, jwsKid = Just "a1"})) jwks + length jwks' @?= 1 + + it "finds an RS1_5 key for encoding" $ do + -- Only key a0 matches. The other 3 RSA keys are signing keys + let jwks' = filter (canEncodeJwe RSA1_5) jwks + length jwks' @?= 1