Skip to content

Commit

Permalink
Fix broken tests due to change in aeson field order
Browse files Browse the repository at this point in the history
See commercialhaskell/stackage#5878

The problem is that the JWE header is generated internally and since
it is included in the signature, the tests which attempt to reproduce
the JWE values from the spec exactly fail.

Since the header is a simple structure, instead of using Aeson
to encode the encode it we just create a ByteString directly with
the original order (and encode the Alg and Enc values into it).
  • Loading branch information
tekul committed Mar 14, 2021
1 parent 7d208a0 commit 1245b4d
Show file tree
Hide file tree
Showing 2 changed files with 34 additions and 18 deletions.
41 changes: 28 additions & 13 deletions Jose/Jwe.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,20 +12,20 @@
-- of the token need to have a copy of the key, which they must keep secret. With
-- RSA anyone can send you a JWE if they have a copy of your public key.
--
-- In the example below, we show encoding and decoding using a 512 byte RSA key pair
-- (in practice you would use a larger key-size, for example 2048 bytes):
-- In the example below, we show encoding and decoding using a 2048 bit RSA key pair
-- (256 bytes).
--
-- >>> import Jose.Jwe
-- >>> import Jose.Jwa
-- >>> import Jose.Jwk (generateRsaKeyPair, generateSymmetricKey, KeyUse(Enc), KeyId)
-- >>> (kPub, kPr) <- generateRsaKeyPair 512 (KeyId "My RSA Key") Enc Nothing
-- >>> (kPub, kPr) <- generateRsaKeyPair 256 (KeyId "My RSA Key") Enc Nothing
-- >>> Right (Jwt jwt) <- jwkEncode RSA_OAEP A128GCM kPub (Claims "secret claims")
-- >>> Right (Jwe (hdr, claims)) <- jwkDecode kPr jwt
-- >>> claims
-- "secret claims"
--
-- Using 128-bit AES keywrap is very similar, the main difference is that
-- we generate a 128-bit symmetric key:
-- we generate a 128-bit symmetric key (16 bytes):
--
-- >>> aesKey <- generateSymmetricKey 16 (KeyId "My Keywrap Key") Enc Nothing
-- >>> Right (Jwt jwt) <- jwkEncode A128KW A128GCM aesKey (Claims "more secret claims")
Expand All @@ -46,10 +46,13 @@ import Control.Monad.Trans.Except
import Crypto.Cipher.Types (AuthTag(..))
import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder, private_pub)
import Crypto.Random (MonadRandom)
import qualified Data.Aeson as A
import Data.ByteArray (ByteArray, ScrubbedBytes)
import qualified Data.ByteArray as BA
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (isNothing)
import Jose.Types
import qualified Jose.Internal.Base64 as B64
import Jose.Internal.Crypto
Expand All @@ -67,13 +70,24 @@ jwkEncode :: MonadRandom m
-> Payload -- ^ The token content (claims or nested JWT)
-> m (Either JwtError Jwt) -- ^ The encoded JWE if successful
jwkEncode a e jwk payload = runExceptT $ 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) (ExceptT . return . keyWrap a (BA.convert kek)) bytes
RsaPublicJwk kPub kid _ _ -> doEncode (hdr kid) e (doRsa kPub) bytes
RsaPrivateJwk kPr kid _ _ -> doEncode (hdr kid) e (doRsa (private_pub kPr)) bytes
SymmetricJwk kek kid _ _ -> doEncode (hdr kid) e (ExceptT . return . keyWrap a (BA.convert kek)) bytes
_ -> throwE $ KeyError "JWK cannot encode a JWE"
where
doRsa kPub = ExceptT . rsaEncrypt kPub a
hdr kid = defJweHdr {jweAlg = a, jweEnc = e, jweKid = kid, jweCty = contentType}
hdr :: Maybe KeyId -> B.ByteString
hdr kid = BL.toStrict $
BL.concat
[ "{\"alg\":"
, A.encode a
, ",\"enc\":"
, A.encode e
, maybe "" (\c -> BL.concat [",\"cty\":\"", c, "\"" ]) contentType
, if isNothing kid then "" else BL.concat [",\"kid\":", A.encode kid ]
, "}"
]

