jose-jwt 0.6.2 → 0.7

raw patch · 12 files changed

+607/−427 lines, 12 filesdep +cryptonitedep +memorydep −base64-bytestringdep −byteabledep −cipher-aesdep ~unordered-containersdep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptonite, memory

Dependencies removed: base64-bytestring, byteable, cipher-aes, cprng-aes, crypto-cipher-types, crypto-numbers, crypto-pubkey, crypto-pubkey-types, crypto-random, cryptohash

Dependency ranges changed: unordered-containers, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−1
• Jose/Internal/Base64.hs +6/−19
• Jose/Internal/Crypto.hs +209/−112
• Jose/Jwa.hs +7/−9
• Jose/Jwe.hs +83/−60
• Jose/Jwk.hs +64/−41
• Jose/Jws.hs +18/−22
• Jose/Jwt.hs +28/−32
• jose-jwt.cabal +16/−33
• tests/Tests/JweSpec.hs +96/−68
• tests/Tests/JwkSpec.hs +56/−9
• tests/Tests/JwsSpec.hs +17/−21

@@ -1,3 +1,10 @@+0.7+---++* Add support for AES key wrap in JWEs.+* Support A192GCM and A192CBC-HS384 algorithms.+* Switch to cryptonite library.+ 0.6.2 ----- @@ -53,4 +60,3 @@  * New support for JWS validation using elliptic curve algorithms. * Added `Jwt.encode` function which takes a JWK argument, allowing key data (currently the key ID) to be encoded in the token header.-

@@ -6,28 +6,15 @@ module Jose.Internal.Base64 where  import Control.Monad.Error-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BC-import qualified Data.ByteString.Base64.URL as B64+import Data.ByteArray+import Data.ByteArray.Encoding  import Jose.Types  -- | Base64 URL encode without padding.-encode :: ByteString -> ByteString-encode = strip . B64.encode-  where-    strip "" = ""-    strip bs = case BC.last bs of-      '=' -> strip $ B.init bs-      _   -> bs+encode :: (ByteArrayAccess input, ByteArray output) => input -> output+encode = convertToBase Base64URLUnpadded  -- | Base64 decode.-decode :: MonadError JwtError m => ByteString -> m ByteString-decode bs = either (throwError . Base64Error) return $ B64.decode bsPadded-  where-    bsPadded = case B.length bs `mod` 4 of-      3 -> bs `BC.snoc` '='-      2 -> bs `B.append` "=="-      _ -> bs-+decode :: (ByteArrayAccess input, ByteArray output, MonadError JwtError m) => input -> m output+decode bs = either (throwError . Base64Error) return $ convertFromBase Base64URLUnpadded bs

