jose-jwt 0.4.1.1 → 0.4.2
raw patch · 5 files changed
+113/−69 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- Jose/Jwk.hs +74/−56
- Jose/Jwt.hs +8/−8
- jose-jwt.cabal +1/−1
- tests/Tests/JwkSpec.hs +25/−4
CHANGELOG.md view
@@ -1,3 +1,8 @@+0.4.2+-----++* Fix in the code for finding suitable JWKs for encoding/decoding.+ 0.4.1.1 -------
Jose/Jwk.hs view
@@ -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)
Jose/Jwt.hs view
@@ -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
jose-jwt.cabal view
@@ -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
tests/Tests/JwkSpec.hs view
@@ -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