(contentType, bytes) = case payload of
Claims c -> (Nothing, c)
Nested (Jwt b) -> (Just "JWT", b)
Expand Down Expand Up @@ -117,19 +131,18 @@ doDecode decodeCek jwt = do


doEncode :: (MonadRandom m, ByteArray ba)
=> JweHeader
=> ByteString
-> Enc
-> (ScrubbedBytes -> ExceptT JwtError m ByteString)
-> ba
-> ExceptT JwtError m Jwt
doEncode h encryptKey claims = do
doEncode hdr e 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, BA.convert iv, BA.convert 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.
Expand All @@ -139,7 +152,9 @@ rsaEncode :: MonadRandom m
-> PublicKey -- ^ RSA key to encrypt with
-> ByteString -- ^ The JWT claims (content)
-> m (Either JwtError Jwt) -- ^ The encoded JWE
rsaEncode a e kPub claims = runExceptT $ doEncode (defJweHdr {jweAlg = a, jweEnc = e}) (ExceptT . rsaEncrypt kPub a) claims
rsaEncode a e kPub claims = runExceptT $ doEncode hdr e (ExceptT . rsaEncrypt kPub a) claims
where
hdr = BL.toStrict $ BL.concat ["{\"alg\":", A.encode a, ",", "\"enc\":", A.encode e, "}"]


-- | Decrypts a JWE.
Expand Down
11 changes: 6 additions & 5 deletions tests/Tests/JweSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,12 @@
module Tests.JweSpec where

import Control.Applicative
import Data.Aeson (decodeStrict')
import Data.Aeson (decodeStrict', ToJSON)
import Data.Bits (xor)
import Data.Word (Word8, Word64)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BC
import Test.Hspec
import Test.HUnit hiding (Test)
Expand Down Expand Up @@ -48,7 +49,7 @@ spec =
(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
let aad = B64.encode ("{\"alg\":\"RSA-OAEP\",\"enc\":\"A256GCM\"}" :: B.ByteString)
encryptPayload A256GCM a1cek a1iv aad a1Payload @?= Just (AuthTag a1Tag, a1Ciphertext)

it "encodes the payload to the expected JWT, leaving the RNG empty" $
Expand Down Expand Up @@ -94,7 +95,7 @@ spec =

context "when using JWE Appendix 2 data" $ do
let a2Header = defJweHdr {jweAlg = RSA1_5, jweEnc = A128CBC_HS256}
let aad = B64.encode . encodeHeader $ a2Header
let aad = B64.encode ("{\"alg\":\"RSA1_5\",\"enc\":\"A128CBC-HS256\"}" :: B.ByteString)

it "generates the expected RSA-encrypted content key" $
withDRG (RNG a2seed) (rsaEncrypt a2PubKey RSA1_5 a2cek) @?= (Right a2jweKey, RNG "")
Expand Down Expand Up @@ -130,7 +131,7 @@ spec =
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" $
it "encodes the payload to the expected JWT" $
withDRG (RNG $ B.concat [a3cek, a3iv])
(Jwe.jwkEncode A128KW A128CBC_HS256 jwk (Claims a3Payload)) @?= (Right (Jwt a3), RNG "")

Expand Down Expand Up @@ -159,7 +160,7 @@ up = unpad

-- verboseQuickCheckWith quickCheckWith stdArgs {maxSuccess=10000} jweRoundTrip
jweRoundTrip :: RNG -> JWEAlgs -> [Word8] -> Bool
jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (Jwe (defJweHdr {jweAlg = a, jweEnc = e}, bs))
jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (Jwe (defJweHdr {jweAlg = a, jweEnc = e }, bs))
where
jwks = [a1jwk, a2jwk, a3jwk, aes192jwk, aes256jwk] >>= \j -> let Just jwk = decodeStrict' j in [jwk]
bs = B.pack msg
Expand Down

0 comments on commit 1245b4d

Please sign in to comment.