jose-jwt 0.7.4 → 0.7.5
raw patch · 9 files changed
+281/−117 lines, 9 filesdep +attoparsecPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: attoparsec
API changes (from Hackage documentation)
- Jose.Internal.Crypto: decryptPayload :: Enc -> ByteString -> ByteString -> ByteString -> AuthTag -> ByteString -> Maybe ByteString
+ Jose.Internal.Crypto: decryptPayload :: Enc -> ByteString -> IV -> ByteString -> Tag -> ByteString -> Maybe ByteString
Files
- CHANGELOG.md +5/−0
- Jose/Internal/Crypto.hs +25/−23
- Jose/Internal/Parser.hs +142/−0
- Jose/Jwe.hs +16/−26
- Jose/Jws.hs +10/−18
- Jose/Jwt.hs +20/−27
- benchmarks/bench.hs +48/−18
- jose-jwt.cabal +3/−1
- tests/Tests/JweSpec.hs +12/−4
CHANGELOG.md view
@@ -1,3 +1,8 @@+0.7.5+-----++* A JWT parser is now used to separate parsing and decoding into separaate stages (internal change).+ 0.7.4 -----
Jose/Internal/Crypto.hs view
@@ -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
+ Jose/Internal/Parser.hs view
@@ -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
Jose/Jwe.hs view
@@ -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
Jose/Jws.hs view
@@ -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")
Jose/Jwt.hs view
@@ -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,8 +114,12 @@ 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, -- where the contents of the JWT may be required in order to work out@@ -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
benchmarks/bench.hs view
@@ -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
jose-jwt.cabal view
@@ -1,5 +1,5 @@ Name: jose-jwt-Version: 0.7.4+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
tests/Tests/JweSpec.hs view
@@ -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)@@ -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"