diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. - diff --git a/Jose/Internal/Base64.hs b/Jose/Internal/Base64.hs --- a/Jose/Internal/Base64.hs +++ b/Jose/Internal/Base64.hs @@ -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 diff --git a/Jose/Internal/Crypto.hs b/Jose/Internal/Crypto.hs --- a/Jose/Internal/Crypto.hs +++ b/Jose/Internal/Crypto.hs @@ -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 + +-- | +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) diff --git a/Jose/Jwa.hs b/Jose/Jwa.hs --- a/Jose/Jwa.hs +++ b/Jose/Jwa.hs @@ -20,20 +20,19 @@ data Alg = Signed JwsAlg | Encrypted JweAlg deriving (Eq, Show) -- | A subset of the signature algorithms from the --- . +-- . 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 --- . -data JweAlg = RSA1_5 | RSA_OAEP deriving (Eq, Show, Read) +-- . +data JweAlg = RSA1_5 | RSA_OAEP | A128KW | A192KW | A256KW deriving (Eq, Show, Read) -- | Content encryption algorithms from the --- . --- The optional algorithms A192CBC-HS384 and A192GCM are not supported yet. -data Enc = A128CBC_HS256 | A256CBC_HS512 | A128GCM | A256GCM deriving (Eq, Show) +-- . +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 - diff --git a/Jose/Jwe.hs b/Jose/Jwe.hs --- a/Jose/Jwe.hs +++ b/Jose/Jwe.hs @@ -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 diff --git a/Jose/Jwk.hs b/Jose/Jwk.hs --- a/Jose/Jwk.hs +++ b/Jose/Jwk.hs @@ -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)) diff --git a/Jose/Jws.hs b/Jose/Jws.hs --- a/Jose/Jws.hs +++ b/Jose/Jws.hs @@ -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) - diff --git a/Jose/Jwt.hs b/Jose/Jwt.hs --- a/Jose/Jwt.hs +++ b/Jose/Jwt.hs @@ -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, diff --git a/jose-jwt.cabal b/jose-jwt.cabal --- a/jose-jwt.cabal +++ b/jose-jwt.cabal @@ -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 - (). + An implementation of the JOSE suite of IETF standards + and the closely related JWT (JSON web token) spec + (). . 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 Maintainer: Luke Taylor @@ -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 - diff --git a/tests/Tests/JweSpec.hs b/tests/Tests/JweSpec.hs --- a/tests/Tests/JweSpec.hs +++ b/tests/Tests/JweSpec.hs @@ -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 diff --git a/tests/Tests/JwkSpec.hs b/tests/Tests/JwkSpec.hs --- a/tests/Tests/JwkSpec.hs +++ b/tests/Tests/JwkSpec.hs @@ -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 diff --git a/tests/Tests/JwsSpec.hs b/tests/Tests/JwsSpec.hs --- a/tests/Tests/JwsSpec.hs +++ b/tests/Tests/JwsSpec.hs @@ -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