@@ -15,26 +15,31 @@     , encryptPayload     , decryptPayload     , generateCmkAndIV+    , keyWrap+    , keyUnwrap     , pad     , unpad     ) where -import           Control.Applicative-import           Crypto.Cipher.Types (AuthTag(..))-import           Control.Monad.Error++import           Control.Monad (when, unless)+import           Crypto.Error+import           Crypto.Cipher.AES+import           Crypto.Cipher.Types+import           Crypto.Hash.Algorithms import           Crypto.Number.Serialize (os2ip) import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15 import qualified Crypto.PubKey.RSA.OAEP as OAEP-import           Crypto.Random (CPRG, cprgGenerate)-import qualified Crypto.Cipher.AES as AES-import           Crypto.PubKey.HashDescr-import           Crypto.MAC.HMAC (hmac)-import           Data.Byteable (constEqBytes)+import           Crypto.Random (MonadRandom, getRandomBytes)+import           Crypto.MAC.HMAC (HMAC (..), hmac)+import           Data.Bits (xor)+import qualified Data.ByteArray as BA import           Data.ByteString (ByteString) import qualified Data.ByteString as B+import           Data.Either.Combinators import qualified Data.Serialize as Serialize import qualified Data.Text as T import           Data.Word (Word64, Word8)@@ -46,10 +51,12 @@ hmacSign :: JwsAlg      -- ^ HMAC algorithm to use          -> ByteString  -- ^ Key          -> ByteString  -- ^ The message/content-         -> Either JwtError ByteString  -- ^ HMAC output-hmacSign a k m = do-    hash <- maybe (Left $ BadAlgorithm $ T.pack $ "Not an HMAC algorithm: " ++ show a) return $ lookup a hmacHashes-    return $ hmac (hashFunction hash) 64 k m+         -> Either JwtError ByteString -- ^ HMAC output+hmacSign a k m = case a of+    HS256 -> Right $ BA.convert (hmac k m :: HMAC SHA256)+    HS384 -> Right $ BA.convert (hmac k m :: HMAC SHA384)+    HS512 -> Right $ BA.convert (hmac k m :: HMAC SHA512)+    _     -> Left $ BadAlgorithm $ T.pack $ "Not an HMAC algorithm: " ++ show a  -- | Verify the HMAC for a given message. -- Returns false if the MAC is incorrect or the 'Alg' is not an HMAC.@@ -58,7 +65,7 @@            -> ByteString  -- ^ The message/content            -> ByteString  -- ^ The signature to check            -> Bool        -- ^ Whether the signature is correct-hmacVerify a key msg sig = either (const False) (`constEqBytes` sig) $ hmacSign a key msg+hmacVerify a key msg sig = either (const False) (`BA.constEq` sig) $ hmacSign a key msg  -- | Sign a message using an RSA private key. --@@ -70,10 +77,13 @@         -> RSA.PrivateKey     -- ^ Private key to sign with         -> ByteString         -- ^ Message to sign         -> Either JwtError ByteString    -- ^ The signature-rsaSign blinder a key msg = do-    hash <- lookupRSAHash a-    either (const $ Left BadCrypto) Right $ PKCS15.sign blinder hash key msg+rsaSign blinder a key msg = case a of+    RS256 -> go SHA256+    RS384 -> go SHA384+    RS512 -> go SHA512+    _     -> Left . BadAlgorithm . T.pack $ "Not an RSA algorithm: " ++ show a   where+    go h = either (const $ Left BadCrypto) Right $ PKCS15.sign blinder (Just h) key msg  -- | Verify the signature for a message using an RSA public key. --@@ -84,9 +94,13 @@           -> ByteString    -- ^ The message/content           -> ByteString    -- ^ The signature to check           -> Bool          -- ^ Whether the signature is correct-rsaVerify a key msg sig = case lookupRSAHash a of-    Right hash -> PKCS15.verify hash key msg sig-    _          -> False+rsaVerify a key msg sig = case a of+    RS256 -> go SHA256+    RS384 -> go SHA384+    RS512 -> go SHA512+    _     -> False+  where+    go h = PKCS15.verify (Just h) key msg sig  -- | Verify the signature for a message using an EC public key. --@@ -97,136 +111,152 @@          -> ByteString      -- ^ The message/content          -> ByteString      -- ^ The signature to check          -> Bool            -- ^ Whether the signature is correct-ecVerify a key msg sig = case lookupECHash a of-    Just hash -> let (r, s) = B.splitAt (B.length sig `div` 2) sig-                 in  ECDSA.verify hash key (ECDSA.Signature (os2ip r) (os2ip s)) msg-    Nothing   -> False--hmacHashes :: [(JwsAlg, HashDescr)]-hmacHashes = [(HS256, hashDescrSHA256), (HS384, hashDescrSHA384), (HS512, hashDescrSHA512)]--lookupECHash :: JwsAlg -> Maybe HashFunction-lookupECHash alg = hashFunction <$> case alg of-    ES256 -> Just hashDescrSHA256-    ES384 -> Just hashDescrSHA384-    ES512 -> Just hashDescrSHA512-    _     -> Nothing--lookupRSAHash :: JwsAlg -> Either JwtError HashDescr-lookupRSAHash alg = case alg of-    RS256 -> Right hashDescrSHA256-    RS384 -> Right hashDescrSHA384-    RS512 -> Right hashDescrSHA512-    _     -> Left . BadAlgorithm . T.pack $ "Not an RSA algorithm: " ++ show alg+ecVerify a key msg sig = case a of+    ES256 -> go SHA256+    ES384 -> go SHA384+    ES512 -> go SHA512+    _     -> False+  where+    (r, s) = B.splitAt (B.length sig `div` 2) sig+    ecSig  = ECDSA.Signature (os2ip r) (os2ip s)+    go h   = ECDSA.verify h key ecSig msg  -- | Generates the symmetric key (content management key) and IV -- -- Used to encrypt a message.-generateCmkAndIV :: CPRG g-                 => g   -- ^ The random number generator-                 -> Enc -- ^ The encryption algorithm to be used-                 -> ((B.ByteString, B.ByteString), g) -- ^ The key, IV and generator-generateCmkAndIV g e = ((cmk, iv), g'')+generateCmkAndIV :: MonadRandom m+                 => Enc -- ^ The encryption algorithm to be used+                 -> m (B.ByteString, B.ByteString) -- ^ The key, IV+generateCmkAndIV e = do+    cmk <- getRandomBytes (keySize e)+    iv  <- getRandomBytes (ivSize e)   -- iv for aes gcm or cbc+    return (cmk, iv)   where-    (cmk, g') = cprgGenerate (keySize e) g-    (iv, g'') = cprgGenerate (ivSize e) g'  -- iv for aes gcm or cbc--keySize :: Enc -> Int-keySize A128GCM = 16-keySize A256GCM = 32-keySize A128CBC_HS256 = 32-keySize A256CBC_HS512 = 64+    keySize A128GCM = 16+    keySize A192GCM = 24+    keySize A256GCM = 32+    keySize A128CBC_HS256 = 32+    keySize A192CBC_HS384 = 48+    keySize A256CBC_HS512 = 64 -ivSize :: Enc -> Int-ivSize A128GCM = 12-ivSize A256GCM = 12-ivSize _       = 16+    ivSize A128GCM = 12+    ivSize A192GCM = 12+    ivSize A256GCM = 12+    ivSize _       = 16  -- | Encrypts a message (typically a symmetric key) using RSA.-rsaEncrypt :: CPRG g-           => g                  -- ^ Random number generator-           -> JweAlg             -- ^ The algorithm (either @RSA1_5@ or @RSA_OAEP@)-           -> RSA.PublicKey      -- ^ The encryption key-           -> B.ByteString       -- ^ The message to encrypt-           -> (B.ByteString, g)  -- ^ The encrypted messaged and new generator-rsaEncrypt gen a pubKey content = (ct, g')+rsaEncrypt :: MonadRandom m+    => RSA.PublicKey      -- ^ The encryption key+    -> JweAlg             -- ^ The algorithm (either @RSA1_5@ or @RSA_OAEP@)+    -> B.ByteString       -- ^ The message to encrypt+    -> m (Either JwtError B.ByteString)     -- ^ The encrypted message+rsaEncrypt k a bs = case a of+    RSA1_5   -> mapErr (PKCS15.encrypt k bs)+    RSA_OAEP -> mapErr (OAEP.encrypt (OAEP.defaultOAEPParams SHA1) k bs)+    _        -> return (Left (BadAlgorithm "Not an RSA algorithm"))   where-    encrypt = case a of-        RSA1_5   -> PKCS15.encrypt gen-        RSA_OAEP -> OAEP.encrypt gen oaepParams--- TODO: Check that we can't cause any errors here with our RSA public key-    (Right ct, g') = encrypt pubKey content+    mapErr = fmap (mapLeft (const BadCrypto))  -- | Decrypts an RSA encrypted message. rsaDecrypt :: Maybe RSA.Blinder-           -> JweAlg                        -- ^ The RSA algorithm to use            -> RSA.PrivateKey                -- ^ The decryption key+           -> JweAlg                        -- ^ The RSA algorithm to use            -> B.ByteString                  -- ^ The encrypted content            -> Either JwtError B.ByteString  -- ^ The decrypted key-rsaDecrypt blinder a rsaKey jweKey = either (const $ throwError BadCrypto) return $ decrypt rsaKey jweKey+rsaDecrypt blinder rsaKey a jweKey = case a of+    RSA1_5   -> mapErr (PKCS15.decrypt blinder rsaKey jweKey)+    RSA_OAEP -> mapErr (OAEP.decrypt blinder (OAEP.defaultOAEPParams SHA1) rsaKey jweKey)+    _        -> Left (BadAlgorithm "Not an RSA algorithm")   where-    decrypt = case a of-        RSA1_5   -> PKCS15.decrypt blinder-        RSA_OAEP -> OAEP.decrypt blinder oaepParams+    mapErr = mapLeft (const BadCrypto) -oaepParams :: OAEP.OAEPParams-oaepParams = OAEP.defaultOAEPParams (hashFunction hashDescrSHA1)+-- Dummy type to constrain Cipher type+data C c = C +initCipher :: BlockCipher c => C c -> B.ByteString -> Maybe c+initCipher _ k = maybeCryptoError $ cipherInit k+ -- | Decrypt an AES encrypted message.-decryptPayload :: MonadError JwtError m-               => Enc        -- ^ Encryption algorithm+decryptPayload :: Enc        -- ^ Encryption algorithm                -> ByteString -- ^ Content management key                -> ByteString -- ^ IV                -> ByteString -- ^ Additional authentication data-               -> ByteString -- ^ The integrity protection value to be checked+               -> AuthTag    -- ^ The integrity protection value to be checked                -> ByteString -- ^ The encrypted JWT payload-               -> m ByteString-decryptPayload e cek iv aad sig ct = do-    (plaintext, tag) <- case e of-        A128GCM        -> decryptedGCM-        A256GCM        -> decryptedGCM-        A128CBC_HS256  -> decryptedCBC 16 hashDescrSHA256-        A256CBC_HS512  -> decryptedCBC 32 hashDescrSHA512-    if tag == AuthTag sig-      then return plaintext-      else throwError BadSignature+               -> 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   where-    decryptedGCM = return $ AES.decryptGCM (AES.initAES cek) iv aad ct+    (cbcMacKey, cbcEncKey) = B.splitAt (B.length cek `div` 2) cek+    al = fromIntegral (B.length aad) * 8 :: Word64 -    decryptedCBC l h = do-      unless (B.length ct `mod` 16 == 0) $ throwError BadCrypto-      let (macKey, encKey) = B.splitAt (B.length cek `div` 2) cek-      let al = fromIntegral (B.length aad) * 8 :: Word64-      plaintext <- unpad $ AES.decryptCBC (AES.initAES encKey) iv ct-      let mac = authTag l h macKey $ B.concat [aad, iv, ct, Serialize.encode al]-      return (plaintext, mac)+    doGCM :: BlockCipher c => C c -> Maybe ByteString+    doGCM c = do+        cipher <- initCipher c cek+        aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv)+        aeadSimpleDecrypt aead aad ct (AuthTag $ BA.convert sig) +    doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> a -> Int -> Maybe ByteString+    doCBC c a tagLen = do+        checkMac a tagLen+        cipher <- 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++    doMac :: HashAlgorithm a => a -> HMAC a+    doMac _ = hmac cbcMacKey $ B.concat [aad, iv, ct, Serialize.encode al]+ -- | Encrypt a message using AES. encryptPayload :: Enc                   -- ^ Encryption algorithm                -> ByteString            -- ^ Content management key                -> ByteString            -- ^ IV                -> ByteString            -- ^ Additional authenticated data                -> ByteString            -- ^ The message/JWT claims-               -> (ByteString, AuthTag) -- ^ Ciphertext claims and signature tag+               -> Maybe (AuthTag, ByteString) -- ^ Ciphertext claims and signature tag encryptPayload e cek iv aad msg = case e of-    A128GCM        -> aesgcm-    A256GCM        -> aesgcm-    A128CBC_HS256  -> (aescbc, sig 16 hashDescrSHA256)-    A256CBC_HS512  -> (aescbc, sig 32 hashDescrSHA512)+    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   where-    aesgcm = AES.encryptGCM (AES.initAES cek) iv aad msg-    (macKey, encKey) = B.splitAt (B.length cek `div` 2) cek-    aescbc = AES.encryptCBC (AES.initAES encKey) iv (pad msg)-    al     = fromIntegral (B.length aad) * 8 :: Word64-    sig l h = authTag l h macKey $ B.concat [aad, iv, aescbc, Serialize.encode al]+    (cbcMacKey, cbcEncKey) = B.splitAt (B.length cek `div` 2) cek+    al = fromIntegral (B.length aad) * 8 :: Word64 -authTag :: Int -> HashDescr -> ByteString -> ByteString -> AuthTag-authTag l h k m = AuthTag $ B.take l $ hmac (hashFunction h) 64 k m+    doGCM :: BlockCipher c => C c -> Maybe (AuthTag, ByteString)+    doGCM c = do+        cipher <- initCipher c cek+        aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv)+        return $ aeadSimpleEncrypt aead aad msg 16 -unpad :: MonadError JwtError m => ByteString -> m ByteString+    doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> a -> Int -> Maybe (AuthTag, ByteString)+    doCBC c a tagLen = do+        cipher <- initCipher c cbcEncKey+        iv'    <- makeIV iv+        let ct = cbcEncrypt cipher iv' (pad msg)+            mac = doMac a ct+            tag = BA.take tagLen (BA.convert mac)+        return (AuthTag tag, ct)++    doMac :: HashAlgorithm a => a -> ByteString -> HMAC a+    doMac _ ct = hmac cbcMacKey $ B.concat [aad, iv, ct, Serialize.encode al]++unpad :: ByteString -> Maybe ByteString unpad bs-    | padLen > 16 || padLen /= B.length padding = throwError BadCrypto-    | B.any (/= padByte) padding = throwError BadCrypto+    | padLen > 16 || padLen /= B.length padding = Nothing+    | B.any (/= padByte) padding = Nothing     | otherwise = return pt   where     len     = B.length bs@@ -241,3 +271,70 @@     padByte       = fromIntegral $ 16 - lastBlockSize :: Word8     padding       = B.replicate (fromIntegral padByte) padByte +-- Key wrapping and unwrapping functions++-- | <https://tools.ietf.org/html/rfc3394#section-2.2.1>+keyWrap :: JweAlg -> ByteString -> ByteString -> Either JwtError ByteString+keyWrap alg kek cek = case alg of+    A128KW -> doKeyWrap (C :: C AES128)+    A192KW -> doKeyWrap (C :: C AES192)+    A256KW -> doKeyWrap (C :: C AES256)+    _      -> Left (BadAlgorithm "Not a keywrap algorithm")+  where+    l = B.length cek+    n = l `div` 8+    iv = BA.replicate 8 166 :: ByteString++    doKeyWrap c = do+        when (l < 16 || l `mod` 8 /= 0) (Left (KeyError "Invalid content key"))+        cipher <- maybe (Left (KeyError "cipher initialization failed")) return $ initCipher c kek+        let p = toBlocks cek+            (r0, r) = foldl (doRound (ecbEncrypt cipher) 1) (iv, p) [0..5]+        Right $ B.concat (r0 : r)++    doRound _ _  (a, []) _ = (a, [])+    doRound enc i (a, r:rs) j =+        let b  = enc $ B.concat [a, r]+            t  = fromIntegral ((n*j) + i) :: Word8+            a' = txor t (B.take 8 b)+            r' = B.drop 8 b+            next = doRound enc (i+1) (a', rs) j+        in (fst next, r' : snd next)++    txor t b = B.snoc (B.init b) (B.last b `xor` t)++toBlocks :: ByteString -> [ByteString]+toBlocks bytes+    | bytes == B.empty = []+    | otherwise    = let (b, bs') = B.splitAt 8 bytes+                        in  b : toBlocks bs'++keyUnwrap :: ByteString -> JweAlg -> ByteString -> Either JwtError ByteString+keyUnwrap kek alg encK = case alg of+    A128KW -> doUnWrap (C :: C AES128)+    A192KW -> doUnWrap (C :: C AES192)+    A256KW -> doUnWrap (C :: C AES256)+    _      -> Left (BadAlgorithm "Not a keywrap algorithm")+  where+    l = B.length encK+    n = (l `div` 8) - 1+    iv = BA.replicate 8 166 :: ByteString++    doUnWrap c = do+        when (l < 24 || l `mod` 8 /= 0) (Left BadCrypto)+        cipher <- maybe (Left BadCrypto) return $ initCipher c kek+        let r = toBlocks encK+            (p0, p) = foldl (doRound (ecbDecrypt cipher) n) (head r, reverse (tail r)) (reverse [0..5])+        unless (p0 == iv) (Left BadCrypto)+        Right $ B.concat (reverse p)++    doRound _ _  (a, []) _ = (a, [])+    doRound dec i (a, r:rs) j =+        let b  = dec $ B.concat [txor t a, r]+            t  = fromIntegral ((n*j) + i) :: Word8+            a' = B.take 8 b+            r' = B.drop 8 b+            next = doRound dec (i-1) (a', rs) j+        in (fst next, r' : snd next)++    txor t b = B.snoc (B.init b) (B.last b `xor` t)

@@ -20,20 +20,19 @@ data Alg = Signed JwsAlg | Encrypted JweAlg deriving (Eq, Show)  -- | A subset of the signature algorithms from the--- <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-31#section-3 JWA Spec>.+-- <https://tools.ietf.org/html/rfc7518#section-3 JWA Spec>. data JwsAlg = None | HS256 | HS384 | HS512 | RS256 | RS384 | RS512 | ES256 | ES384 | ES512 deriving (Eq, Show, Read)  -- | A subset of the key management algorithms from the--- <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-31#section-5 JWA Spec>.-data JweAlg = RSA1_5 | RSA_OAEP deriving (Eq, Show, Read)+-- <https://tools.ietf.org/html/rfc7518#section-4 JWA Spec>.+data JweAlg = RSA1_5 | RSA_OAEP | A128KW | A192KW | A256KW deriving (Eq, Show, Read)  -- | Content encryption algorithms from the--- <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-31#section-5 JWA Spec>.--- The optional algorithms A192CBC-HS384 and A192GCM are not supported yet.-data Enc = A128CBC_HS256 | A256CBC_HS512 | A128GCM | A256GCM deriving (Eq, Show)+-- <https://tools.ietf.org/html/rfc7518#section-5 JWA Spec>.+data Enc = A128CBC_HS256 | A192CBC_HS384 | A256CBC_HS512 | A128GCM | A192GCM | A256GCM deriving (Eq, Show)  algs :: [(Text, Alg)]-algs = [("none", Signed None), ("HS256", Signed HS256), ("HS384", Signed HS384), ("HS512", Signed HS512), ("RS256", Signed RS256), ("RS384", Signed RS384), ("RS512", Signed RS512), ("ES256", Signed ES256), ("ES384", Signed ES384), ("ES512", Signed ES512), ("RSA1_5", Encrypted RSA1_5), ("RSA-OAEP", Encrypted RSA_OAEP)]+algs = [("none", Signed None), ("HS256", Signed HS256), ("HS384", Signed HS384), ("HS512", Signed HS512), ("RS256", Signed RS256), ("RS384", Signed RS384), ("RS512", Signed RS512), ("ES256", Signed ES256), ("ES384", Signed ES384), ("ES512", Signed ES512), ("RSA1_5", Encrypted RSA1_5), ("RSA-OAEP", Encrypted RSA_OAEP), ("A128KW", Encrypted A128KW), ("A192KW", Encrypted A192KW), ("A256KW", Encrypted A256KW)]  algName :: Alg -> Text algName a = fromJust $ lookup a algNames@@ -42,7 +41,7 @@ algNames = map swap algs  encs :: [(Text, Enc)]-encs = [("A128CBC-HS256", A128CBC_HS256), ("A256CBC-HS512", A256CBC_HS512), ("A128GCM", A128GCM), ("A256GCM", A256GCM)]+encs = [("A128CBC-HS256", A128CBC_HS256), ("A256CBC-HS512", A256CBC_HS512), ("A192CBC-HS384", A192CBC_HS384), ("A128GCM", A128GCM), ("A192GCM", A192GCM), ("A256GCM", A256GCM)]  encName :: Enc -> Text encName e = fromJust $ lookup e encNames@@ -79,4 +78,3 @@  instance ToJSON Enc where     toJSON = String . encName-

@@ -6,27 +6,29 @@ -- -- >>> import Jose.Jwe -- >>> import Jose.Jwa--- >>> import Crypto.Random.AESCtr--- >>> g <- makeSystem+-- >>> import Crypto.Random+-- >>> g <- drgNew -- >>> import Crypto.PubKey.RSA--- >>> let ((kPub, kPr), g') = generate g 512 65537--- >>> let (Jwt jwt, g'') = rsaEncode g' RSA_OAEP A128GCM kPub "secret claims"--- >>> fst $ rsaDecode g'' kPr jwt+-- >>> let ((kPub, kPr), g') = withDRG g (generate 512 65537)+-- >>> let (Right (Jwt jwt), g'') = withDRG g' (rsaEncode RSA_OAEP A128GCM kPub "secret claims")+-- >>> fst $ withDRG g'' (rsaDecode kPr jwt) -- Right (JweHeader {jweAlg = RSA_OAEP, jweEnc = A128GCM, jweTyp = Nothing, jweCty = Nothing, jweZip = Nothing, jweKid = Nothing},"secret claims")  module Jose.Jwe     ( jwkEncode+    , jwkDecode     , rsaEncode     , rsaDecode     ) where -import Control.Arrow (first)-import Crypto.Cipher.Types (AuthTag(..))+import Control.Monad (unless)+import Control.Monad.Trans (lift) import Control.Monad.Trans.Either+import Crypto.Cipher.Types (AuthTag(..)) import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder, private_pub)-import Control.Monad.State.Strict-import Crypto.Random.API (CPRG)+import Crypto.Random (MonadRandom)+import qualified Data.ByteArray as BA import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC@@ -39,59 +41,44 @@ -- | Create a JWE using a JWK. -- The key and algorithms must be consistent or an error -- will be returned.-jwkEncode :: CPRG g-          => g                               -- ^ Random number generator-          -> JweAlg                          -- ^ Algorithm to use for key encryption-          -> Enc                             -- ^ Content encryption algorithm-          -> Jwk                             -- ^ The key to use to encrypt the content key-          -> Payload                         -- ^ The token content (claims or nested JWT)-          -> (Either JwtError Jwt, g)        -- ^ The encoded JWE if successful-jwkEncode rng a e jwk payload = case jwk of-    RsaPublicJwk kPub kid _ _ -> first Right $ rsaEncodeInternal rng (hdr kid) kPub bytes-    RsaPrivateJwk kPr kid _ _ -> first Right $ rsaEncodeInternal rng (hdr kid) (private_pub kPr) bytes-    _                         -> (Left $ KeyError "Only RSA JWKs can be used for encoding", rng)+jwkEncode :: MonadRandom m+    => JweAlg                          -- ^ Algorithm to use for key encryption+    -> Enc                             -- ^ Content encryption algorithm+    -> Jwk                             -- ^ The key to use to encrypt the content key+    -> Payload                         -- ^ The token content (claims or nested JWT)+    -> m (Either JwtError Jwt)         -- ^ The encoded JWE if successful+jwkEncode a e jwk payload = runEitherT $ case jwk of+    RsaPublicJwk kPub kid _ _ -> doEncode (hdr kid) (doRsa kPub) bytes+    RsaPrivateJwk kPr kid _ _ -> doEncode (hdr kid) (doRsa (private_pub kPr)) bytes+    SymmetricJwk  kek kid _ _ -> doEncode (hdr kid) (hoistEither . keyWrap a kek) bytes+    _                         -> left $ KeyError "JWK cannot encode a JWE"   where+    doRsa kPub = EitherT . rsaEncrypt kPub a     hdr kid = defJweHdr {jweAlg = a, jweEnc = e, jweKid = kid, jweCty = contentType}     (contentType, bytes) = case payload of         Claims c       -> (Nothing, c)         Nested (Jwt b) -> (Just "JWT", b) --- | Creates a JWE.-rsaEncode :: CPRG g-          => g               -- ^ Random number generator-          -> JweAlg          -- ^ RSA algorithm to use (@RSA_OAEP@ or @RSA1_5@)-          -> Enc             -- ^ Content encryption algorithm-          -> PublicKey       -- ^ RSA key to encrypt with-          -> ByteString      -- ^ The JWT claims (content)-          -> (Jwt, g) -- ^ The encoded JWE and new generator-rsaEncode rng a e = rsaEncodeInternal rng (defJweHdr {jweAlg = a, jweEnc = e})--rsaEncodeInternal :: CPRG g-                  => g-                  -> JweHeader-                  -> PublicKey-                  -> ByteString-                  -> (Jwt, g)-rsaEncodeInternal rng h pubKey claims = (Jwt jwe, rng'')-  where-    a   = jweAlg h-    e   = jweEnc h-    hdr = encodeHeader h-    ((cmk, iv), rng') = generateCmkAndIV rng e-    (jweKey, rng'') = rsaEncrypt rng' a pubKey cmk-    aad = B64.encode hdr-    (ct, AuthTag sig) = encryptPayload e cmk iv aad claims-    jwe = B.intercalate "." $ map B64.encode [hdr, jweKey, iv, ct, sig]---- | Decrypts a JWE.-rsaDecode :: CPRG g-          => g-          -> PrivateKey               -- ^ Decryption key-          -> ByteString               -- ^ The encoded JWE-          -> (Either JwtError Jwe, g) -- ^ The decoded JWT, unless an error occurs-rsaDecode rng pk jwt = flip runState rng $ runEitherT $ do-    blinder <- state $ \g -> generateBlinder g (public_n $ private_pub pk)+-- | Try to decode a JWE using a JWK.+-- If the key type does not match the content encoding algorithm,+-- an error will be returned.+jwkDecode :: MonadRandom m+    => Jwk+    -> ByteString+    -> m (Either JwtError JwtContent)+jwkDecode jwk jwt = runEitherT $ case jwk of+    RsaPrivateJwk kPr _ _ _ -> do+        blinder <- lift $ generateBlinder (public_n $ private_pub kPr)+        e <- doDecode (rsaDecrypt (Just blinder) kPr) jwt+        return (Jwe e)+    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@@ -103,17 +90,53 @@         Left e              -> left e     let alg = jweAlg hdr         enc = jweEnc hdr-    (dummyCek, dummyIv) <- state $ \g -> generateCmkAndIV g enc-    let decryptedCek = either (const dummyCek) id $ rsaDecrypt (Just blinder) alg pk ek+    (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+                 then decryptedCek+                 else dummyCek         iv  = if B.length providedIv == B.length dummyIv                  then providedIv                  else dummyIv-    claims <- decryptPayload enc cek iv aad sig payload+        authTag = AuthTag $ BA.convert sig+    claims <- maybe (left BadCrypto) return $ decryptPayload enc cek iv aad authTag payload     return (hdr, claims)    where     checkDots = unless (BC.count '.' jwt == 4) $ left (BadDots 4) ++doEncode :: MonadRandom m+    => JweHeader+    -> (ByteString -> EitherT JwtError m ByteString)+    -> ByteString+    -> EitherT JwtError m Jwt+doEncode h encryptKey claims = do+    (cmk, iv) <- lift (generateCmkAndIV e)+    let Just (AuthTag sig, ct) = encryptPayload e cmk iv aad claims+    jweKey <- encryptKey cmk+    let jwe = B.intercalate "." $ map B64.encode [hdr, jweKey, iv, ct, BA.convert sig]+    return (Jwt jwe)+  where+    e   = jweEnc h+    hdr = encodeHeader h+    aad = B64.encode hdr++-- | Creates a JWE with the content key encoded using RSA.+rsaEncode :: MonadRandom m+    => JweAlg          -- ^ RSA algorithm to use (@RSA_OAEP@ or @RSA1_5@)+    -> Enc             -- ^ Content encryption algorithm+    -> PublicKey       -- ^ RSA key to encrypt with+    -> ByteString      -- ^ The JWT claims (content)+    -> m (Either JwtError Jwt) -- ^ The encoded JWE+rsaEncode a e kPub claims = runEitherT $ doEncode (defJweHdr {jweAlg = a, jweEnc = e}) (EitherT . rsaEncrypt kPub a) claims+++-- | Decrypts a JWE.+rsaDecode :: MonadRandom m+    => PrivateKey               -- ^ Decryption key+    -> ByteString               -- ^ The encoded JWE+    -> m (Either JwtError Jwe)  -- ^ The decoded JWT, unless an error occurs+rsaDecode pk jwt = runEitherT $ do+    blinder <- lift $ generateBlinder (public_n $ private_pub pk)+    doDecode (rsaDecrypt (Just blinder) pk) jwt

@@ -1,9 +1,8 @@-{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric, RecordWildCards #-} {-# OPTIONS_HADDOCK prune #-}  module Jose.Jwk-    ( KeyType-    , KeyUse (..)+    ( KeyUse (..)     , KeyId     , Jwk (..)     , JwkSet (..)@@ -20,14 +19,16 @@ where  import           Control.Applicative (pure)-import           Crypto.Random (CPRG)+import           Control.Monad (unless)+import           Crypto.Random (MonadRandom) import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import qualified Crypto.Types.PubKey.ECC as ECC+import qualified Crypto.PubKey.ECC.Types as ECC import           Crypto.Number.Serialize import           Data.Aeson (genericToJSON, Value(..), FromJSON(..), ToJSON(..), withText) import           Data.Aeson.Types (Parser, Options (..), defaultOptions) import           Data.ByteString (ByteString)+import           Data.Maybe (isNothing) import           Data.Text (Text) import qualified Data.Text.Encoding as TE import           GHC.Generics (Generic)@@ -39,7 +40,7 @@ data KeyType = Rsa              | Ec              | Oct-               deriving (Eq, Show)+               deriving (Eq)  data EcCurve = P_256              | P_384@@ -50,27 +51,26 @@              | Enc                deriving (Eq,Show) -data Jwk = RsaPublicJwk  RSA.PublicKey (Maybe KeyId) (Maybe KeyUse) (Maybe Alg)-         | RsaPrivateJwk RSA.PrivateKey (Maybe KeyId) (Maybe KeyUse) (Maybe Alg)-         | EcPublicJwk   ECDSA.PublicKey (Maybe KeyId) (Maybe KeyUse) (Maybe Alg) EcCurve-         | EcPrivateJwk  ECDSA.KeyPair   (Maybe KeyId) (Maybe KeyUse) (Maybe Alg) EcCurve-         | SymmetricJwk  ByteString (Maybe KeyId) (Maybe KeyUse) (Maybe Alg)+data Jwk = RsaPublicJwk  !RSA.PublicKey   !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg)+         | RsaPrivateJwk !RSA.PrivateKey  !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg)+         | EcPublicJwk   !ECDSA.PublicKey !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) !EcCurve+         | EcPrivateJwk  !ECDSA.KeyPair   !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) !EcCurve+         | SymmetricJwk  !ByteString      !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg)            deriving (Show, Eq)  data JwkSet = JwkSet     { keys :: [Jwk]     } deriving (Show, Eq, Generic) -generateRsaKeyPair :: (CPRG g)-    => g-    -> Int+generateRsaKeyPair :: (MonadRandom m)+    => Int     -> KeyId     -> KeyUse     -> Maybe Alg-    -> ((Jwk, Jwk), g)-generateRsaKeyPair rng nBytes id' kuse kalg =-    let ((kPub, kPr), rng') = RSA.generate rng nBytes 65537-    in  ((RsaPublicJwk kPub (Just id') (Just kuse) kalg, RsaPrivateJwk kPr (Just id') (Just kuse) kalg), rng')+    -> m (Jwk, Jwk)+generateRsaKeyPair nBytes id' kuse kalg = do+    (kPub, kPr) <- RSA.generate nBytes 65537+    return (RsaPublicJwk kPub (Just id') (Just kuse) kalg, RsaPrivateJwk kPr (Just id') (Just kuse) kalg)  isPublic :: Jwk -> Bool isPublic RsaPublicJwk {} = True@@ -126,17 +126,23 @@     case (jweAlg hdr, jwk) of         (RSA1_5,   RsaPrivateJwk {}) -> True         (RSA_OAEP, RsaPrivateJwk {}) -> True+        (A128KW,   SymmetricJwk {})  -> True+        (A192KW,   SymmetricJwk {})  -> True+        (A256KW,   SymmetricJwk {})  -> 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,   RsaPublicJwk {})  -> True+        (RSA_OAEP, RsaPublicJwk {})  -> True         (RSA1_5,   RsaPrivateJwk {}) -> True         (RSA_OAEP, RsaPrivateJwk {}) -> True-        _                           -> False+        (A128KW,   SymmetricJwk {})  -> True+        (A192KW,   SymmetricJwk {})  -> True+        (A256KW,   SymmetricJwk {})  -> True+        _                            -> False  keyIdCompatible :: Maybe KeyId -> Jwk -> Bool keyIdCompatible Nothing _ = True@@ -323,7 +329,7 @@     , x5u :: Maybe Text     , x5c :: Maybe [Text]     , x5t :: Maybe Text-    } deriving (Show, Generic)+    } deriving (Generic)  instance FromJSON JwkData instance ToJSON   JwkData where@@ -353,23 +359,40 @@     }  createJwk :: JwkData -> Either String Jwk-createJwk kd = case kd of-    J Rsa (Just nb) (Just eb) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing u a i _ _ _ ->-        return $ RsaPublicJwk (rsaPub nb eb) i u a-    J Rsa (Just nb) (Just eb) (Just db) mp mq mdp mdq mqi Nothing Nothing Nothing Nothing u a i _ _ _ ->-        return $ RsaPrivateJwk (RSA.PrivateKey (rsaPub nb eb) (os2ip $ bytes db) (os2mip mp) (os2mip mq) (os2mip mdp) (os2mip mdq) (os2mip mqi)) i u a-    J Oct Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just kb) Nothing Nothing Nothing u a i Nothing Nothing Nothing ->-        return $ SymmetricJwk (bytes kb) i u a-    J Ec  Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just crv') (Just xb) (Just yb) u a i Nothing Nothing Nothing ->-        return $ EcPublicJwk (ECDSA.PublicKey (curve crv') (ecPoint xb yb)) i u a crv'-    J Ec  Nothing Nothing (Just db) Nothing Nothing Nothing Nothing Nothing Nothing (Just crv') (Just xb) (Just yb) u a i Nothing Nothing Nothing ->-        return $ EcPrivateJwk (ECDSA.KeyPair (curve crv') (ecPoint xb yb) (os2ip (bytes db))) i u a crv'-    _ -> Left $ "Invalid key data. Didn't match any known JWK parameter combinations:" ++ show kd+createJwk J {..} = case kty of+    Rsa -> do+        nb <- note "n is required for an RSA key" n+        eb <- note "e is required for an RSA key" e+        checkNoEc+        let kPub = rsaPub nb eb+        case d of+            Nothing -> do+                unless (isNothing (sequence [p, q, dp, dq, qi])) (Left "RSA private parameters can't be set for a public key")+                return (RsaPublicJwk kPub kid use alg)+            Just db -> return $ RsaPrivateJwk (RSA.PrivateKey kPub (os2ip (bytes db)) (os2mip p) (os2mip q) (os2mip dp) (os2mip dq) (os2mip qi)) kid use alg+    Oct -> do+        kb <- note "k is required for a symmetric key" k+        unless (isNothing (sequence [n, e, d, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for a symmetric key")+        checkNoEc+        return $ SymmetricJwk (bytes kb) kid use alg+    Ec  -> do+        crv' <- note "crv is required for an elliptic curve key" crv+        let c = curve crv'+        ecPt <- ecPoint+        unless (isNothing (sequence [n, e, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for an elliptic curve key")+        case d of+            Nothing -> return $ EcPublicJwk (ECDSA.PublicKey c ecPt) kid use alg crv'+            Just db -> return $ EcPrivateJwk (ECDSA.KeyPair c ecPt (os2ip (bytes db))) kid use alg crv'   where-    rsaPub  nb eb  = let m  = os2ip $ bytes nb-                         ex = os2ip $ bytes eb-                     in RSA.PublicKey (rsaSize m 1) m ex-    rsaSize m i    = if (2 ^ (i * 8)) > m then i else rsaSize m (i+1)-    os2mip         = maybe 0 (os2ip . bytes)-    ecPoint xb yb  = ECC.Point (os2ip (bytes xb)) (os2ip (bytes yb))-+    checkNoEc = unless (isNothing crv) (Left "Elliptic curve type can't be set for an RSA key") >>+       unless (isNothing (sequence [x, y])) (Left "Elliptic curve coordinates can't be set for an RSA key")+    note err      = maybe (Left err) Right+    os2mip        = maybe 0 (os2ip . bytes)+    rsaPub nb eb  = let m  = os2ip $ bytes nb+                        ex = os2ip $ bytes eb+                    in RSA.PublicKey (rsaSize m 1) m ex+    rsaSize m i   = if (2 ^ (i * 8)) > m then i else rsaSize m (i+1)+    ecPoint       = do+        xb <- note "x is required for an EC key" x+        yb <- note "y is required for an EC key" y+        return $ ECC.Point (os2ip (bytes xb)) (os2ip (bytes yb))

@@ -28,7 +28,7 @@ import Control.Monad (unless) import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder)-import Crypto.Random (CPRG)+import Crypto.Random (MonadRandom) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC@@ -42,16 +42,15 @@ -- | Create a JWS signed with a JWK. -- The key and algorithm must be consistent or an error -- will be returned.-jwkEncode :: (CPRG g)-          => g-          -> JwsAlg                          -- ^ The algorithm to use+jwkEncode :: MonadRandom m+          => JwsAlg                          -- ^ The algorithm to use           -> Jwk                             -- ^ The key to sign with           -> Payload                         -- ^ The public JWT claims-          -> (Either JwtError Jwt, g)        -- ^ The encoded token, if successful-jwkEncode rng a key payload = case key of-    RsaPrivateJwk kPr kid _ _ -> rsaEncodeInternal rng a kPr (sigTarget a kid payload)-    SymmetricJwk  k   kid _ _ -> (hmacEncodeInternal a k (sigTarget a kid payload), rng)-    _                         -> (Left $ BadAlgorithm "EC signing is not supported", rng)+          -> m (Either JwtError Jwt)         -- ^ The encoded token, if successful+jwkEncode a key payload = case key of+    RsaPrivateJwk kPr kid _ _ -> rsaEncodeInternal a kPr (sigTarget a kid payload)+    SymmetricJwk  k   kid _ _ -> return $ hmacEncodeInternal a k (sigTarget a kid payload)+    _                         -> return $ Left $ BadAlgorithm "EC signing is not supported"  -- | Create a JWS with an HMAC for validation. hmacEncode :: JwsAlg       -- ^ The MAC algorithm to use@@ -73,24 +72,22 @@ hmacDecode key = decode (`hmacVerify` key)  -- | Creates a JWS with an RSA signature.-rsaEncode :: CPRG g-          => g-          -> JwsAlg                           -- ^ The RSA algorithm to use+rsaEncode :: MonadRandom m+          => JwsAlg                           -- ^ The RSA algorithm to use           -> PrivateKey                       -- ^ The key to sign with           -> ByteString                       -- ^ The public JWT claims (token content)-          -> (Either JwtError Jwt, g)  -- ^ The encoded JWS token-rsaEncode rng a pk payload = rsaEncodeInternal rng a pk (sigTarget a Nothing (Claims payload))+          -> m (Either JwtError Jwt)          -- ^ The encoded JWS token+rsaEncode a pk payload = rsaEncodeInternal a pk (sigTarget a Nothing (Claims payload)) -rsaEncodeInternal :: CPRG g-                  => g-                  -> JwsAlg+rsaEncodeInternal :: MonadRandom m+                  => JwsAlg                   -> PrivateKey                   -> ByteString-                  -> (Either JwtError Jwt, g)-rsaEncodeInternal rng a pk st = (sign blinder, rng')+                  -> m (Either JwtError Jwt)+rsaEncodeInternal a pk st = do+    blinder <- generateBlinder (public_n $ private_pub pk)+    return $ sign blinder   where-    (blinder, rng') = generateBlinder rng (public_n $ private_pub pk)-     sign b = case rsaSign (Just b) a pk st of         Right sig -> Right . Jwt $ B.concat [st, ".", B64.encode sig]         Left e    -> Left e@@ -135,4 +132,3 @@   where     spanEndDot bs = let (toDot, end) = BC.spanEnd (/= '.') bs                     in  (B.init toDot, end)-

@@ -10,12 +10,12 @@ -- >>> import Jose.Jwk -- >>> import Data.ByteString -- >>> import Data.Aeson (decodeStrict)--- >>> import Crypto.Random.AESCtr--- >>> g <- makeSystem+-- >>> import Crypto.Random+-- >>> g <- drgNew -- >>> let jsonJwk = "{\"kty\":\"RSA\", \"kid\":\"mykey\", \"n\":\"ofgWCuLjybRlzo0tZWJjNiuSfb4p4fAkd_wWJcyQoTbji9k0l8W26mPddxHmfHQp-Vaw-4qPCJrcS2mJPMEzP1Pt0Bm4d4QlL-yRT-SFd2lZS-pCgNMsD1W_YpRPEwOWvG6b32690r2jZ47soMZo9wGzjb_7OMg0LOL-bSf63kpaSHSXndS5z5rexMdbBYUsLA9e-KXBdQOS-UTo7WTBEMa2R2CapHg665xsmtdVMTBQY4uDZlxvb3qCo5ZwKh9kG4LT6_I5IhlJH7aGhyxXFvUK-DWNmoudF8NAco9_h9iaGNj8q2ethFkMLs91kzk2PAcDTW9gb54h4FRWyuXpoQ\", \"e\":\"AQAB\", \"d\":\"Eq5xpGnNCivDflJsRQBXHx1hdR1k6Ulwe2JZD50LpXyWPEAeP88vLNO97IjlA7_GQ5sLKMgvfTeXZx9SE-7YwVol2NXOoAJe46sui395IW_GO-pWJ1O0BkTGoVEn2bKVRUCgu-GjBVaYLU6f3l9kJfFNS3E0QbVdxzubSu3Mkqzjkn439X0M_V51gfpRLI9JYanrC4D4qAdGcopV_0ZHHzQlBjudU2QvXt4ehNYTCBr6XCLQUShb1juUO1ZdiYoFaFQT5Tw8bGUl_x_jTj3ccPDVZFD9pIuhLhBOneufuBiB4cS98l2SR_RQyGWSeWjnczT0QU91p1DhOVRuOopznQ\"}" :: ByteString -- >>> let Just jwk = decodeStrict jsonJwk :: Maybe Jwk--- >>> let (Right (Jwt jwtEncoded), g')  = encode g [jwk] (JwsEncoding RS256) (Claims "public claims")--- >>> let (Right jwtDecoded, g'') = Jose.Jwt.decode g' [jwk] (Just (JwsEncoding RS256)) jwtEncoded+-- >>> let (Right (Jwt jwtEncoded), g') = withDRG g $ encode [jwk] (JwsEncoding RS256) (Claims "public claims")+-- >>> let (Right jwtDecoded, g'') = withDRG g' $ Jose.Jwt.decode [jwk] (Just (JwsEncoding RS256)) jwtEncoded -- >>> jwtDecoded -- Jws (JwsHeader {jwsAlg = RS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Just (KeyId "mykey")},"public claims") @@ -27,11 +27,12 @@     ) where -import Control.Monad.State.Strict+import Control.Monad (when, unless, liftM)+import Control.Monad.Trans (lift) import Control.Monad.Trans.Either import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.PubKey.RSA (PrivateKey(..))-import Crypto.Random (CPRG)+import Crypto.Random (MonadRandom) import Data.Aeson (decodeStrict') import Data.ByteString (ByteString) import Data.List (find)@@ -51,43 +52,42 @@ -- The list of keys will be searched to locate one which is -- consistent with the chosen encoding algorithms. ---encode :: (CPRG g)-       => g                          -- ^ Random number generator-       -> [Jwk]                      -- ^ The key or keys. At least one must be consistent with the chosen algorithm-       -> JwtEncoding                -- ^ The encoding algorithm(s) used to encode the payload-       -> Payload                    -- ^ The payload (claims)-       -> (Either JwtError Jwt, g)   -- ^ The encoded JWT, if successful-encode rng jwks encoding msg = flip runState rng $ runEitherT $ case encoding of+encode :: MonadRandom m+    => [Jwk]                     -- ^ The key or keys. At least one must be consistent with the chosen algorithm+    -> JwtEncoding               -- ^ The encoding algorithm(s) used to encode the payload+    -> Payload                   -- ^ The payload (claims)+    -> m (Either JwtError Jwt)   -- ^ The encoded JWT, if successful+encode jwks encoding msg = runEitherT $ case encoding of     JwsEncoding None -> case msg of         Claims p -> return $ Jwt $ BC.intercalate "." [unsecuredHdr, B64.encode p]         Nested _ -> left BadClaims     JwsEncoding a    -> 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)+        (k:_) -> hoistEither =<< lift (Jws.jwkEncode a k msg)     JweEncoding a e -> 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)+        (k:_) -> hoistEither =<< lift (Jwe.jwkEncode a e k msg)   where-    unsecuredHdr = B64.encode "{\"alg\":\"none\"}"+    unsecuredHdr = B64.encode (BC.pack "{\"alg\":\"none\"}")   -- | Uses the supplied keys to decode a JWT. -- Locates a matching key by header @kid@ value where possible -- or by suitable key type for the encoding algorithm. ----- The algorithm(s) used can be optionally be supplied for validation+-- The algorithm(s) used can optionally be supplied for validation -- by setting the @JwtEncoding@ parameter, in which case an error will--- be returned if they don't match.+-- be returned if they don't match. If you expect the tokens to use+-- a particular algorithm, then you should set this parameter. -- -- For unsecured tokens (with algorithm "none"), the expected algorithm -- must be set to @Just (JwsEncoding None)@ or an error will be returned.-decode :: CPRG g-       => g                               -- ^ Random number generator. Only used for RSA blinding-       -> [Jwk]                           -- ^ The keys to use for decoding-       -> Maybe JwtEncoding               -- ^ The expected encoding information-       -> ByteString                      -- ^ The encoded JWT-       -> (Either JwtError JwtContent, g) -- ^ The decoded JWT payload, if successful-decode rng keySet encoding jwt = flip runState rng $ runEitherT $ do+decode :: MonadRandom m+    => [Jwk]                           -- ^ The keys to use for decoding+    -> Maybe JwtEncoding               -- ^ The expected encoding information+    -> 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@@ -106,7 +106,7 @@             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)+    decodeWithJws :: MonadRandom m => Jwk -> EitherT JwtError m (Maybe JwtContent)     decodeWithJws k = either (const $ return Nothing) (return . Just . Jws) $ case k of         RsaPublicJwk  kPub _ _ _ -> Jws.rsaDecode kPub jwt         RsaPrivateJwk kPr  _ _ _ -> Jws.rsaDecode (private_pub kPr) jwt@@ -114,12 +114,8 @@         EcPrivateJwk  kPr  _ _ _ _ -> Jws.ecDecode (ECDSA.toPublicKey kPr) jwt         SymmetricJwk  kb   _ _ _ -> Jws.hmacDecode kb jwt -    decodeWithJwe :: CPRG g => Jwk -> EitherT JwtError (State g) (Maybe JwtContent)-    decodeWithJwe k = case k of-        RsaPrivateJwk kPr _ _ _ -> do-            e <- state (\g -> Jwe.rsaDecode g kPr jwt)-            either (const $ return Nothing) (return . Just . Jwe) e-        _                       -> left $ KeyError "Not a JWE key (shouldn't happen)"+    decodeWithJwe :: MonadRandom m => Jwk -> EitherT JwtError m (Maybe JwtContent)+    decodeWithJwe k = liftM (either (const Nothing) Just) (lift (Jwe.jwkDecode k jwt))  -- | Convenience function to return the claims contained in a JWT. -- This is required in situations such as client assertion authentication,

@@ -1,20 +1,16 @@ Name:               jose-jwt-Version:            0.6.2+Version:            0.7 Synopsis:           JSON Object Signing and Encryption Library Homepage:           http://github.com/tekul/jose-jwt Bug-Reports:        http://github.com/tekul/jose-jwt/issues Description:     .-    Intended to provide support for the JOSE suite of IETF (draft)-    standards and the closely related JWT (JSON web token) spec-    (<http://tools.ietf.org/html/draft-ietf-oauth-json-web-token-32/>).+    An implementation of the JOSE suite of IETF standards+    and the closely related JWT (JSON web token) spec+    (<https://tools.ietf.org/html/rfc7519/>).     .     Both signed and encrypted JWTs are supported, as well as simple-    JWK format keys.-    .-    The library is currently intended to support work on an OpenID-    Connect implementation and the APIs should not be considered-    complete, stable or secure for all use cases.+    JWK keys.  Author:             Luke Taylor <tekul.hs@gmail.com> Maintainer:         Luke Taylor <tekul.hs@gmail.com>@@ -47,24 +43,17 @@                     , Jose.Internal.Crypto   Other-Modules:      Jose.Types   Build-Depends:      base >= 4 && < 5-                    , mtl >= 2.1.3.1+                    , aeson >= 0.8.0.2                     , bytestring >= 0.9-                    , byteable >= 0.1.1                     , cereal >= 0.4                     , containers >= 0.4-                    , cryptohash >= 0.8-                    , crypto-cipher-types >= 0.0.9-                    , crypto-pubkey >= 0.2.5-                    , crypto-pubkey-types >= 0.4-                    , crypto-random >= 0.0.7-                    , crypto-numbers >= 0.2-                    , cipher-aes >= 0.2.6+                    , cryptonite >= 0.3                     , either-                    , aeson >= 0.8.1.0+                    , memory >= 0.10+                    , mtl >= 2.1.3.1                     , text  >= 0.11                     , time  >= 1.4                     , unordered-containers >= 0.2-                    , base64-bytestring >= 1                     , vector >= 0.10   Ghc-Options:        -Wall @@ -76,19 +65,16 @@                     , Tests.JwkSpec   Build-depends:      jose-jwt                     , base+                    , aeson                     , aeson-qq                     , bytestring-                    , base64-bytestring-                    , cryptohash-                    , crypto-pubkey-                    , crypto-pubkey-types-                    , crypto-random-                    , crypto-cipher-types-                    , cipher-aes+                    , cryptonite                     , either >= 4.0+                    , memory                     , mtl                     , text-                    , aeson+                    , unordered-containers+                    , vector                     , hspec >= 1.6                     , HUnit >= 1.2                     , QuickCheck >= 2.4@@ -100,14 +86,14 @@   Default-Language:   Haskell2010   Type:               exitcode-stdio-1.0   Main-is:            doctests.hs-  Ghc-options:        -XOverloadedStrings+  Default-Extensions: OverloadedStrings    if !flag(doctest)     Buildable: False   else     Build-depends:    base                     , doctest >= 0.9.11-                    , cprng-aes+                    , cryptonite  Benchmark bench-jwt   Default-Language:   Haskell2010@@ -119,8 +105,5 @@                     , base                     , bytestring                     , criterion-                    , crypto-pubkey-                    , crypto-random    Ghc-Options:        -Wall -O2-

@@ -4,10 +4,11 @@ module Tests.JweSpec where  import Control.Applicative-import Data.Aeson (eitherDecode, decodeStrict')+import Data.Aeson (decodeStrict') import Data.Bits (xor)-import Data.Either.Combinators-import Data.Word (Word8)+import Data.Maybe (fromJust)+import Data.Word (Word8, Word64)+import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Test.Hspec@@ -15,11 +16,11 @@ import Test.QuickCheck  import qualified Crypto.PubKey.RSA as RSA+import Crypto.Hash (SHA1(..), hashDigestSize) import Crypto.PubKey.RSA.Prim (dp) import Crypto.PubKey.MaskGenFunction-import Crypto.PubKey.HashDescr import Crypto.Cipher.Types (AuthTag(..))-import Crypto.Random (CPRG(..))+import Crypto.Random (DRG(..), withDRG, drgNewTest) import Jose.Jwt import qualified Jose.Jwe as Jwe import Jose.Jwa@@ -37,122 +38,139 @@     context "when using JWE Appendix 1 data" $ do       let a1Header = defJweHdr {jweAlg = RSA_OAEP, jweEnc = A256GCM} -      it "generates the expected IV and CMK from the RNG" $ do-        let g = RNG $ B.append a1cek a1iv-        generateCmkAndIV g A256GCM @?= ((a1cek, a1iv), RNG "")+      it "generates the expected IV and CMK from the RNG" $+        withDRG (RNG $ B.append a1cek a1iv)+            (generateCmkAndIV A256GCM) @?= ((a1cek, a1iv), RNG "") -      it "generates the expected RSA-encrypted content key" $ do-        let g = RNG a1oaepSeed-        rsaEncrypt g RSA_OAEP a1PubKey a1cek @?= (a1jweKey, RNG "")+      it "generates the expected RSA-encrypted content key" $+        withDRG (RNG a1oaepSeed)+            (rsaEncrypt a1PubKey RSA_OAEP a1cek) @?= (Right a1jweKey, RNG "")        it "encrypts the payload to the expected ciphertext and authentication tag" $ do         let aad = B64.encode . encodeHeader $ a1Header-        encryptPayload A256GCM a1cek a1iv aad a1Payload @?= (a1Ciphertext, AuthTag a1Tag)+        encryptPayload A256GCM a1cek a1iv aad a1Payload @?= Just (AuthTag a1Tag, a1Ciphertext) -      it "encodes the payload to the expected JWT, leaving the RNG empty" $ do-        let g = RNG $ B.concat [a1cek, a1iv, a1oaepSeed]-        Jwe.rsaEncode g RSA_OAEP A256GCM a1PubKey a1Payload @?= (Jwt a1, RNG "")+      it "encodes the payload to the expected JWT, leaving the RNG empty" $+        withDRG (RNG $ B.concat [a1cek, a1iv, a1oaepSeed])+            (Jwe.rsaEncode RSA_OAEP A256GCM a1PubKey a1Payload) @?= (Right (Jwt a1), RNG "")        it "decodes the JWT to the expected header and payload" $-        fst (Jwe.rsaDecode blinderRNG a1PrivKey a1) @?= Right (a1Header, a1Payload)+        withBlinder (Jwe.rsaDecode a1PrivKey a1) @?= Right (a1Header, a1Payload)        it "decodes the JWK to the correct RSA key values" $ do-        let Right (Jwk.RsaPrivateJwk (RSA.PrivateKey pubKey d 0 0 0 0 0) _ _ _) = eitherDecode a1jwk+        let Just (Jwk.RsaPrivateJwk (RSA.PrivateKey pubKey d 0 0 0 0 0) _ _ _) = decodeStrict' a1jwk         RSA.public_n pubKey  @?= a1RsaModulus         RSA.public_e pubKey  @?= rsaExponent         d                    @?= a1RsaPrivateExponent        it "decodes the JWT using the JWK" $ do-        let Right k1 = eitherDecode a1jwk-            Just  k2 = decodeStrict' a2jwk-        fst (decode blinderRNG [k2, k1] (Just $ JweEncoding RSA_OAEP A256GCM) a1) @?= (Right $ Jwe (a1Header, a1Payload))+        let Just k1 = decodeStrict' a1jwk+            Just k2 = decodeStrict' a2jwk+        withBlinder (decode [k2, k1] (Just $ JweEncoding RSA_OAEP A256GCM) a1) @?= (Right $ Jwe (a1Header, a1Payload)) -      it "a truncated CEK returns BadSignature" $ do+      it "a truncated CEK returns BadCrypto" $ do         let [hdr, _, iv, payload, tag] = BC.split '.' a1-            (newEk, _) = rsaEncrypt blinderRNG RSA_OAEP a1PubKey (B.tail a1cek)-        fst (Jwe.rsaDecode blinderRNG a1PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadSignature+            (Right newEk, _) = withDRG blinderRNG (rsaEncrypt a1PubKey RSA_OAEP (B.tail a1cek))+        withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadCrypto -      it "a truncated payload returns BadSignature" $ do+      it "a truncated payload returns BadCrypto" $ do         let [hdr, ek, iv, payload, tag] = BC.split '.' a1             Right ct = B64.decode payload-        fst (Jwe.rsaDecode blinderRNG a1PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadSignature+        withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto -      it "a truncated IV returns BadSignature" $ do+      it "a truncated IV returns BadCrypto" $ do         let (fore, aft) = BC.breakSubstring (B64.encode a1iv) a1             newIv = B64.encode (B.tail a1iv)-        fst (Jwe.rsaDecode blinderRNG a1PrivKey (B.concat [fore, newIv, aft])) @?= Left BadSignature+        withBlinder (Jwe.rsaDecode a1PrivKey (B.concat [fore, newIv, aft])) @?= Left BadCrypto       context "when using JWE Appendix 2 data" $ do       let a2Header = defJweHdr {jweAlg = RSA1_5, jweEnc = A128CBC_HS256}       let aad = B64.encode . encodeHeader $ a2Header -      it "generates the expected RSA-encrypted content key" $ do-        let g = RNG a2seed-        rsaEncrypt g RSA1_5 a2PubKey a2cek @?= (a2jweKey, RNG "")+      it "generates the expected RSA-encrypted content key" $+        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 @?= (a2Ciphertext, AuthTag a2Tag)+        encryptPayload A128CBC_HS256 a2cek a2iv aad a2Payload @?= Just (a2Tag, a2Ciphertext) -      it "encodes the payload to the expected JWT" $ do-        let g = RNG $ B.concat [a2cek, a2iv, a2seed]-        Jwe.rsaEncode g RSA1_5 A128CBC_HS256 a2PubKey a2Payload @?= (Jwt a2, RNG "")+      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 @?= Right a2Payload+        decryptPayload A128CBC_HS256 a2cek a2iv aad a2Tag a2Ciphertext @?= Just a2Payload        it "decodes the JWT to the expected header and payload" $-        fst (Jwe.rsaDecode blinderRNG a2PrivKey a2) @?= Right (a2Header, a2Payload)+        withBlinder (Jwe.rsaDecode a2PrivKey a2) @?= Right (a2Header, a2Payload)        it "a truncated CEK returns BadCrypto" $ do         let [hdr, _, iv, payload, tag] = BC.split '.' a2-            (newEk, _) = rsaEncrypt blinderRNG RSA1_5 a2PubKey (B.tail a2cek)-        fst (Jwe.rsaDecode blinderRNG a2PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadCrypto+            (Right newEk, _) = withDRG blinderRNG $ rsaEncrypt a2PubKey RSA1_5 (B.tail a2cek)+        withBlinder (Jwe.rsaDecode a2PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadCrypto        it "a truncated payload returns BadCrypto" $ do         let [hdr, ek, iv, payload, tag] = BC.split '.' a2             Right ct = B64.decode payload-        fst (Jwe.rsaDecode blinderRNG a2PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto+        withBlinder (Jwe.rsaDecode a2PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto -      it "a truncated IV returns BadSignature" $ do+      it "a truncated IV returns BadCrypto" $ do         let (fore, aft) = BC.breakSubstring (B64.encode a2iv) a2             newIv = B64.encode (B.tail a2iv)-        fst (Jwe.rsaDecode blinderRNG a2PrivKey (B.concat [fore, newIv, aft])) @?= Left BadSignature+        withBlinder (Jwe.rsaDecode a2PrivKey (B.concat [fore, newIv, aft])) @?= Left BadCrypto +    context "when using JWE Appendix 3 data" $ do+      let Just jwk = decodeStrict' a3jwk+          a3Header = defJweHdr {jweAlg = A128KW, jweEnc = A128CBC_HS256}+      it "encodes the payload to the epected JWT" $+        withDRG (RNG $ B.concat [a3cek, a3iv])+            (Jwe.jwkEncode A128KW A128CBC_HS256 jwk (Claims a3Payload)) @?= (Right (Jwt a3), RNG "")++      it "decodes the JWT using the JWK" $+        withBlinder (decode [jwk] Nothing a3) @?= (Right $ Jwe (a3Header, a3Payload))+     context "when used with quickcheck" $ do       it "padded msg is always a multiple of 16" $ property $         \s -> B.length (pad (B.pack s)) `mod` 16 == 0       it "unpad is the inverse of pad" $ property $-        \s -> let msg = B.pack s in (fromRight' . unpad . pad) msg == msg+        \s -> let msg = B.pack s in (fromJust . unpad . pad) msg == msg       it "jwe decode/decode returns the original payload" $ property jweRoundTrip +    context "miscellaneous tests" $ do+      it "Padding byte larger than 16 is rejected" $+        unpad "111a" @?= Nothing+      it "Padding byte which doesn't match padding length is rejected" $+        unpad "111\t\t\t\t\t\t\t" @?= Nothing+      it "Padding byte which matches padding length is OK" $+        unpad "1111111\t\t\t\t\t\t\t\t\t" @?= Just "1111111"+ -- verboseQuickCheckWith quickCheckWith stdArgs {maxSuccess=10000}  jweRoundTrip jweRoundTrip :: RNG -> JWEAlgs -> [Word8] -> Bool-jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (defJweHdr {jweAlg = a, jweEnc = e}, bs)+jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (Jwe (defJweHdr {jweAlg = a, jweEnc = e}, bs))   where+    jwks = map (fromJust . decodeStrict') [a1jwk, a2jwk, a3jwk]     bs = B.pack msg-    encodeDecode = fst $ Jwe.rsaDecode blinderRNG a2PrivKey $ unJwt $ fst $ Jwe.rsaEncode g a e a2PubKey bs+    encodeDecode = fst (withDRG blinderRNG (decode jwks Nothing encoded))+    Right encoded = unJwt <$> fst (withDRG g (encode jwks (JweEncoding a e) (Claims bs))) +withBlinder = fst . withDRG blinderRNG+ -- 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) -genBytes :: Int -> RNG -> (B.ByteString, RNG)-genBytes 0 g = (B.empty, g)-genBytes n (RNG bs) = (bytes, RNG next)+genBytes :: BA.ByteArray ba => Int -> RNG -> (ba, RNG)+genBytes 0 g = (BA.empty, g)+genBytes n (RNG bs) = (BA.convert bytes, RNG next)   where-    (bytes, next) = if B.null bs-                      then error "RNG is empty"-                      else B.splitAt n bs+    (bytes, next) = if BA.null bs+                        then error "RNG is empty"+                        else BA.splitAt n bs -instance CPRG RNG where-    cprgCreate   = undefined-    cprgSetReseedThreshold = undefined-    cprgGenerate = genBytes-    cprgGenerateWithEntropy = undefined-    cprgFork = undefined+instance DRG RNG where+    randomBytesGenerate = genBytes -blinderRNG = RNG $ B.replicate 2000 255+blinderRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64  -------------------------------------------------------------------------------- -- JWE Appendix 1 Test Data@@ -171,9 +189,9 @@  a1Ciphertext = B.pack [229, 236, 166, 241, 53, 191, 115, 196, 174, 43, 73, 109, 39, 122, 233, 96, 140, 206, 120, 52, 51, 237, 48, 11, 190, 219, 186, 80, 111, 104, 50, 142, 47, 167, 59, 61, 181, 127, 196, 21, 40, 82, 242, 32, 123, 143, 168, 226, 73, 216, 176, 144, 138, 247, 106, 60, 16, 205, 160, 109, 64, 63, 192] -a1Tag = B.pack [92, 80, 104, 49, 133, 25, 161, 215, 173, 101, 219, 211, 136, 91, 210, 145]+a1Tag = BA.pack [92, 80, 104, 49, 133, 25, 161, 215, 173, 101, 219, 211, 136, 91, 210, 145] -Right a1jweKey = B64.decode "OKOawDo13gRp2ojaHV7LFpZcgV7T6DVZKTyKOMTYUmKoTCVJRgckCL9kiMT03JGeipsEdY3mx_etLbbWSrFr05kLzcSr4qKAq7YN7e9jwQRb23nfa6c9d-StnImGyFDbSv04uVuxIp5Zms1gNxKKK2Da14B8S4rzVRltdYwam_lDp5XnZAYpQdb76FdIKLaVmqgfwX7XWRxv2322i-vDxRfqNzo_tETKzpVLzfiwQyeyPGLBIO56YJ7eObdv0je81860ppamavo35UgoRdbYaBcoh9QcfylQr66oc6vFWXRcZ_ZT2LawVCWTIy3brGPi6UklfCpIMfIjf7iGdXKHzg"+Right a1jweKey = B64.decode $ BC.pack "OKOawDo13gRp2ojaHV7LFpZcgV7T6DVZKTyKOMTYUmKoTCVJRgckCL9kiMT03JGeipsEdY3mx_etLbbWSrFr05kLzcSr4qKAq7YN7e9jwQRb23nfa6c9d-StnImGyFDbSv04uVuxIp5Zms1gNxKKK2Da14B8S4rzVRltdYwam_lDp5XnZAYpQdb76FdIKLaVmqgfwX7XWRxv2322i-vDxRfqNzo_tETKzpVLzfiwQyeyPGLBIO56YJ7eObdv0je81860ppamavo35UgoRdbYaBcoh9QcfylQr66oc6vFWXRcZ_ZT2LawVCWTIy3brGPi6UklfCpIMfIjf7iGdXKHzg"  a1jwk = "{\"kty\":\"RSA\", \"n\":\"oahUIoWw0K0usKNuOR6H4wkf4oBUXHTxRvgb48E-BVvxkeDNjbC4he8rUWcJoZmds2h7M70imEVhRU5djINXtqllXI4DFqcI1DgjT9LewND8MW2Krf3Spsk_ZkoFnilakGygTwpZ3uesH-PFABNIUYpOiN15dsQRkgr0vEhxN92i2asbOenSZeyaxziK72UwxrrKoExv6kc5twXTq4h-QChLOln0_mtUZwfsRaMStPs6mS6XrgxnxbWhojf663tuEQueGC-FCMfra36C9knDFGzKsNa7LZK2djYgyD3JR_MB_4NUJW_TqOQtwHYbxevoJArm-L5StowjzGy-_bq6Gw\", \"e\":\"AQAB\", \"d\":\"kLdtIj6GbDks_ApCSTYQtelcNttlKiOyPzMrXHeI-yk1F7-kpDxY4-WY5NWV5KntaEeXS1j82E375xxhWMHXyvjYecPT9fpwR_M9gV8n9Hrh2anTpTD93Dt62ypW3yDsJzBnTnrYu1iwWRgBKrEYY46qAZIrA2xAwnm2X7uGR1hghkqDp0Vqj3kbSCz1XyfCs6_LehBwtxHIyh8Ripy40p24moOAbgxVw3rxT_vlt3UVe4WO3JkJOzlpUf-KTVI2Ptgm-dARxTEtE-id-4OJr0h-K-VFs3VSndVTIznSxfyrj8ILL6MG_Uv8YAu7VILSB3lOW085-4qE3DzgrTjgyQ\" }" @@ -204,9 +222,9 @@  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 = B.pack [246, 17, 244, 190, 4, 95, 98, 3, 231, 0, 115, 157, 242, 203, 100, 191]+a2Tag = AuthTag $ BA.pack [246, 17, 244, 190, 4, 95, 98, 3, 231, 0, 115, 157, 242, 203, 100, 191] -Right a2jweKey = B64.decode "UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A"+Right a2jweKey = B64.decode $ BC.pack "UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A"  a2jwk = "{\"kty\":\"RSA\", \"n\":\"sXchDaQebHnPiGvyDOAT4saGEUetSyo9MKLOoWFsueri23bOdgWp4Dy1WlUzewbgBHod5pcM9H95GQRV3JDXboIRROSBigeC5yjU1hGzHHyXss8UDprecbAYxknTcQkhslANGRUZmdTOQ5qTRsLAt6BTYuyvVRdhS8exSZEy_c4gs_7svlJJQ4H9_NxsiIoLwAEk7-Q3UXERGYw_75IDrGA84-lA_-Ct4eTlXHBIY2EaV7t7LjJaynVJCpkv4LKjTTAumiGUIuQhrNhZLuF_RJLqHpM2kgWFLU7-VTdL1VbC2tejvcI2BlMkEpk1BzBZI0KQB0GaDWFLN-aEAw3vRw\", \"e\":\"AQAB\", \"d\":\"VFCWOqXr8nvZNyaaJLXdnNPXZKRaWCjkU5Q2egQQpTBMwhprMzWzpR8Sxq1OPThh_J6MUD8Z35wky9b8eEO0pwNS8xlh1lOFRRBoNqDIKVOku0aZb-rynq8cxjDTLZQ6Fz7jSjR1Klop-YKaUHc9GsEofQqYruPhzSA-QgajZGPbE_0ZaVDJHfyd7UUBUKunFMScbflYAAOYJqVIVwaYR5zWEEceUjNnTNo_CVSj-VvXLO5VZfCUAVLgW4dpf1SrtZjSt34YLsRarSb127reG_DUwg9Ch-KyvjT1SkHgUWRVGcyly7uvVGRSDwsXypdrNinPA4jlhoNdizK2zF2CWQ\" }" @@ -221,7 +239,19 @@  a2seed = extractPKCS15Seed a2PrivKey a2jweKey +a3Payload = a2Payload +a3jwk = "{\"kty\":\"oct\", \"k\":\"GawgguFyGrWKav7AX4VKUg\"}"++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]++a3 :: B.ByteString+a3 = "eyJhbGciOiJBMTI4S1ciLCJlbmMiOiJBMTI4Q0JDLUhTMjU2In0.6KB707dM9YTIgHtLvtgWQ8mKwboJW3of9locizkDTHzBC2IlrT1oOQ.AxY8DCtDaGlsbGljb3RoZQ.KDlTtXchhZTGufMYmOYGS4HffxPSUrfmqCHXaI9wOGY.U0m_YmjN04DJvceFICbCVQ"+++ -------------------------------------------------------------------------------- -- Quickcheck Stuff --------------------------------------------------------------------------------@@ -230,19 +260,18 @@ data JWEAlgs = JWEAlgs JweAlg Enc deriving Show  instance Arbitrary Enc where-    arbitrary = elements [A128CBC_HS256, A256CBC_HS512, A128GCM, A256GCM]+    arbitrary = elements [A128CBC_HS256, A192CBC_HS384, A256CBC_HS512, A128GCM, A192GCM, A256GCM]  instance Arbitrary JWEAlgs where   arbitrary = do-    a <- elements [RSA1_5, RSA_OAEP]-    e <- elements [A128CBC_HS256, A256CBC_HS512, A128GCM, A256GCM]+    a <- elements [RSA1_5, RSA_OAEP, A128KW, A192KW, A256KW]+    e <- arbitrary     return $ JWEAlgs a e  instance Arbitrary RNG where   arbitrary = (RNG . B.pack) <$> vector 600  - -------------------------------------------------------------------------------- -- Utility Functions --------------------------------------------------------------------------------@@ -270,11 +299,10 @@ extractOaepSeed key ct = B.pack $ B.zipWith xor maskedSeed seedMask   where     em       = dp Nothing key ct-    sha1     = hashFunction hashDescrSHA1-    hashLen  = B.length $ sha1 B.empty+    hashLen  = hashDigestSize SHA1     em0      = B.tail em     (maskedSeed, maskedDB) = B.splitAt hashLen em0-    seedMask = mgf1 sha1 maskedDB hashLen+    seedMask = mgf1 SHA1 maskedDB hashLen   -- Decrypt, drop the 02 at the start and take the bytes up to the next 0 extractPKCS15Seed :: RSA.PrivateKey -> B.ByteString -> B.ByteString

@@ -8,8 +8,12 @@ import Data.Aeson import Data.Aeson.QQ import qualified Data.ByteString.Char8 ()-import Crypto.Types.PubKey.ECDSA-import Crypto.Types.PubKey.ECC+import qualified Data.HashMap.Strict as H+import Data.Word (Word64)+import qualified Data.Vector as V+import Crypto.PubKey.ECC.ECDSA+import Crypto.PubKey.ECC.Types+import Crypto.Random (drgNewTest, withDRG)  import Jose.Jwt (defJwsHdr, JwsHeader(..), KeyId(..)) import Jose.Jwk@@ -37,15 +41,20 @@ spec :: Spec spec = do     let Success s@(JwkSet _) = fromJSON (Object keySet) :: Result JwkSet-    describe "JWK encoding and decoding" $+        Just s'  = decode' (encode s) :: Maybe JwkSet+        Just s'' = decode' (encode s) :: Maybe JwkSet+        kss      = keys s'+        k0       = head kss+        k1       = kss !! 1+        k3       = kss !! 3+        k4       = kss !! 4+    describe "JWK encoding and decoding" $ do         it "decodes and encodes an entire key set successfully" $ do-            let Just s' = decode' (encode s) :: Maybe JwkSet-                kss = keys s'-                RsaPublicJwk  _ key0Id key0Use    a0   = head kss-                RsaPublicJwk  _ key1Id key1Use    _    = kss !! 1+            let RsaPublicJwk  _ key0Id key0Use    a0   = k0+                RsaPublicJwk  _ key1Id key1Use    _    = k1                 EcPublicJwk   k key2Id key2Use    _ _  = kss !! 2-                EcPublicJwk   _ key3Id key3Use    _ _  = kss !! 3-                SymmetricJwk  _ key4Id Nothing    _    = kss !! 4+                EcPublicJwk _ key3Id key3Use  _ _      = k3+                SymmetricJwk _ key4Id Nothing _        = k4                 EcPublicJwk   _ key5Id (Just Enc) _ _  = kss !! 5                 RsaPublicJwk  _ key6Id Nothing    a6   = kss !! 6                 EcPrivateJwk  _ key7Id (Just Enc) _ _  = kss !! 7@@ -68,7 +77,24 @@             key3Use @?= Just Enc             a6      @?= Just (Signed RS256)             a8      @?= Just (Signed RS256)+            isPublic k3 @?= True+            isPublic k4 @?= False+            isPrivate k4 @?= False+        it "shameless Show and Eq coverage boosting" $ do+            s' @?= s''+            assertBool "Different sets aren't equal" (s' /= JwkSet { keys = take 8 kss ++ [k0]})+            assertBool "Show stuff" $ showCov s' && showCov k0 && showCov k3 && showCov Sig+            assertBool "Different keys should be unequal" (k0 /= k1) +    describe "Errors in JWK data" $ do+        let Just (Array ks) = H.lookup "keys" keySet+            Object k0obj = V.head ks+        it "invalid Base64 returns an error" $ do+            let result = fromJSON (Object $ H.insert "n" (String "NotBase64**") k0obj) :: Result Jwk+            case result of+                Error _ -> assertBool "" True+                _       -> assertFailure "Expected an error for invalid base 64"+     describe "JWK Algorithm matching" $ do         let jwks = keys s         it "finds one key for RS256 encoding" $ do@@ -89,3 +115,24 @@             -- Only key a0 matches. The other 3 RSA keys are signing keys             let jwks' = filter (canEncodeJwe RSA1_5) jwks             length jwks' @?= 1++    describe "RSA Key generation" $ do+        let rng = drgNewTest (w, w, w, w, w) where w = 1 :: Word64+            kid = KeyId "mykey"+            ((kPub, kPr), _) = withDRG rng (generateRsaKeyPair 512 kid Sig Nothing)+        it "keys generated with same RNG are equal" $ do+            let ((kPub', kPr'), _) = withDRG rng (generateRsaKeyPair 512 kid Sig Nothing)+            kPub' @?= kPub+            kPr'  @?= kPr+        it "isPublic and isPrivate are correct for RSA keys" $ do+            isPublic kPub @?= True+            isPublic kPr  @?= False+            isPrivate kPr @?= True+        it "keys have supplied ID" $ do+            jwkId kPr  @?= Just kid+            jwkId kPub @?= Just kid+        it "keys have supplied use" $ do+            jwkUse kPr  @?= Just Sig+            jwkUse kPub @?= Just Sig+  where+    showCov x = showList [x] `seq` showsPrec 1 x `seq` show x `seq` True

@@ -9,28 +9,23 @@ import Data.Aeson (decodeStrict') import qualified Data.ByteString as B import qualified Data.ByteString.Char8 ()-import qualified Crypto.Hash.SHA256 as SHA256-import Crypto.MAC.HMAC (hmac)+import Data.Word (Word64)+import Crypto.Hash.Algorithms (SHA256(..))+import Crypto.MAC.HMAC (HMAC, hmac) import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSAPKCS15-import Crypto.PubKey.HashDescr-import Crypto.Random (CPRG(..))+import Crypto.Random (withDRG, drgNewTest)  import Jose.Jwt import Jose.Jwa import qualified Jose.Internal.Base64 as B64 import qualified Jose.Jws as Jws --- Test CPRG which just produces a stream of '255' bytes-data RNG = RNG deriving (Show, Eq) -instance CPRG RNG where-    cprgCreate              = undefined-    cprgSetReseedThreshold  = undefined-    cprgGenerate n g        = (B.replicate n 255, g)-    cprgGenerateWithEntropy = undefined-    cprgFork                = undefined+testRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64 +fstWithRNG = fst . withDRG testRNG+ {-- Examples from the JWS appendix A --}  spec :: Spec@@ -46,7 +41,7 @@          it "decodes the payload using the JWK" $ do           let Just k11 = decodeStrict' a11jwk-          fst (decode RNG [k11] Nothing a11) @?= fmap Jws a11decoded+          fstWithRNG (decode [k11] Nothing a11) @?= fmap Jws a11decoded          it "encodes/decodes using HS512" $           hmacRoundTrip HS512 a11Payload@@ -60,10 +55,10 @@          it "decodes the JWT to the expected header and payload with the JWK" $ do           let Just k21 = decodeStrict' a21jwk-          fst (decode RNG [k21] (Just (JwsEncoding RS256)) a21) @?= (Right $ Jws (defJwsHdr {jwsAlg = RS256}, a21Payload))+          fstWithRNG (decode [k21] (Just (JwsEncoding RS256)) a21) @?= (Right $ Jws (defJwsHdr {jwsAlg = RS256}, a21Payload))          it "encodes the payload to the expected JWT" $ do-          let sign = either (error "Sign failed") id . RSAPKCS15.sign Nothing hashDescrSHA256 rsaPrivateKey+          let sign = either (error "Sign failed") id . RSAPKCS15.sign Nothing (Just SHA256) rsaPrivateKey           signWithHeader sign a21Header a21Payload @?= a21          it "encodes/decodes using RS256" $@@ -79,15 +74,15 @@         let a31decoded = Right (defJwsHdr {jwsAlg = ES256}, a31Payload)         it "decodes the JWT to the expected header and payload" $ do           let Just k31 = decodeStrict' a31jwk-          fst (decode RNG [k31] Nothing a31) @?= fmap Jws a31decoded+          fstWithRNG (decode [k31] Nothing a31) @?= fmap Jws a31decoded        context "when using an unsecured JWT" $ do         it "returns an error if alg is unset" $-          fst (decode RNG [] Nothing jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'")+          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'" $-          fst (decode RNG [] (Just (JwsEncoding RS256)) jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was 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" $-          fst (decode RNG [] (Just (JwsEncoding None)) jwt61) @?= Right (Unsecured jwt61Payload)+          fstWithRNG (decode [] (Just (JwsEncoding None)) jwt61) @?= Right (Unsecured jwt61Payload)   signWithHeader sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload]@@ -97,7 +92,7 @@ hmacRoundTrip a msg = let Right (Jwt encoded) = Jws.hmacEncode a "asecretkey" msg                      in  Jws.hmacDecode "asecretkey" encoded @?= Right (defJwsHdr {jwsAlg = a}, msg) -rsaRoundTrip a msg = let Right (Jwt encoded) = fst $ Jws.rsaEncode RNG a rsaPrivateKey msg+rsaRoundTrip a msg = let Right (Jwt encoded) = fstWithRNG (Jws.rsaEncode a rsaPrivateKey msg)                      in  Jws.rsaDecode rsaPublicKey encoded @?= Right (defJwsHdr {jwsAlg = a}, msg)  -- Unsecured JWT from section 6.1@@ -155,4 +150,5 @@     , RSA.public_e = rsaExponent     } -a11mac = hmac SHA256.hash 64 hmacKey+a11mac :: B.ByteString -> HMAC SHA256+a11mac = hmac hmacKey