diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ + +0.7.1 +--- + +* Update cryptonite version to 0.19 to avoid security issues +* Fix broken benchmark code +* Better error message for invalid key length when using AES keywrap + 0.7 --- diff --git a/Jose/Internal/Crypto.hs b/Jose/Internal/Crypto.hs --- a/Jose/Internal/Crypto.hs +++ b/Jose/Internal/Crypto.hs @@ -173,9 +173,17 @@ -- Dummy type to constrain Cipher type data C c = C -initCipher :: BlockCipher c => C c -> B.ByteString -> Maybe c -initCipher _ k = maybeCryptoError $ cipherInit k +initCipher :: BlockCipher c => C c -> ByteString -> Either JwtError c +initCipher _ k = mapFail (cipherInit k) +-- Map CryptoFailable to JwtError +mapFail :: CryptoFailable a -> Either JwtError a +mapFail (CryptoPassed a) = return a +mapFail (CryptoFailed e) = Left $ case e of + CryptoError_KeySizeInvalid -> KeyError "cipher key length is invalid" + _ -> BadCrypto + + -- | Decrypt an AES encrypted message. decryptPayload :: Enc -- ^ Encryption algorithm -> ByteString -- ^ Content management key @@ -197,14 +205,14 @@ doGCM :: BlockCipher c => C c -> Maybe ByteString doGCM c = do - cipher <- initCipher c cek + cipher <- rightToMaybe (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 + cipher <- rightToMaybe (initCipher c cbcEncKey) iv' <- makeIV iv unless (B.length ct `mod` blockSize cipher == 0) Nothing unpad $ cbcDecrypt cipher iv' ct @@ -237,13 +245,13 @@ doGCM :: BlockCipher c => C c -> Maybe (AuthTag, ByteString) doGCM c = do - cipher <- initCipher c cek + cipher <- rightToMaybe (initCipher c cek) aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv) return $ aeadSimpleEncrypt aead aad msg 16 doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> a -> Int -> Maybe (AuthTag, ByteString) doCBC c a tagLen = do - cipher <- initCipher c cbcEncKey + cipher <- rightToMaybe (initCipher c cbcEncKey) iv' <- makeIV iv let ct = cbcEncrypt cipher iv' (pad msg) mac = doMac a ct @@ -271,6 +279,7 @@ padByte = fromIntegral $ 16 - lastBlockSize :: Word8 padding = B.replicate (fromIntegral padByte) padByte + -- Key wrapping and unwrapping functions -- | @@ -287,7 +296,7 @@ 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 + cipher <- initCipher c kek let p = toBlocks cek (r0, r) = foldl (doRound (ecbEncrypt cipher) 1) (iv, p) [0..5] Right $ B.concat (r0 : r) @@ -322,7 +331,7 @@ doUnWrap c = do when (l < 24 || l `mod` 8 /= 0) (Left BadCrypto) - cipher <- maybe (Left BadCrypto) return $ initCipher c kek + cipher <- 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) diff --git a/Jose/Jwa.hs b/Jose/Jwa.hs --- a/Jose/Jwa.hs +++ b/Jose/Jwa.hs @@ -13,7 +13,6 @@ import Control.Applicative (pure) import Data.Aeson import Data.Text (Text) -import Data.Maybe (fromJust) import Data.Tuple (swap) -- | General representation of the @alg@ JWT header value. @@ -35,7 +34,7 @@ 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 +algName a = let Just n = lookup a algNames in n algNames :: [(Alg, Text)] algNames = map swap algs @@ -44,7 +43,7 @@ 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 +encName e = let Just n = lookup e encNames in n encNames :: [(Enc, Text)] encNames = map swap encs diff --git a/Jose/Jwe.hs b/Jose/Jwe.hs --- a/Jose/Jwe.hs +++ b/Jose/Jwe.hs @@ -6,12 +6,10 @@ -- -- >>> import Jose.Jwe -- >>> import Jose.Jwa --- >>> import Crypto.Random --- >>> g <- drgNew -- >>> import Crypto.PubKey.RSA --- >>> 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) +-- >>> (kPub, kPr) <- generate 512 65537 +-- >>> Right (Jwt jwt) <- rsaEncode RSA_OAEP A128GCM kPub "secret claims" +-- >>> rsaDecode kPr jwt -- Right (JweHeader {jweAlg = RSA_OAEP, jweEnc = A128GCM, jweTyp = Nothing, jweCty = Nothing, jweZip = Nothing, jweKid = Nothing},"secret claims") module Jose.Jwe diff --git a/Jose/Jwt.hs b/Jose/Jwt.hs --- a/Jose/Jwt.hs +++ b/Jose/Jwt.hs @@ -10,12 +10,10 @@ -- >>> import Jose.Jwk -- >>> import Data.ByteString -- >>> import Data.Aeson (decodeStrict) --- >>> 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') = withDRG g $ encode [jwk] (JwsEncoding RS256) (Claims "public claims") --- >>> let (Right jwtDecoded, g'') = withDRG g' $ Jose.Jwt.decode [jwk] (Just (JwsEncoding RS256)) jwtEncoded +-- >>> Right (Jwt jwtEncoded) <- encode [jwk] (JwsEncoding RS256) (Claims "public claims") +-- >>> Right jwtDecoded <- Jose.Jwt.decode [jwk] (Just (JwsEncoding RS256)) jwtEncoded -- >>> jwtDecoded -- Jws (JwsHeader {jwsAlg = RS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Just (KeyId "mykey")},"public claims") @@ -27,7 +25,7 @@ ) where -import Control.Monad (when, unless, liftM) +import Control.Monad (msum, when, unless, liftM) import Control.Monad.Trans (lift) import Control.Monad.Trans.Either import qualified Crypto.PubKey.ECC.ECDSA as ECDSA @@ -35,8 +33,7 @@ import Crypto.Random (MonadRandom) import Data.Aeson (decodeStrict') import Data.ByteString (ByteString) -import Data.List (find) -import Data.Maybe (fromJust, isJust, isNothing) +import Data.Maybe (isNothing) import qualified Data.ByteString.Char8 as BC import qualified Jose.Internal.Base64 as B64 @@ -104,7 +101,9 @@ JweH h -> do unless (isNothing encoding || encoding == Just (JweEncoding (jweAlg h) (jweEnc h))) $ left (BadAlgorithm "Expected encoding doesn't match JWE header") mapM decodeWithJwe ks - maybe (left $ KeyError "None of the keys was able to decode the JWT") (return . fromJust) $ find isJust decodings + case msum decodings of + Nothing -> left $ KeyError "None of the keys was able to decode the JWT" + Just jwt -> return jwt where decodeWithJws :: MonadRandom m => Jwk -> EitherT JwtError m (Maybe JwtContent) decodeWithJws k = either (const $ return Nothing) (return . Just . Jws) $ case k of diff --git a/benchmarks/bench.hs b/benchmarks/bench.hs --- a/benchmarks/bench.hs +++ b/benchmarks/bench.hs @@ -1,17 +1,21 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} module Main where import Criterion.Main import Crypto.Random +import Data.Word (Word64) import Jose.Jws import Jose.Jwa import Jose.Jwt import Keys +benchRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64 + +fstWithRNG = fst . withDRG benchRNG + main = do - rng <- cprgCreate `fmap` createEntropyPool :: IO SystemRNG let msg = "The best laid schemes o' mice and men" - rsaE a m = case fst $ rsaEncode rng a jwsRsaPrivateKey m of + rsaE a m = case fstWithRNG (rsaEncode a jwsRsaPrivateKey m) of Left _ -> error "RSA encode shouldn't fail" Right (Jwt j) -> j hmacE a m = case hmacEncode a jwsHmacKey m of @@ -21,9 +25,12 @@ defaultMain [ bgroup "JWS" [ bench "encode RSA256" $ nf (rsaE RS256) msg +#if MIN_VERSION_cryptonite(0,13,0) , bench "encode RSA384" $ nf (rsaE RS384) msg - , bench "encode RSA512" $ nf (rsaE RS384) msg +#endif + , bench "encode RSA512" $ nf (rsaE RS512) msg , bench "encode HS256" $ nf (hmacE HS256) msg + , bench "encode HS384" $ nf (hmacE HS384) msg , bench "encode HS512" $ nf (hmacE HS512) msg ] ] diff --git a/jose-jwt.cabal b/jose-jwt.cabal --- a/jose-jwt.cabal +++ b/jose-jwt.cabal @@ -1,5 +1,5 @@ Name: jose-jwt -Version: 0.7 +Version: 0.7.1 Synopsis: JSON Object Signing and Encryption Library Homepage: http://github.com/tekul/jose-jwt Bug-Reports: http://github.com/tekul/jose-jwt/issues @@ -30,7 +30,7 @@ Source-Repository head Type: git - Location: git://github.com/tekul/jose-jwt.git + Location: https://github.com/tekul/jose-jwt.git Library Default-Language: Haskell2010 @@ -42,12 +42,12 @@ , Jose.Internal.Base64 , Jose.Internal.Crypto Other-Modules: Jose.Types - Build-Depends: base >= 4 && < 5 + Build-Depends: base >= 4.6 && < 5 , aeson >= 0.8.0.2 , bytestring >= 0.9 , cereal >= 0.4 , containers >= 0.4 - , cryptonite >= 0.3 + , cryptonite >= 0.19 , either , memory >= 0.10 , mtl >= 2.1.3.1 @@ -105,5 +105,6 @@ , base , bytestring , criterion + , cryptonite 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 @@ -6,7 +6,6 @@ import Control.Applicative import Data.Aeson (decodeStrict') import Data.Bits (xor) -import Data.Maybe (fromJust) import Data.Word (Word8, Word64) import qualified Data.ByteArray as BA import qualified Data.ByteString as B @@ -133,7 +132,7 @@ 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 (fromJust . unpad . pad) msg == msg + \s -> let msg = B.pack s in (unpad . pad) msg == Just msg it "jwe decode/decode returns the original payload" $ property jweRoundTrip context "miscellaneous tests" $ do @@ -148,7 +147,7 @@ jweRoundTrip :: RNG -> JWEAlgs -> [Word8] -> Bool jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (Jwe (defJweHdr {jweAlg = a, jweEnc = e}, bs)) where - jwks = map (fromJust . decodeStrict') [a1jwk, a2jwk, a3jwk] + jwks = [a1jwk, a2jwk, a3jwk] >>= \j -> let Just jwk = decodeStrict' j in [jwk] bs = B.pack msg encodeDecode = fst (withDRG blinderRNG (decode jwks Nothing encoded)) Right encoded = unJwt <$> fst (withDRG g (encode jwks (JweEncoding a e) (Claims bs)))