Hello community, here is the log from the commit of package ghc-jose-jwt for openSUSE:Factory checked in at 2017-03-18 20:50:07 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-jose-jwt (Old) and /work/SRC/openSUSE:Factory/.ghc-jose-jwt.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-jose-jwt" Sat Mar 18 20:50:07 2017 rev:3 rq:461653 version:0.7.5 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-jose-jwt/ghc-jose-jwt.changes 2016-11-14 20:14:16.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-jose-jwt.new/ghc-jose-jwt.changes 2017-03-18 20:50:08.509352596 +0100 @@ -1,0 +2,10 @@ +Mon Feb 20 08:42:15 UTC 2017 - [email protected] + +- Update to version 0.7.5 with cabal2obs. + +------------------------------------------------------------------- +Sun Jan 8 21:13:42 UTC 2017 - [email protected] + +- Update to version 0.7.4 with cabal2obs. + +------------------------------------------------------------------- Old: ---- jose-jwt-0.7.3.tar.gz New: ---- jose-jwt-0.7.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-jose-jwt.spec ++++++ --- /var/tmp/diff_new_pack.leEVwO/_old 2017-03-18 20:50:09.993142392 +0100 +++ /var/tmp/diff_new_pack.leEVwO/_new 2017-03-18 20:50:09.997141826 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-jose-jwt # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name jose-jwt %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.7.3 +Version: 0.7.5 Release: 0 Summary: JSON Object Signing and Encryption Library License: BSD-3-Clause @@ -28,6 +28,7 @@ Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel BuildRequires: ghc-aeson-devel +BuildRequires: ghc-attoparsec-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-cereal-devel BuildRequires: ghc-containers-devel ++++++ jose-jwt-0.7.3.tar.gz -> jose-jwt-0.7.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/CHANGELOG.md new/jose-jwt-0.7.5/CHANGELOG.md --- old/jose-jwt-0.7.3/CHANGELOG.md 2016-09-24 13:13:36.000000000 +0200 +++ new/jose-jwt-0.7.5/CHANGELOG.md 2017-02-18 20:35:55.000000000 +0100 @@ -1,3 +1,13 @@ +0.7.5 +----- + +* A JWT parser is now used to separate parsing and decoding into separaate stages (internal change). + +0.7.4 +----- + +* Stricter checking of AES key lengths when looking for a valid JWK to encode/decode an AES-KW JWT. + 0.7.3 ----- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/Jose/Internal/Crypto.hs new/jose-jwt-0.7.5/Jose/Internal/Crypto.hs --- old/jose-jwt-0.7.3/Jose/Internal/Crypto.hs 2016-06-01 20:16:46.000000000 +0200 +++ new/jose-jwt-0.7.5/Jose/Internal/Crypto.hs 2017-02-17 02:46:40.000000000 +0100 @@ -26,7 +26,7 @@ import Control.Monad (when, unless) import Crypto.Error import Crypto.Cipher.AES -import Crypto.Cipher.Types +import Crypto.Cipher.Types hiding (IV) import Crypto.Hash.Algorithms import Crypto.Number.Serialize (os2ip) import qualified Crypto.PubKey.ECC.ECDSA as ECDSA @@ -46,6 +46,7 @@ import Jose.Jwa import Jose.Types (JwtError(..)) +import Jose.Internal.Parser (IV(..), Tag(..)) -- | Sign a message with an HMAC key. hmacSign :: JwsAlg -- ^ HMAC algorithm to use @@ -186,44 +187,45 @@ -- | Decrypt an AES encrypted message. decryptPayload :: Enc -- ^ Encryption algorithm - -> ByteString -- ^ Content management key - -> ByteString -- ^ IV + -> ByteString -- ^ Content encryption key + -> IV -- ^ IV -> ByteString -- ^ Additional authentication data - -> AuthTag -- ^ The integrity protection value to be checked + -> Tag -- ^ The integrity protection value to be checked -> ByteString -- ^ The encrypted JWT payload -> Maybe ByteString -decryptPayload enc cek iv aad sig ct = case enc of - A128GCM -> doGCM (C :: C AES128) - A192GCM -> doGCM (C :: C AES192) - A256GCM -> doGCM (C :: C AES256) - A128CBC_HS256 -> doCBC (C :: C AES128) SHA256 16 - A192CBC_HS384 -> doCBC (C :: C AES192) SHA384 24 - A256CBC_HS512 -> doCBC (C :: C AES256) SHA512 32 +decryptPayload enc cek iv_ aad tag_ ct = case (enc, iv_, tag_) of + (A128GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES128) b t + (A192GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES192) b t + (A256GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES256) b t + (A128CBC_HS256, IV16 b, Tag16 t) -> doCBC (C :: C AES128) b t SHA256 16 + (A192CBC_HS384, IV16 b, Tag24 t) -> doCBC (C :: C AES192) b t SHA384 24 + (A256CBC_HS512, IV16 b, Tag32 t) -> doCBC (C :: C AES256) b t SHA512 32 + _ -> Nothing -- This shouldn't be possible if the JWT was parsed first where (cbcMacKey, cbcEncKey) = B.splitAt (B.length cek `div` 2) cek al = fromIntegral (B.length aad) * 8 :: Word64 - doGCM :: BlockCipher c => C c -> Maybe ByteString - doGCM c = do + doGCM :: BlockCipher c => C c -> ByteString -> ByteString -> Maybe ByteString + doGCM c iv tag = do cipher <- rightToMaybe (initCipher c cek) aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv) - aeadSimpleDecrypt aead aad ct (AuthTag $ BA.convert sig) + aeadSimpleDecrypt aead aad ct (AuthTag $ BA.convert tag) - doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> a -> Int -> Maybe ByteString - doCBC c a tagLen = do - checkMac a tagLen + doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> ByteString -> ByteString -> a -> Int -> Maybe ByteString + doCBC c iv tag a tagLen = do + checkMac a tag iv tagLen cipher <- rightToMaybe (initCipher c cbcEncKey) iv' <- makeIV iv unless (B.length ct `mod` blockSize cipher == 0) Nothing unpad $ cbcDecrypt cipher iv' ct - checkMac :: HashAlgorithm a => a -> Int -> Maybe () - checkMac a l = do - let mac = BA.take l $ BA.convert $ doMac a :: BA.Bytes - unless (sig `BA.constEq` mac) Nothing + checkMac :: HashAlgorithm a => a -> ByteString -> ByteString -> Int -> Maybe () + checkMac a tag iv l = do + let mac = BA.take l $ BA.convert $ doMac a iv :: BA.Bytes + unless (tag `BA.constEq` mac) Nothing - doMac :: HashAlgorithm a => a -> HMAC a - doMac _ = hmac cbcMacKey $ B.concat [aad, iv, ct, Serialize.encode al] + doMac :: HashAlgorithm a => a -> ByteString -> HMAC a + doMac _ iv = hmac cbcMacKey $ B.concat [aad, iv, ct, Serialize.encode al] -- | Encrypt a message using AES. encryptPayload :: Enc -- ^ Encryption algorithm diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/Jose/Internal/Parser.hs new/jose-jwt-0.7.5/Jose/Internal/Parser.hs --- old/jose-jwt-0.7.3/Jose/Internal/Parser.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/jose-jwt-0.7.5/Jose/Internal/Parser.hs 2017-02-18 20:00:10.000000000 +0100 @@ -0,0 +1,142 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune #-} + +-- | Parses encoded JWTs into data structures which can be handled + +module Jose.Internal.Parser + ( parseJwt + , DecodableJwt (..) + , EncryptedCEK (..) + , Payload (..) + , IV (..) + , Tag (..) + , AAD (..) + , Sig (..) + , SigTarget (..) + ) +where + +import Control.Applicative +import Data.Aeson (eitherDecodeStrict') +import Data.Attoparsec.ByteString (Parser) +import qualified Data.Attoparsec.ByteString as P +import qualified Data.Attoparsec.ByteString.Char8 as PC +import Data.ByteArray.Encoding (convertFromBase, Base(..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Either.Combinators (mapLeft) + +import Jose.Jwa +import Jose.Types (JwtError(..), JwtHeader(..), JwsHeader(..), JweHeader(..)) + + +data DecodableJwt + = Unsecured ByteString + | DecodableJws JwsHeader Payload Sig SigTarget + | DecodableJwe JweHeader EncryptedCEK IV Payload Tag AAD + + +data Tag + = Tag16 ByteString + | Tag24 ByteString + | Tag32 ByteString + + +data IV + = IV12 ByteString + | IV16 ByteString + + +newtype Sig = Sig ByteString +newtype SigTarget = SigTarget ByteString +newtype AAD = AAD ByteString +newtype Payload = Payload ByteString +newtype EncryptedCEK = EncryptedCEK ByteString + + +parseJwt :: ByteString -> Either JwtError DecodableJwt +parseJwt bs = mapLeft (const BadCrypto) $ P.parseOnly jwt bs + + +jwt :: Parser DecodableJwt +jwt = do + (hdr, raw) <- jwtHeader + case hdr of + UnsecuredH -> Unsecured <$> base64Chunk + JwsH h -> do + payloadB64 <- PC.takeWhile ('.' /=) <* PC.char '.' + payload <- b64Decode payloadB64 + s <- sig (jwsAlg h) + pure $ DecodableJws h (Payload payload) s (SigTarget (B.concat [raw, ".", payloadB64])) + JweH h -> + DecodableJwe + <$> pure h + <*> encryptedCEK + <*> iv (jweEnc h) + <*> encryptedPayload + <*> authTag (jweEnc h) + <*> pure (AAD raw) + + +sig :: JwsAlg -> Parser Sig +sig _ = do + t <- P.takeByteString >>= b64Decode + pure (Sig t) + + +authTag :: Enc -> Parser Tag +authTag e = do + t <- P.takeByteString >>= b64Decode + case e of + A128GCM -> tag16 t + A192GCM -> tag16 t + A256GCM -> tag16 t + A128CBC_HS256 -> tag16 t + A192CBC_HS384 -> tag24 t + A256CBC_HS512 -> tag32 t + where + badTag = "invalid auth tag" + tag16 t = if B.length t /= 16 then fail badTag else pure (Tag16 t) + tag24 t = if B.length t /= 24 then fail badTag else pure (Tag24 t) + tag32 t = if B.length t /= 32 then fail badTag else pure (Tag32 t) + + +iv :: Enc -> Parser IV +iv e = do + bs <- base64Chunk + case e of + A128GCM -> iv12 bs + A192GCM -> iv12 bs + A256GCM -> iv12 bs + _ -> iv16 bs + where + iv12 bs = if B.length bs /= 12 then fail "invalid iv" else pure (IV12 bs) + iv16 bs = if B.length bs /= 16 then fail "invalid iv" else pure (IV16 bs) + + +encryptedCEK :: Parser EncryptedCEK +encryptedCEK = EncryptedCEK <$> base64Chunk + + +encryptedPayload :: Parser Payload +encryptedPayload = Payload <$> base64Chunk + + +jwtHeader :: P.Parser (JwtHeader, ByteString) +jwtHeader = do + hdrB64 <- PC.takeWhile ('.' /=) <* PC.char '.' + hdrBytes <- b64Decode hdrB64 :: P.Parser ByteString + hdr <- parseHdr hdrBytes + return (hdr, hdrB64) + where + parseHdr bs = either fail return (eitherDecodeStrict' bs) + + +base64Chunk :: P.Parser ByteString +base64Chunk = do + bs <- PC.takeWhile ('.' /=) <* PC.char '.' + b64Decode bs + + +b64Decode :: ByteString -> P.Parser ByteString +b64Decode bs = either (fail "Invalid Base64") return $ convertFromBase Base64URLUnpadded bs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/Jose/Jwe.hs new/jose-jwt-0.7.5/Jose/Jwe.hs --- old/jose-jwt-0.7.3/Jose/Jwe.hs 2016-06-01 20:16:46.000000000 +0200 +++ new/jose-jwt-0.7.5/Jose/Jwe.hs 2017-02-17 02:46:40.000000000 +0100 @@ -20,7 +20,6 @@ ) where -import Control.Monad (unless) import Control.Monad.Trans (lift) import Control.Monad.Trans.Either import Crypto.Cipher.Types (AuthTag(..)) @@ -29,12 +28,12 @@ import qualified Data.ByteArray as BA import Data.ByteString (ByteString) import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC import Jose.Types import qualified Jose.Internal.Base64 as B64 import Jose.Internal.Crypto import Jose.Jwa import Jose.Jwk +import qualified Jose.Internal.Parser as P -- | Create a JWE using a JWK. -- The key and algorithms must be consistent or an error @@ -57,6 +56,7 @@ Claims c -> (Nothing, c) Nested (Jwt b) -> (Just "JWT", b) + -- | Try to decode a JWE using a JWK. -- If the key type does not match the content encoding algorithm, -- an error will be returned. @@ -72,36 +72,26 @@ SymmetricJwk kb _ _ _ -> fmap Jwe (doDecode (keyUnwrap kb) jwt) _ -> left $ KeyError "JWK cannot decode a JWE" + doDecode :: MonadRandom m => (JweAlg -> ByteString -> Either JwtError ByteString) -> ByteString -> EitherT JwtError m Jwe doDecode decodeCek jwt = do - checkDots - let components = BC.split '.' jwt - let aad = head components - [h, ek, providedIv, payload, sig] <- mapM B64.decode components - hdr <- case parseHeader h of - Right (JweH jweHdr) -> return jweHdr - Right (JwsH _) -> left (BadHeader "Header is for a JWS") - Right UnsecuredH -> left (BadHeader "Header is for an unsecured JWT") - Left e -> left e - let alg = jweAlg hdr - enc = jweEnc hdr - (dummyCek, dummyIv) <- lift $ generateCmkAndIV enc - let decryptedCek = either (const dummyCek) id $ decodeCek alg ek - cek = if B.length decryptedCek == B.length dummyCek - then decryptedCek - else dummyCek - iv = if B.length providedIv == B.length dummyIv - then providedIv - else dummyIv - authTag = AuthTag $ BA.convert sig - claims <- maybe (left BadCrypto) return $ decryptPayload enc cek iv aad authTag payload - return (hdr, claims) + encodedJwt <- hoistEither (P.parseJwt jwt) + case encodedJwt of + P.DecodableJwe hdr (P.EncryptedCEK ek) iv (P.Payload payload) tag (P.AAD aad) -> do + let alg = jweAlg hdr + enc = jweEnc hdr + (dummyCek, _) <- lift $ generateCmkAndIV enc + let decryptedCek = either (const dummyCek) id $ decodeCek alg ek + cek = if B.length decryptedCek == B.length dummyCek + then decryptedCek + else dummyCek + claims <- maybe (left BadCrypto) return $ decryptPayload enc cek iv aad tag payload + return (hdr, claims) - where - checkDots = unless (BC.count '.' jwt == 4) $ left (BadDots 4) + _ -> left (BadHeader "Content is not a JWE") doEncode :: MonadRandom m diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/Jose/Jwk.hs new/jose-jwt-0.7.5/Jose/Jwk.hs --- old/jose-jwt-0.7.3/Jose/Jwk.hs 2016-06-01 20:16:46.000000000 +0200 +++ new/jose-jwt-0.7.5/Jose/Jwk.hs 2016-12-26 23:59:55.000000000 +0100 @@ -28,6 +28,7 @@ import Data.Aeson (genericToJSON, Value(..), FromJSON(..), ToJSON(..), withText) import Data.Aeson.Types (Parser, Options (..), defaultOptions) import Data.ByteString (ByteString) +import qualified Data.ByteString as B import Data.Maybe (isNothing) import Data.Text (Text) import qualified Data.Text.Encoding as TE @@ -126,9 +127,9 @@ case (jweAlg hdr, jwk) of (RSA1_5, RsaPrivateJwk {}) -> True (RSA_OAEP, RsaPrivateJwk {}) -> True - (A128KW, SymmetricJwk {}) -> True - (A192KW, SymmetricJwk {}) -> True - (A256KW, SymmetricJwk {}) -> True + (A128KW, SymmetricJwk k _ _ _) -> B.length k == 16 + (A192KW, SymmetricJwk k _ _ _) -> B.length k == 24 + (A256KW, SymmetricJwk k _ _ _) -> B.length k == 32 _ -> False canEncodeJwe :: JweAlg -> Jwk -> Bool @@ -139,9 +140,9 @@ (RSA_OAEP, RsaPublicJwk {}) -> True (RSA1_5, RsaPrivateJwk {}) -> True (RSA_OAEP, RsaPrivateJwk {}) -> True - (A128KW, SymmetricJwk {}) -> True - (A192KW, SymmetricJwk {}) -> True - (A256KW, SymmetricJwk {}) -> True + (A128KW, SymmetricJwk k _ _ _) -> B.length k == 16 + (A192KW, SymmetricJwk k _ _ _) -> B.length k == 24 + (A256KW, SymmetricJwk k _ _ _) -> B.length k == 32 _ -> False keyIdCompatible :: Maybe KeyId -> Jwk -> Bool diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/Jose/Jws.hs new/jose-jwt-0.7.5/Jose/Jws.hs --- old/jose-jwt-0.7.3/Jose/Jws.hs 2016-06-01 20:16:46.000000000 +0200 +++ new/jose-jwt-0.7.5/Jose/Jws.hs 2017-02-17 19:18:40.000000000 +0100 @@ -25,17 +25,16 @@ where import Control.Applicative -import Control.Monad (unless) import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder) import Crypto.Random (MonadRandom) import Data.ByteString (ByteString) import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC import Jose.Types import qualified Jose.Internal.Base64 as B64 import Jose.Internal.Crypto +import qualified Jose.Internal.Parser as P import Jose.Jwa import Jose.Jwk (Jwk (..)) @@ -63,7 +62,7 @@ -> ByteString -> ByteString -> Either JwtError Jwt -hmacEncodeInternal a key st = Jwt <$> (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st +hmacEncodeInternal a key st = Jwt . (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st -- | Decodes and validates an HMAC signed JWS. hmacDecode :: ByteString -- ^ The HMAC key @@ -115,20 +114,13 @@ type JwsVerifier = JwsAlg -> ByteString -> ByteString -> Bool + decode :: JwsVerifier -> ByteString -> Either JwtError Jws decode verify jwt = do - unless (BC.count '.' jwt == 2) $ Left $ BadDots 2 - let (hdrPayload, sig) = spanEndDot jwt - sigBytes <- B64.decode sig - [h, payload] <- mapM B64.decode $ BC.split '.' hdrPayload - hdr <- case parseHeader h of - Right (JwsH jwsHdr) -> return jwsHdr - Right (JweH _) -> Left (BadHeader "Header is for a JWE") - Right UnsecuredH -> Left (BadHeader "Header is for an unsecured JWT") - Left e -> Left e - if verify (jwsAlg hdr) hdrPayload sigBytes - then Right (hdr, payload) - else Left BadSignature - where - spanEndDot bs = let (toDot, end) = BC.spanEnd (/= '.') bs - in (B.init toDot, end) + decodableJwt <- P.parseJwt jwt + case decodableJwt of + P.DecodableJws hdr (P.Payload p) (P.Sig sig) (P.SigTarget signed) -> + if verify (jwsAlg hdr) signed sig + then Right (hdr, p) + else Left BadSignature + _ -> Left (BadHeader "JWT is not a JWS") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/Jose/Jwt.hs new/jose-jwt-0.7.5/Jose/Jwt.hs --- old/jose-jwt-0.7.3/Jose/Jwt.hs 2016-09-22 19:53:29.000000000 +0200 +++ new/jose-jwt-0.7.5/Jose/Jwt.hs 2017-02-18 19:11:26.000000000 +0100 @@ -25,7 +25,7 @@ ) where -import Control.Monad (msum, when, unless, liftM) +import Control.Monad (msum, when, unless) import Control.Monad.Trans (lift) import Control.Monad.Trans.Either import qualified Crypto.PubKey.ECC.ECDSA as ECDSA @@ -37,6 +37,7 @@ import qualified Data.ByteString.Char8 as BC import qualified Jose.Internal.Base64 as B64 +import qualified Jose.Internal.Parser as P import Jose.Types import Jose.Jwk import Jose.Jwa @@ -85,21 +86,20 @@ -> ByteString -- ^ The encoded JWT -> m (Either JwtError JwtContent) -- ^ The decoded JWT payload, if successful decode keySet encoding jwt = runEitherT $ do - let components = BC.split '.' jwt - when (length components < 3) $ left $ BadDots 2 - hdr <- B64.decode (head components) >>= hoistEither . parseHeader - 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 -> do - unless (encoding == Just (JwsEncoding None)) $ left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") - B64.decode (components !! 1) >>= \p -> return [Just (Unsecured p)] - JwsH h -> do - unless (isNothing encoding || encoding == Just (JwsEncoding (jwsAlg h))) $ left (BadAlgorithm "Expected 'alg' doesn't match JWS header") + decodableJwt <- hoistEither (P.parseJwt jwt) + + decodings <- case (decodableJwt, encoding) of + (P.Unsecured p, Just (JwsEncoding None)) -> return [Just (Unsecured p)] + (P.Unsecured _, _) -> left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") + (P.DecodableJws hdr _ _ _, e) -> do + unless (isNothing e || e == Just (JwsEncoding (jwsAlg hdr))) $ + left (BadAlgorithm "Expected 'alg' doesn't match JWS header") + ks <- checkKeys $ filter (canDecodeJws hdr) keySet mapM decodeWithJws ks - JweH h -> do - unless (isNothing encoding || encoding == Just (JweEncoding (jweAlg h) (jweEnc h))) $ left (BadAlgorithm "Expected encoding doesn't match JWE header") + (P.DecodableJwe hdr _ _ _ _ _, e) -> do + unless (isNothing e || e == Just (JweEncoding (jweAlg hdr) (jweEnc hdr))) $ + left (BadAlgorithm "Expected encoding doesn't match JWE header") + ks <- checkKeys $ filter (canDecodeJwe hdr) keySet mapM decodeWithJwe ks case msum decodings of Nothing -> left $ KeyError "None of the keys was able to decode the JWT" @@ -114,7 +114,11 @@ SymmetricJwk kb _ _ _ -> Jws.hmacDecode kb jwt decodeWithJwe :: MonadRandom m => Jwk -> EitherT JwtError m (Maybe JwtContent) - decodeWithJwe k = liftM (either (const Nothing) Just) (lift (Jwe.jwkDecode k jwt)) + decodeWithJwe k = fmap (either (const Nothing) Just) (lift (Jwe.jwkDecode k jwt)) + + checkKeys [] = left $ KeyError "No suitable key was found to decode the JWT" + checkKeys ks = return ks + -- | Convenience function to return the claims contained in a JWT. -- This is required in situations such as client assertion authentication, @@ -132,14 +136,3 @@ return (hdr, claims) where parseClaims bs = maybe (Left BadClaims) Right $ decodeStrict' bs - - -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 - checkKeys [] = left $ KeyError "No suitable key was found to decode the JWT" - checkKeys ks = return ks diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/benchmarks/bench.hs new/jose-jwt-0.7.5/benchmarks/bench.hs --- old/jose-jwt-0.7.3/benchmarks/bench.hs 2016-06-01 20:16:46.000000000 +0200 +++ new/jose-jwt-0.7.5/benchmarks/bench.hs 2017-02-17 02:42:27.000000000 +0100 @@ -1,36 +1,66 @@ -{-# LANGUAGE OverloadedStrings, CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Main where import Criterion.Main import Crypto.Random import Data.Word (Word64) import Jose.Jws +import qualified Jose.Jwe as Jwe import Jose.Jwa import Jose.Jwt +import Jose.Jwk import Keys benchRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64 fstWithRNG = fst . withDRG benchRNG +msg = "The best laid schemes o' mice and men" + main = do - let msg = "The best laid schemes o' mice and men" - rsaE a m = case fstWithRNG (rsaEncode a jwsRsaPrivateKey m) of - Left _ -> error "RSA encode shouldn't fail" - Right (Jwt j) -> j - hmacE a m = case hmacEncode a jwsHmacKey m of - Left _ -> error "HMAC shouldn't fail" - Right (Jwt j) -> j + kwKek <- getRandomBytes 32 >>= \k -> return $ SymmetricJwk k Nothing Nothing Nothing :: IO Jwk + Right rsaOAEPJwe <- Jwe.rsaEncode RSA_OAEP A256GCM jwsRsaPublicKey msg + Right keywrapJwe <- Jwe.jwkEncode A256KW A256GCM kwKek (Claims msg) defaultMain - [ bgroup "JWS" - [ bench "encode RSA256" $ nf (rsaE RS256) msg -#if MIN_VERSION_cryptonite(0,13,0) - , bench "encode RSA384" $ nf (rsaE RS384) msg -#endif - , bench "encode RSA512" $ nf (rsaE RS512) msg - , bench "encode HS256" $ nf (hmacE HS256) msg - , bench "encode HS384" $ nf (hmacE HS384) msg - , bench "encode HS512" $ nf (hmacE HS512) msg - ] + [ benchJwsHmac + , benchJwsRsa + , benchJweKeywrap (unJwt keywrapJwe) kwKek + , benchJweRsa (unJwt rsaOAEPJwe) ] + +benchJweRsa jwe = bgroup "JWE-RSA" + [ bench "decode RSA_OAEP" $ nf rsaDecrypt jwe + ] + where + rsaDecrypt m = case fstWithRNG (Jwe.rsaDecode jwsRsaPrivateKey m) of + Left _ -> error "RSA decode of JWE shouldn't fail" + Right j -> snd j + +benchJweKeywrap jwe jwk = bgroup "JWE-KW" + [ bench "decode A256KW" $ nf keywrapDecode jwe + ] + where + keywrapDecode m = case fstWithRNG (Jwe.jwkDecode jwk m) of + Right (Jwe j) -> snd j + _ -> error "RSA decode of JWE shouldn't fail" + +benchJwsRsa = bgroup "JWS-RSA" + [ bench "encode RSA256" $ nf (rsaE RS256) msg + , bench "encode RSA384" $ nf (rsaE RS384) msg + , bench "encode RSA512" $ nf (rsaE RS512) msg + ] + where + rsaE a m = case fstWithRNG (rsaEncode a jwsRsaPrivateKey m) of + Left _ -> error "RSA encode shouldn't fail" + Right (Jwt j) -> j + +benchJwsHmac = bgroup "JWS-HMAC" + [ bench "encode HS256" $ nf (hmacE HS256) msg + , bench "encode HS384" $ nf (hmacE HS384) msg + , bench "encode HS512" $ nf (hmacE HS512) msg + ] + where + hmacE a m = case hmacEncode a jwsHmacKey m of + Left _ -> error "HMAC shouldn't fail" + Right (Jwt j) -> j diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/jose-jwt.cabal new/jose-jwt-0.7.5/jose-jwt.cabal --- old/jose-jwt-0.7.3/jose-jwt.cabal 2016-09-24 13:12:30.000000000 +0200 +++ new/jose-jwt-0.7.5/jose-jwt.cabal 2017-02-18 20:39:04.000000000 +0100 @@ -1,5 +1,5 @@ Name: jose-jwt -Version: 0.7.3 +Version: 0.7.5 Synopsis: JSON Object Signing and Encryption Library Homepage: http://github.com/tekul/jose-jwt Bug-Reports: http://github.com/tekul/jose-jwt/issues @@ -42,9 +42,11 @@ , Jose.Jwk , Jose.Internal.Base64 , Jose.Internal.Crypto + , Jose.Internal.Parser Other-Modules: Jose.Types Build-Depends: base >= 4.6 && < 5 , aeson >= 0.8.0.2 + , attoparsec >= 0.12.0.0 , bytestring >= 0.9 , cereal >= 0.4 , containers >= 0.4 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/tests/Tests/JweSpec.hs new/jose-jwt-0.7.5/tests/Tests/JweSpec.hs --- old/jose-jwt-0.7.3/tests/Tests/JweSpec.hs 2016-06-01 20:16:46.000000000 +0200 +++ new/jose-jwt-0.7.5/tests/Tests/JweSpec.hs 2017-02-17 02:46:40.000000000 +0100 @@ -25,6 +25,7 @@ import Jose.Jwa import qualified Jose.Jwk as Jwk import Jose.Internal.Crypto +import Jose.Internal.Parser(Tag(..), IV(..)) import qualified Jose.Internal.Base64 as B64 -------------------------------------------------------------------------------- @@ -77,6 +78,13 @@ Right ct = B64.decode payload withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto + it "a truncated auth tag returns BadCrypto" $ do + let [hdr, ek, iv, payload, tag] = BC.split '.' a1 + Right tagBytes = B64.decode tag + badTag = B64.encode $ BC.take 2 tagBytes + withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, ek, iv, payload, badTag])) @?= Left BadCrypto + + it "a truncated IV returns BadCrypto" $ do let (fore, aft) = BC.breakSubstring (B64.encode a1iv) a1 newIv = B64.encode (B.tail a1iv) @@ -91,14 +99,14 @@ withDRG (RNG a2seed) (rsaEncrypt a2PubKey RSA1_5 a2cek) @?= (Right a2jweKey, RNG "") it "encrypts the payload to the expected ciphertext and authentication tag" $ - encryptPayload A128CBC_HS256 a2cek a2iv aad a2Payload @?= Just (a2Tag, a2Ciphertext) + encryptPayload A128CBC_HS256 a2cek a2iv aad a2Payload @?= Just (AuthTag (BA.convert a2Tag), a2Ciphertext) it "encodes the payload to the expected JWT" $ withDRG (RNG $ B.concat [a2cek, a2iv, a2seed]) (Jwe.rsaEncode RSA1_5 A128CBC_HS256 a2PubKey a2Payload) @?= (Right (Jwt a2), RNG "") it "decrypts the ciphertext to the correct payload" $ - decryptPayload A128CBC_HS256 a2cek a2iv aad a2Tag a2Ciphertext @?= Just a2Payload + decryptPayload A128CBC_HS256 a2cek (IV16 a2iv) aad (Tag16 a2Tag) a2Ciphertext @?= Just a2Payload it "decodes the JWT to the expected header and payload" $ withBlinder (Jwe.rsaDecode a2PrivKey a2) @?= Right (a2Header, a2Payload) @@ -147,7 +155,7 @@ jweRoundTrip :: RNG -> JWEAlgs -> [Word8] -> Bool jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (Jwe (defJweHdr {jweAlg = a, jweEnc = e}, bs)) where - jwks = [a1jwk, a2jwk, a3jwk] >>= \j -> let Just jwk = decodeStrict' j in [jwk] + jwks = [a1jwk, a2jwk, a3jwk, aes192jwk, aes256jwk] >>= \j -> let Just jwk = decodeStrict' j in [jwk] bs = B.pack msg encodeDecode = fst (withDRG blinderRNG (decode jwks Nothing encoded)) Right encoded = unJwt <$> fst (withDRG g (encode jwks (JweEncoding a e) (Claims bs))) @@ -156,7 +164,7 @@ -- A decidedly non-random, random number generator which allows specific -- sequences of bytes to be supplied which match the JWE test data. -data RNG = RNG B.ByteString deriving (Eq, Show) +newtype RNG = RNG B.ByteString deriving (Eq, Show) genBytes :: BA.ByteArray ba => Int -> RNG -> (ba, RNG) genBytes 0 g = (BA.empty, g) @@ -221,7 +229,7 @@ a2Ciphertext = B.pack [40, 57, 83, 181, 119, 33, 133, 148, 198, 185, 243, 24, 152, 230, 6, 75, 129, 223, 127, 19, 210, 82, 183, 230, 168, 33, 215, 104, 143, 112, 56, 102] -a2Tag = AuthTag $ BA.pack [246, 17, 244, 190, 4, 95, 98, 3, 231, 0, 115, 157, 242, 203, 100, 191] +a2Tag = B.pack [246, 17, 244, 190, 4, 95, 98, 3, 231, 0, 115, 157, 242, 203, 100, 191] Right a2jweKey = B64.decode $ BC.pack "UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A" @@ -242,6 +250,11 @@ a3jwk = "{\"kty\":\"oct\", \"k\":\"GawgguFyGrWKav7AX4VKUg\"}" +-- We need keys that are valid for AES192 and AES256 for quickcheck tests +aes192jwk = "{\"kty\":\"oct\", \"k\":\"FatNm7ez26tyPGsXdaqhYHtvThX0jSAA\"}" +aes256jwk = "{\"kty\":\"oct\", \"k\":\"1MeiHdxK8CQBsmjgOM8SCxg06MTjFzG7sFa7EnDCJzo\"}" + + a3cek = B.pack [4, 211, 31, 197, 84, 157, 252, 254, 11, 100, 157, 250, 63, 170, 106, 206, 107, 124, 212, 45, 111, 107, 9, 219, 200, 177, 0, 240, 143, 156, 44, 207] a3iv = B.pack [3, 22, 60, 12, 43, 67, 104, 105, 108, 108, 105, 99, 111, 116, 104, 101] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/jose-jwt-0.7.3/tests/Tests/JwsSpec.hs new/jose-jwt-0.7.5/tests/Tests/JwsSpec.hs --- old/jose-jwt-0.7.3/tests/Tests/JwsSpec.hs 2016-06-01 20:16:46.000000000 +0200 +++ new/jose-jwt-0.7.5/tests/Tests/JwsSpec.hs 2017-02-17 02:02:22.000000000 +0100 @@ -77,11 +77,11 @@ fstWithRNG (decode [k31] Nothing a31) @?= fmap Jws a31decoded context "when using an unsecured JWT" $ do - it "returns an error if alg is unset" $ + it "returns an error if chosen alg is unset" $ fstWithRNG (decode [] Nothing jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") - it "returns an error if alg is is not 'none'" $ + it "returns an error if chosen alg is not 'none'" $ fstWithRNG (decode [] (Just (JwsEncoding RS256)) jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") - it "decodes the JWT to the expected header and payload" $ + it "decodes the JWT to the expected header and payload if chosen alg is 'none'" $ fstWithRNG (decode [] (Just (JwsEncoding None)) jwt61) @?= Right (Unsecured jwt61Payload)
