diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +0.4 +--- + +* Changed use of `Jwt` type to represent an encoded JWT. +* Introduced `Payload` type to allow setting the `cty` header value correctly for nested JWTs. +* Added an explicit `Unsecured` type for a decoded JWT, to make it obvious when the content is not signed or encrypted. +* Fixed some bugs in JSON encoding and decoding of EC JWKs. + 0.3.1 ----- diff --git a/Jose/Jwe.hs b/Jose/Jwe.hs --- a/Jose/Jwe.hs +++ b/Jose/Jwe.hs @@ -10,7 +10,7 @@ -- >>> g <- makeSystem -- >>> import Crypto.PubKey.RSA -- >>> let ((kPub, kPr), g') = generate g 512 65537 --- >>> let (jwt, g'') = rsaEncode g' RSA_OAEP A128GCM kPub "secret claims" +-- >>> let (Jwt jwt, g'') = rsaEncode g' RSA_OAEP A128GCM kPub "secret claims" -- >>> fst $ rsaDecode g'' kPr jwt -- Right (JweHeader {jweAlg = RSA_OAEP, jweEnc = A128GCM, jweTyp = Nothing, jweCty = Nothing, jweZip = Nothing, jweKid = Nothing},"secret claims") @@ -42,14 +42,17 @@ -> JweAlg -- ^ Algorithm to use for key encryption -> Enc -- ^ Content encryption algorithm -> Jwk -- ^ The key to use to encrypt the content key - -> ByteString -- ^ The token content (claims) - -> (Either JwtError ByteString, g) -- ^ The encoded JWE if successful -jwkEncode rng a e jwk claims = case jwk of - RsaPublicJwk kPub kid _ _ -> first Right $ rsaEncodeInternal rng (hdr kid) kPub claims - RsaPrivateJwk kPr kid _ _ -> first Right $ rsaEncodeInternal rng (hdr kid) (private_pub kPr) claims + -> 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) where - hdr kid = defJweHdr {jweAlg = a, jweEnc = e, jweKid = kid} + 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 @@ -58,7 +61,7 @@ -> Enc -- ^ Content encryption algorithm -> PublicKey -- ^ RSA key to encrypt with -> ByteString -- ^ The JWT claims (content) - -> (ByteString, g) -- ^ The encoded JWE and new generator + -> (Jwt, g) -- ^ The encoded JWE and new generator rsaEncode rng a e = rsaEncodeInternal rng (defJweHdr {jweAlg = a, jweEnc = e}) rsaEncodeInternal :: CPRG g @@ -66,8 +69,8 @@ -> JweHeader -> PublicKey -> ByteString - -> (ByteString, g) -rsaEncodeInternal rng h pubKey claims = (jwe, rng'') + -> (Jwt, g) +rsaEncodeInternal rng h pubKey claims = (Jwt jwe, rng'') where a = jweAlg h e = jweEnc h @@ -97,6 +100,7 @@ hdr <- case parseHeader h of Right (JweH jweHdr) -> return jweHdr Right (JwsH _) -> Left (BadHeader "Header is for a JWS") + Right UnsecuredH -> Left (BadHeader "Header is for an unsecured JWT") Left e -> Left e let alg = jweAlg hdr cek <- rsaDecrypt (Just b) alg pk ek diff --git a/Jose/Jwk.hs b/Jose/Jwk.hs --- a/Jose/Jwk.hs +++ b/Jose/Jwk.hs @@ -3,7 +3,7 @@ module Jose.Jwk ( KeyType - , KeyUse + , KeyUse (..) , KeyId , Jwk (..) , JwkSet (..) @@ -46,8 +46,8 @@ 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) - | EcPrivateJwk ECDSA.KeyPair (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) @@ -101,8 +101,8 @@ jwkId key = case key of RsaPublicJwk _ keyId _ _ -> keyId RsaPrivateJwk _ keyId _ _ -> keyId - EcPublicJwk _ keyId _ _ -> keyId - EcPrivateJwk _ keyId _ _ -> keyId + EcPublicJwk _ keyId _ _ _ -> keyId + EcPrivateJwk _ keyId _ _ _ -> keyId SymmetricJwk _ keyId _ _ -> keyId @@ -110,8 +110,8 @@ jwkUse key = case key of RsaPublicJwk _ _ u _ -> u RsaPrivateJwk _ _ u _ -> u - EcPublicJwk _ _ u _ -> u - EcPrivateJwk _ _ u _ -> u + EcPublicJwk _ _ u _ _ -> u + EcPrivateJwk _ _ u _ _ -> u SymmetricJwk _ _ u _ -> u findKeyById :: [Jwk] -> KeyId -> Maybe Jwk @@ -215,16 +215,17 @@ , alg = mAlg } - EcPublicJwk pubKey mId mUse mAlg -> defJwk + EcPublicJwk pubKey mId mUse mAlg c -> defJwk { kty = Ec , x = fst (ecPoint pubKey) , y = snd (ecPoint pubKey) , kid = mId , use = mUse , alg = mAlg + , crv = Just c } - EcPrivateJwk kp mId mUse mAlg -> defJwk + EcPrivateJwk kp mId mUse mAlg c -> defJwk { kty = Ec , x = fst (ecPoint (ECDSA.toPublicKey kp)) , y = snd (ecPoint (ECDSA.toPublicKey kp)) @@ -232,6 +233,7 @@ , kid = mId , use = mUse , alg = mAlg + , crv = Just c } where i2b 0 = Nothing @@ -314,10 +316,10 @@ 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 + 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 - _ -> Left "Invalid key data. Didn't match any known JWK parameter combinations." + 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 where rsaPub nb eb = let m = os2ip $ bytes nb ex = os2ip $ bytes eb diff --git a/Jose/Jws.hs b/Jose/Jws.hs --- a/Jose/Jws.hs +++ b/Jose/Jws.hs @@ -6,7 +6,7 @@ -- -- >>> import Jose.Jws -- >>> import Jose.Jwa --- >>> let Right jwt = hmacEncode HS256 "secretmackey" "public claims" +-- >>> let Right (Jwt jwt) = hmacEncode HS256 "secretmackey" "public claims" -- >>> jwt -- "eyJhbGciOiJIUzI1NiJ9.cHVibGljIGNsYWltcw.GDV7RdBrCYfCtFCZZGPy_sWry4GwfX3ckMywXUyxBsc" -- >>> hmacDecode "wrongkey" jwt @@ -46,8 +46,8 @@ => g -> JwsAlg -- ^ The algorithm to use -> Jwk -- ^ The key to sign with - -> ByteString -- ^ The public JWT claims - -> (Either JwtError ByteString, g) -- ^ The encoded token, if successful + -> 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) @@ -57,14 +57,14 @@ hmacEncode :: JwsAlg -- ^ The MAC algorithm to use -> ByteString -- ^ The MAC key -> ByteString -- ^ The public JWT claims (token content) - -> Either JwtError ByteString -- ^ The encoded JWS token -hmacEncode a key payload = hmacEncodeInternal a key (sigTarget a Nothing payload) + -> Either JwtError Jwt -- ^ The encoded JWS token +hmacEncode a key payload = hmacEncodeInternal a key (sigTarget a Nothing (Claims payload)) hmacEncodeInternal :: JwsAlg -> ByteString -> ByteString - -> Either JwtError ByteString -hmacEncodeInternal a key st = (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st + -> Either JwtError Jwt +hmacEncodeInternal a key st = Jwt <$> (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st -- | Decodes and validates an HMAC signed JWS. hmacDecode :: ByteString -- ^ The HMAC key @@ -78,22 +78,22 @@ -> JwsAlg -- ^ The RSA algorithm to use -> PrivateKey -- ^ The key to sign with -> ByteString -- ^ The public JWT claims (token content) - -> (Either JwtError ByteString, g) -- ^ The encoded JWS token -rsaEncode rng a pk payload = rsaEncodeInternal rng a pk (sigTarget a Nothing payload) + -> (Either JwtError Jwt, g) -- ^ The encoded JWS token +rsaEncode rng a pk payload = rsaEncodeInternal rng a pk (sigTarget a Nothing (Claims payload)) rsaEncodeInternal :: CPRG g => g -> JwsAlg -> PrivateKey -> ByteString - -> (Either JwtError ByteString, g) + -> (Either JwtError Jwt, g) rsaEncodeInternal rng a pk st = (sign blinder, rng') where (blinder, rng') = generateBlinder rng (public_n $ private_pub pk) sign b = case rsaSign (Just b) a pk st of - Right sig -> Right $ B.concat [st, ".", B64.encode sig] - err -> err + Right sig -> Right . Jwt $ B.concat [st, ".", B64.encode sig] + Left e -> Left e -- | Decode and validate an RSA signed JWS. rsaDecode :: PublicKey -- ^ The key to check the signature with @@ -108,8 +108,13 @@ -> Either JwtError Jws -- ^ The decoded token if successful ecDecode key = decode (`ecVerify` key) -sigTarget :: JwsAlg -> Maybe KeyId -> ByteString -> ByteString -sigTarget a kid payload = B.intercalate "." $ map B64.encode [encodeHeader $ defJwsHdr {jwsAlg = a, jwsKid = kid}, payload] +sigTarget :: JwsAlg -> Maybe KeyId -> Payload -> ByteString +sigTarget a kid payload = B.intercalate "." $ map B64.encode [encodeHeader hdr, bytes] + where + hdr = defJwsHdr {jwsAlg = a, jwsKid = kid, jwsCty = contentType} + (contentType, bytes) = case payload of + Claims c -> (Nothing, c) + Nested (Jwt b) -> (Just "JWT", b) type JwsVerifier = JwsAlg -> ByteString -> ByteString -> Bool @@ -122,6 +127,7 @@ hdr <- case parseHeader h of Right (JwsH jwsHdr) -> return jwsHdr Right (JweH _) -> Left (BadHeader "Header is for a JWE") + Right UnsecuredH -> Left (BadHeader "Header is for an unsecured JWT") Left e -> Left e if verify (jwsAlg hdr) hdrPayload sigBytes then Right (hdr, payload) diff --git a/Jose/Jwt.hs b/Jose/Jwt.hs --- a/Jose/Jwt.hs +++ b/Jose/Jwt.hs @@ -8,12 +8,13 @@ -- >>> import Jose.Jwe -- >>> import Jose.Jwa -- >>> import Jose.Jwk +-- >>> import Data.ByteString -- >>> import Data.Aeson (decodeStrict) -- >>> import Crypto.Random.AESCtr -- >>> g <- makeSystem --- >>> 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\"}" +-- >>> 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 jwtEncoded, g') = encode g jwk (Signed RS256) Nothing "public claims" +-- >>> let (Right (Jwt jwtEncoded), g') = encode g [jwk] (Signed RS256) Nothing (Claims "public claims") -- >>> let (Right jwtDecoded, g'') = Jose.Jwt.decode g' [jwk] jwtEncoded -- >>> jwtDecoded -- Jws (JwsHeader {jwsAlg = RS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Just "mykey"},"public claims") @@ -51,23 +52,30 @@ -- consistent with the chosen algorithm. -- encode :: (CPRG g) - => g -- ^ Random number generator. - -> [Jwk] -- ^ The key or keys. At least one must be consistent with the chosen algorithm - -> Alg -- ^ The JWS or JWE algorithm - -> Maybe Enc -- ^ The payload encryption algorithm (if applicable) - -> ByteString -- ^ The payload (claims) - -> (Either JwtError ByteString, g) -- ^ The encoded JWT, if successful + => g -- ^ Random number generator. + -> [Jwk] -- ^ The key or keys. At least one must be consistent with the chosen algorithm + -> Alg -- ^ The JWS or JWE algorithm + -> Maybe Enc -- ^ The payload encryption algorithm (if applicable) + -> Payload -- ^ The payload (claims) + -> (Either JwtError Jwt, g) -- ^ The encoded JWT, if successful encode rng jwks alg enc msg = flip runState rng $ runEitherT $ case alg of + Signed None -> do + unless (isNothing enc) $ left (BadAlgorithm "Enc cannot be set for an unsecured JWT") + case msg of + Claims p -> return $ Jwt $ BC.intercalate "." [unsecuredHdr, B64.encode p] + Nested _ -> left BadClaims Signed a -> do unless (isNothing enc) $ left (BadAlgorithm "Enc cannot be set for a JWS") case findMatchingJwsKeys jwks (defJwsHdr { jwsAlg = a }) of - [] -> left (KeyError "No matching key found for JWS algorithm") + [] -> left (KeyError "No matching key found for JWS algorithm") (k:_) -> hoistEither =<< state (\g -> Jws.jwkEncode g a k msg) Encrypted a -> do e <- hoistEither $ note (BadAlgorithm "Enc must be supplied for a JWE") enc case findMatchingJweKeys jwks (defJweHdr { jweAlg = a, jweEnc = e }) of - [] -> left (KeyError "No matching key found for JWE algorithm") + [] -> left (KeyError "No matching key found for JWE algorithm") (k:_) -> hoistEither =<< state (\g -> Jwe.jwkEncode g a e k msg) + where + unsecuredHdr = B64.encode "{\"alg\":\"none\"}" -- | Uses the supplied keys to decode a JWT. @@ -75,32 +83,32 @@ -- or by suitable key type. -- The JWK @use@ and @alg@ options are currently ignored. decode :: CPRG g - => g -- ^ Random number generator. Only used for RSA blinding - -> [Jwk] -- ^ The keys to use for decoding - -> ByteString -- ^ The encoded JWT - -> (Either JwtError Jwt, g) -- ^ The decoded JWT, if successful + => g -- ^ Random number generator. Only used for RSA blinding + -> [Jwk] -- ^ The keys to use for decoding + -> ByteString -- ^ The encoded JWT + -> (Either JwtError JwtContent, g) -- ^ The decoded JWT payload, if successful decode rng keySet jwt = flip runState rng $ runEitherT $ do let components = BC.split '.' jwt when (length components < 3) $ left $ BadDots 2 hdr <- B64.decode (head components) >>= hoistEither . parseHeader ks <- findKeys hdr keySet - -- Now we have one or more suitable keys. + -- Now we have one or more suitable keys (or none for the unsecured case). -- Try each in turn until successful - let decodeWith = case hdr of - JwsH _ -> decodeWithJws - _ -> decodeWithJwe - decodings <- mapM decodeWith ks + decodings <- case hdr of + UnsecuredH -> B64.decode (components !! 1) >>= \p -> return [Just (Unsecured p)] + JwsH _ -> mapM decodeWithJws ks + _ -> 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 Jwt) + decodeWithJws :: CPRG g => Jwk -> EitherT JwtError (State g) (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 - EcPublicJwk kPub _ _ _ -> Jws.ecDecode kPub jwt - EcPrivateJwk kPr _ _ _ -> Jws.ecDecode (ECDSA.toPublicKey kPr) jwt + EcPublicJwk kPub _ _ _ _ -> Jws.ecDecode kPub jwt + EcPrivateJwk kPr _ _ _ _ -> Jws.ecDecode (ECDSA.toPublicKey kPr) jwt SymmetricJwk kb _ _ _ -> Jws.hmacDecode kb jwt - decodeWithJwe :: CPRG g => Jwk -> EitherT JwtError (State g) (Maybe 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) @@ -126,9 +134,10 @@ findKeys :: Monad m => JwtHeader -> [Jwk] -> EitherT JwtError m [Jwk] -findKeys hdr jwks = checkKeys $ case hdr of - JweH h -> findMatchingJweKeys jwks h - JwsH h -> findMatchingJwsKeys jwks h +findKeys hdr jwks = case hdr of + JweH h -> checkKeys $ findMatchingJweKeys jwks h + JwsH h -> checkKeys $ findMatchingJwsKeys jwks h + UnsecuredH -> return [] where -- TODO Move checks to JWK and support better error messages checkKeys [] = left $ KeyError "No suitable key was found to decode the JWT" diff --git a/Jose/Types.hs b/Jose/Types.hs --- a/Jose/Types.hs +++ b/Jose/Types.hs @@ -9,8 +9,10 @@ , JwtHeader (..) , JwsHeader (..) , JweHeader (..) + , JwtContent (..) , JwtError (..) , IntDate (..) + , Payload (..) , KeyId , parseHeader , encodeHeader @@ -30,22 +32,32 @@ import Data.Time.Clock.POSIX import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import Data.Vector (singleton) import GHC.Generics import Jose.Jwa (JweAlg(..), JwsAlg (..), Enc(..)) +-- | An encoded JWT. +newtype Jwt = Jwt { unJwt :: ByteString } deriving (Show, Eq) + +-- | The payload to be encoded in a JWT. +data Payload = Nested Jwt + | Claims ByteString + deriving (Show, Eq) + -- | The header and claims of a decoded JWS. type Jws = (JwsHeader, ByteString) -- | The header and claims of a decoded JWE. type Jwe = (JweHeader, ByteString) --- | A decoded JWT which can be either a JWE or a JWS. -data Jwt = Jws !Jws | Jwe !Jwe deriving (Show, Eq) +-- | A decoded JWT which can be either a JWE or a JWS, or an unsecured JWT. +data JwtContent = Unsecured !ByteString | Jws !Jws | Jwe !Jwe deriving (Show, Eq) data JwtHeader = JweH JweHeader | JwsH JwsHeader + | UnsecuredH deriving (Show) type KeyId = Text @@ -99,11 +111,18 @@ instance ToJSON JwtClaims where toJSON = genericToJSON claimsOptions +instance ToJSON Jwt where + toJSON (Jwt bytes) = String (TE.decodeUtf8 bytes) + +instance FromJSON Jwt where + parseJSON (String token) = pure $ Jwt (TE.encodeUtf8 token) + parseJSON _ = fail "Jwt must be a string" + claimsOptions :: Options claimsOptions = prefixOptions "jwt" defJwsHdr :: JwsHeader -defJwsHdr = JwsHeader None Nothing Nothing Nothing +defJwsHdr = JwsHeader RS256 Nothing Nothing Nothing defJweHdr :: JweHeader defJweHdr = JweHeader RSA_OAEP A128GCM Nothing Nothing Nothing Nothing @@ -132,9 +151,11 @@ parseJSON = genericParseJSON jweOptions instance FromJSON JwtHeader where - parseJSON v@(Object o) = case H.lookup "enc" o of - Nothing -> JwsH <$> parseJSON v - _ -> JweH <$> parseJSON v + parseJSON v@(Object o) = case H.lookup "alg" o of + Just (String "none") -> pure UnsecuredH + _ -> case H.lookup "enc" o of + Nothing -> JwsH <$> parseJSON v + _ -> JweH <$> parseJSON v parseJSON _ = fail "JwtHeader must be an object" encodeHeader :: ToJSON a => a -> ByteString diff --git a/benchmarks/Keys.hs b/benchmarks/Keys.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Keys.hs @@ -0,0 +1,23 @@ +module Keys where + +import qualified Crypto.PubKey.RSA as RSA +import qualified Data.ByteString as B + +jwsHmacKey = B.pack [3, 35, 53, 75, 43, 15, 165, 188, 131, 126, 6, 101, 119, 123, 166, 143, 90, 179, 40, 230, 240, 84, 201, 40, 169, 15, 132, 178, 210, 80, 46, 191, 211, 251, 90, 146, 210, 6, 71, 239, 150, 138, 180, 195, 119, 98, 61, 34, 61, 46, 33, 114, 5, 46, 79, 8, 192, 205, 154, 245, 103, 208, 128, 163] + +jwsRsaPrivateKey = RSA.PrivateKey + { RSA.private_pub = jwsRsaPublicKey + , RSA.private_d = 2358310989939619510179986262349936882924652023566213765118606431955566700506538911356936879137503597382515919515633242482643314423192704128296593672966061810149316320617894021822784026407461403384065351821972350784300967610143459484324068427674639688405917977442472804943075439192026107319532117557545079086537982987982522396626690057355718157403493216553255260857777965627529169195827622139772389760130571754834678679842181142252489617665030109445573978012707793010592737640499220015083392425914877847840457278246402760955883376999951199827706285383471150643561410605789710883438795588594095047409018233862167884701 + , RSA.private_q = 0 + , RSA.private_p = 0 + , RSA.private_dP = 0 + , RSA.private_dQ = 0 + , RSA.private_qinv = 0 + } + +jwsRsaPublicKey = RSA.PublicKey + { RSA.public_size = 256 + , RSA.public_n = 20446702916744654562596343388758805860065209639960173505037453331270270518732245089773723012043203236097095623402044690115755377345254696448759605707788965848889501746836211206270643833663949992536246985362693736387185145424787922241585721992924045675229348655595626434390043002821512765630397723028023792577935108185822753692574221566930937805031155820097146819964920270008811327036286786392793593121762425048860211859763441770446703722015857250621107855398693133264081150697423188751482418465308470313958250757758547155699749157985955379381294962058862159085915015369381046959790476428631998204940879604226680285601 + , RSA.public_e = 65537 + } + diff --git a/benchmarks/bench.hs b/benchmarks/bench.hs --- a/benchmarks/bench.hs +++ b/benchmarks/bench.hs @@ -5,18 +5,25 @@ import Crypto.Random import Jose.Jws import Jose.Jwa +import Jose.Jwt import Keys 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 + Left _ -> error "RSA encode shouldn't fail" + Right (Jwt j) -> j + hmacE a m = case hmacEncode a jwsHmacKey m of + Left _ -> error "HMAC shouldn't fail" + Right (Jwt j) -> j defaultMain [ bgroup "JWS" - [ bench "encode RSA256" $ nf (rsaEncode RS256 jwsRsaPrivateKey) msg - , bench "encode RSA384" $ nf (rsaEncode RS384 jwsRsaPrivateKey) msg - , bench "encode RSA512" $ nf (rsaEncode RS384 jwsRsaPrivateKey) msg - , bench "encode HS256" $ nf (hmacEncode HS256 jwsHmacKey) msg - , bench "encode HS512" $ nf (hmacEncode HS512 jwsHmacKey) msg + [ bench "encode RSA256" $ nf (rsaE RS256) msg + , bench "encode RSA384" $ nf (rsaE RS384) msg + , bench "encode RSA512" $ nf (rsaE RS384) msg + , bench "encode HS256" $ nf (hmacE HS256) msg + , bench "encode HS512" $ nf (hmacE HS512) msg ] ] diff --git a/doctests.hs b/doctests.hs --- a/doctests.hs +++ b/doctests.hs @@ -1,2 +1,2 @@ import Test.DocTest -main = doctest ["-XOverloadedStrings", "Jose.Jws", "Jose.Jwe"] +main = doctest ["-XOverloadedStrings", "Jose.Jwt", "Jose.Jws", "Jose.Jwe"] 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.3.1 +Version: 0.4 Synopsis: JSON Object Signing and Encryption Library Homepage: http://github.com/tekul/jose-jwt Bug-Reports: http://github.com/tekul/jose-jwt/issues @@ -68,16 +68,18 @@ Type: exitcode-stdio-1.0 Other-Modules: Tests.JwsSpec , Tests.JweSpec + , Tests.JwkSpec Build-depends: jose-jwt , base + , aeson-qq , bytestring , base64-bytestring , cryptohash , crypto-pubkey + , crypto-pubkey-types , crypto-random , crypto-cipher-types , cipher-aes - , cprng-aes , either >= 4.0 , mtl , text @@ -101,6 +103,7 @@ Default-Language: Haskell2010 Hs-source-dirs: benchmarks Main-is: bench.hs + Other-Modules: Keys Type: exitcode-stdio-1.0 Build-depends: jose-jwt , base diff --git a/tests/Tests/JweSpec.hs b/tests/Tests/JweSpec.hs --- a/tests/Tests/JweSpec.hs +++ b/tests/Tests/JweSpec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} module Tests.JweSpec where @@ -7,6 +7,7 @@ import Data.Aeson (eitherDecode, decodeStrict') import Data.Bits (xor) import Data.Either.Combinators +import Data.Word (Word8) import qualified Data.ByteString as B import Test.Hspec import Test.HUnit hiding (Test) @@ -49,7 +50,7 @@ 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 @?= (a1, RNG "") + Jwe.rsaEncode g RSA_OAEP A256GCM a1PubKey a1Payload @?= (Jwt a1, RNG "") it "decodes the JWT to the expected header and payload" $ do (fst $ Jwe.rsaDecode blinderRNG a1PrivKey a1) @?= Right (a1Header, a1Payload) @@ -63,41 +64,42 @@ it "decodes the JWT using the JWK" $ do let Right k1 = eitherDecode a1jwk Just k2 = decodeStrict' a2jwk - (fst $ decode blinderRNG [k2, k1] a1) @?= (Right $ Jwe (a1Header, a1Payload)) + fst (decode blinderRNG [k2, k1] a1) @?= (Right $ Jwe (a1Header, a1Payload)) 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 + let g = RNG a2seed rsaEncrypt g RSA1_5 a2PubKey a2cek @?= (a2jweKey, RNG "") - it "encrypts the payload to the expected ciphertext and authentication tag" $ do + it "encrypts the payload to the expected ciphertext and authentication tag" $ encryptPayload A128CBC_HS256 a2cek a2iv aad a2Payload @?= (a2Ciphertext, AuthTag a2Tag) 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 @?= (a2, RNG "") + Jwe.rsaEncode g RSA1_5 A128CBC_HS256 a2PubKey a2Payload @?= (Jwt a2, RNG "") - it "decrypts the ciphertext to the correct payload" $ do + it "decrypts the ciphertext to the correct payload" $ decryptPayload A128CBC_HS256 a2cek a2iv aad a2Tag a2Ciphertext @?= Right a2Payload - it "decodes the JWT to the expected header and payload" $ do - (fst $ Jwe.rsaDecode blinderRNG a2PrivKey a2) @?= Right (a2Header, a2Payload) + it "decodes the JWT to the expected header and payload" $ + fst (Jwe.rsaDecode blinderRNG a2PrivKey a2) @?= Right (a2Header, a2Payload) context "when used with quickcheck" $ do it "padded msg is always a multiple of 16" $ property $ - \bs -> B.length (pad bs) `mod` 16 == 0 + \s -> B.length (pad (B.pack s)) `mod` 16 == 0 it "unpad is the inverse of pad" $ property $ - \bs -> (fromRight' . unpad . pad) bs == bs - it "jwe decode/decode returns the original payload" $ property $ jweRoundTrip + \s -> let msg = B.pack s in (fromRight' . unpad . pad) msg == msg + it "jwe decode/decode returns the original payload" $ property jweRoundTrip -- verboseQuickCheckWith quickCheckWith stdArgs {maxSuccess=10000} jweRoundTrip -jweRoundTrip :: RNG -> JWEAlgs -> B.ByteString -> Bool -jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (defJweHdr {jweAlg = a, jweEnc = e}, msg) +jweRoundTrip :: RNG -> JWEAlgs -> [Word8] -> Bool +jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (defJweHdr {jweAlg = a, jweEnc = e}, bs) where - encodeDecode = fst $ Jwe.rsaDecode blinderRNG a2PrivKey $ fst $ Jwe.rsaEncode g a e a2PubKey msg + bs = B.pack msg + encodeDecode = fst $ Jwe.rsaDecode blinderRNG a2PrivKey $ unJwt $ fst $ Jwe.rsaEncode g a e a2PubKey bs -- A decidedly non-random, random number generator which allows specific -- sequences of bytes to be supplied which match the JWE test data. @@ -124,6 +126,7 @@ -- JWE Appendix 1 Test Data -------------------------------------------------------------------------------- +a1 :: B.ByteString a1 = "eyJhbGciOiJSU0EtT0FFUCIsImVuYyI6IkEyNTZHQ00ifQ.OKOawDo13gRp2ojaHV7LFpZcgV7T6DVZKTyKOMTYUmKoTCVJRgckCL9kiMT03JGeipsEdY3mx_etLbbWSrFr05kLzcSr4qKAq7YN7e9jwQRb23nfa6c9d-StnImGyFDbSv04uVuxIp5Zms1gNxKKK2Da14B8S4rzVRltdYwam_lDp5XnZAYpQdb76FdIKLaVmqgfwX7XWRxv2322i-vDxRfqNzo_tETKzpVLzfiwQyeyPGLBIO56YJ7eObdv0je81860ppamavo35UgoRdbYaBcoh9QcfylQr66oc6vFWXRcZ_ZT2LawVCWTIy3brGPi6UklfCpIMfIjf7iGdXKHzg.48V1_ALb6US04U3b.5eym8TW_c8SuK0ltJ3rpYIzOeDQz7TALvtu6UG9oMo4vpzs9tX_EFShS8iB7j6jiSdiwkIr3ajwQzaBtQD_A.XFBoMYUZodetZdvTiFvSkQ" a1Payload = "The true sign of intelligence is not knowledge but imagination." @@ -179,6 +182,7 @@ a2RsaPrivateExponent = 10643756465292254988457796463889735064030094089452909840615134957452106668931481879498770304395097541282329162591478128330968231330113176654221501869950411410564116254672288216799191435916328405513154035654178369543717138143188973636496077305930253145572851787483810154020967535132278148578697716656066036003388130625459567907864689911133288140117207430454310073863484450086676106606775792171446149215594844607410066899028283290532626577379520547350399030663657813726123700613989625283009134539244470878688076926304079342487789922656366430636978871435674556143884272163840709196449089335092169596187792960067104244313 +a2 :: B.ByteString a2 = "eyJhbGciOiJSU0ExXzUiLCJlbmMiOiJBMTI4Q0JDLUhTMjU2In0.UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A.AxY8DCtDaGlsbGljb3RoZQ.KDlTtXchhZTGufMYmOYGS4HffxPSUrfmqCHXaI9wOGY.9hH0vgRfYgPnAHOd8stkvw" (a2PubKey, a2PrivKey) = createKeyPair a2RsaModulus a2RsaPrivateExponent @@ -192,9 +196,6 @@ -- Valid JWE Alg/Enc combinations data JWEAlgs = JWEAlgs JweAlg Enc deriving Show - -instance Arbitrary B.ByteString where - arbitrary = B.pack <$> arbitrary instance Arbitrary Enc where arbitrary = elements [A128CBC_HS256, A256CBC_HS512, A128GCM, A256GCM] diff --git a/tests/Tests/JwkSpec.hs b/tests/Tests/JwkSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/JwkSpec.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} + +module Tests.JwkSpec where + +import Test.Hspec +import Test.HUnit hiding (Test) + +import Data.Aeson +import Data.Aeson.QQ +import qualified Data.ByteString.Char8 () +import Crypto.Types.PubKey.ECDSA +import Crypto.Types.PubKey.ECC + +import Jose.Jwk +import Jose.Jwa + +-- Some JSON keys to decode +-- TODO: Support for {"kty": "oct", "alg": "A128KW", "k":"GawgguFyGrWKav7AX4VKUg"} +keySet :: Object +Object keySet = [aesonQQ| + { "keys" : + [ {"use": "enc", "n": "vnifEgZCnBxY5UDt3TJXp3_mNv92VWwHoc3B2oCuzgpgNyBwbBVIu3ScaflvQlntSgfo9VHiu16IqPuCOL4FjcY2RUZY7zizUZ2hFmmMThyx4HfTcDMNFOnetB1mKVUQ3gBOFjdnnj9auO4EK22xRcdB704XhES1TtYIiCxxfPOYBysCDHYcR-0KKjUPyXyhBGFoxiUrYP-c14Pf-aKWgNDqVlYlqayw9JHN4QVeJm8M5DHiPOtxO096Mc-5-X5NwXFMTzjywFWzkbFy7XmJj6BDmmh8-WUOBK1a9gy4zTysL9HfNhJIqi3BJUtLM_x2t-ISROm-Ud3y-4xgavXBTw", "e": "AQAB", "kty": "RSA", "kid": "a0"} + , {"use": "sig", "n": "o9kJbxD1SgwrV_ottw7oHxxkjw83AuRrYbq8PzXDfhmvqvRHjhAOEGk1qDUbI8tkWzXsTuy-0UAvI9Xt3Qqmmk1MSkAx6K355_J1ofTafH5VrtPavC7HMVnz1zDebgwJH869jWHFghzL0Nr32zq4_V-gpt-zugKFpQi_LA9dtuAjcSTCMnDzTMw4WrMbzNOm90q0CkJCrWe6xM9z4Q_GCPgb2S4lsd5iNdtus9pG104wFAkgY7BXNP3hatYa1UVkAQdWMYyQATs6HMBZF4Ljf-upU9ic_vGwTGgunvQ7z29yrAFWaZQ-EqjYUnvQlmPFqMaNxg3TkPIgntqvZOdW_w", "e": "AQAB", "kty": "RSA", "kid": "a1"} + , {"use": "sig", "crv": "P-256", "kty": "EC", "y": "kgFS_XvVOyuS41mBzmwJa-ik8Cy4rvM3uFncxmi_-Y8", "x": "bjX_T6O5OUW6WALJ173CH34TfzK9zEHycFT6KMWDnow", "kid": "a2"} + , {"use": "enc", "crv": "P-256", "kty": "EC", "y": "zcOqE_LYsPTf7a9FOFpJiwK2ZQuUmoNLdsY7BRTICN0", "x": "6eXHDpNoiUaAR5Cle6rfmrVgksSagyi8fzvLF1kedKc", "kid": "a3"} + , {"kty": "oct", "k":"AyM1SysPpbyDfgZld3umj1qzKObwVMkoqQ-EstJQLr_T-1qS0gZH75aKtMN3Yj0iPS4hcgUuTwjAzZr1Z9CAow", "kid":"HMAC key used in JWS A.1 example"} + , {"kty":"EC", "crv":"P-256", "x":"MKBCTNIcKUSDii11ySs3526iDZ8AiTo7Tu6KPAqv7D4", "y":"4Etl6SRW2YiLUrN5vfvVHuhp7x8PxltmWWlbbM4IFyM", "use":"enc", "kid":"1"} + , {"kty":"RSA", "n": "0vx7agoebGcQSuuPiLJXZptN9nndrQmbXEps2aiAFbWhM78LhWx4cbbfAAtVT86zwu1RK7aPFFxuhDR1L6tSoc_BJECPebWKRXjBZCiFV4n3oknjhMstn64tZ_2W-5JsGY4Hc5n9yBXArwl93lqt7_RN5w6Cf0h4QyQ5v-65YGjQR0_FDW2QvzqY368QQMicAtaSqzs8KJZgnYb9c7d0zgdAZHzu6qMQvRL5hajrn1n91CbOpbISD08qNLyrdkt-bFTWhAI4vMQFh6WeZu0fM4lFd2NcRwr3XPksINHaQ-G_xBniIqbw0Ls1jF44-csFCur-kEgU8awapJzKnqDKgw", "e":"AQAB", "alg":"RS256", "kid":"2011-04-29"} + , {"kty":"EC", "crv":"P-256", "x":"MKBCTNIcKUSDii11ySs3526iDZ8AiTo7Tu6KPAqv7D4", "y":"4Etl6SRW2YiLUrN5vfvVHuhp7x8PxltmWWlbbM4IFyM", "d":"870MB6gfuTJ4HtUnUvYMyJpr5eUZNP4Bk43bVdj3eAE", "use":"enc", "kid":"1"} + , {"kty":"RSA", "n":"0vx7agoebGcQSuuPiLJXZptN9nndrQmbXEps2aiAFbWhM78LhWx4cbbfAAtVT86zwu1RK7aPFFxuhDR1L6tSoc_BJECPebWKRXjBZCiFV4n3oknjhMstn64tZ_2W-5JsGY4Hc5n9yBXArwl93lqt7_RN5w6Cf0h4QyQ5v-65YGjQR0_FDW2QvzqY368QQMicAtaSqzs8KJZgnYb9c7d0zgdAZHzu6qMQvRL5hajrn1n91CbOpbISD08qNLyrdkt-bFTWhAI4vMQFh6WeZu0fM4lFd2NcRwr3XPksINHaQ-G_xBniIqbw0Ls1jF44-csFCur-kEgU8awapJzKnqDKgw", "e":"AQAB", "d":"X4cTteJY_gn4FYPsXB8rdXix5vwsg1FLN5E3EaG6RJoVH-HLLKD9M7dx5oo7GURknchnrRweUkC7hT5fJLM0WbFAKNLWY2vv7B6NqXSzUvxT0_YSfqijwp3RTzlBaCxWp4doFk5N2o8Gy_nHNKroADIkJ46pRUohsXywbReAdYaMwFs9tv8d_cPVY3i07a3t8MN6TNwm0dSawm9v47UiCl3Sk5ZiG7xojPLu4sbg1U2jx4IBTNBznbJSzFHK66jT8bgkuqsk0GjskDJk19Z4qwjwbsnn4j2WBii3RL-Us2lGVkY8fkFzme1z0HbIkfz0Y6mqnOYtqc0X4jfcKoAC8Q", "p":"83i-7IvMGXoMXCskv73TKr8637FiO7Z27zv8oj6pbWUQyLPQBQxtPVnwD20R-60eTDmD2ujnMt5PoqMrm8RfmNhVWDtjjMmCMjOpSXicFHj7XOuVIYQyqVWlWEh6dN36GVZYk93N8Bc9vY41xy8B9RzzOGVQzXvNEvn7O0nVbfs", "q":"3dfOR9cuYq-0S-mkFLzgItgMEfFzB2q3hWehMuG0oCuqnb3vobLyumqjVZQO1dIrdwgTnCdpYzBcOfW5r370AFXjiWft_NGEiovonizhKpo9VVS78TzFgxkIdrecRezsZ-1kYd_s1qDbxtkDEgfAITAG9LUnADun4vIcb6yelxk", "dp":"G4sPXkc6Ya9y8oJW9_ILj4xuppu0lzi_H7VTkS8xj5SdX3coE0oimYwxIi2emTAue0UOa5dpgFGyBJ4c8tQ2VF402XRugKDTP8akYhFo5tAA77Qe_NmtuYZc3C3m3I24G2GvR5sSDxUyAN2zq8Lfn9EUms6rY3Ob8YeiKkTiBj0", "dq":"s9lAH9fggBsoFR8Oac2R_E2gw282rT2kGOAhvIllETE1efrA6huUUvMfBcMpn8lqeW6vzznYY5SSQF7pMdC_agI3nG8Ibp1BUb0JUiraRNqUfLhcQb_d9GF4Dh7e74WbRsobRonujTYN1xCaP6TO61jvWrX-L18txXw494Q_cgk", "qi":"GyM_p6JrXySiz1toFgKbWV-JdI3jQ4ypu9rbMWx3rQJBfmt0FoYzgUIZEVFEcOqwemRN81zoDAaa-Bk0KWNGDjJHZDdDmFhW3AN7lI-puxk_mHZGJ11rxyR8O55XLSe3SPmRfKwZI6yU24ZxvQKFYItdldUKGzO6Ia6zTKhAVRU", "alg":"RS256", "kid":"2011-04-29"} + ] + } +|] + + +spec :: Spec +spec = + describe "JWK encoding and decoding" $ + it "decodes and encodes an entire key set successfully" $ do + let Success s@(JwkSet _) = fromJSON (Object keySet) :: Result JwkSet + Just s' = decode' (encode s) :: Maybe JwkSet + kss = keys s' + RsaPublicJwk _ key0Id key0Use a0 = head kss + RsaPublicJwk _ key1Id key1Use _ = kss !! 1 + EcPublicJwk k key2Id key2Use _ _ = kss !! 2 + EcPublicJwk _ key3Id key3Use _ _ = kss !! 3 + SymmetricJwk _ key4Id Nothing _ = kss !! 4 + EcPublicJwk _ key5Id (Just Enc) _ _ = kss !! 5 + RsaPublicJwk _ key6Id Nothing a6 = kss !! 6 + EcPrivateJwk _ key7Id (Just Enc) _ _ = kss !! 7 + RsaPrivateJwk _ _ Nothing a8 = kss !! 8 + length kss @?= 9 + a0 @?= Nothing + key0Id @?= Just "a0" + key1Id @?= Just "a1" + key2Id @?= Just "a2" + public_curve k @?= getCurveByName SEC_p256r1 + key3Id @?= Just "a3" + key4Id @?= Just "HMAC key used in JWS A.1 example" + key5Id @?= Just "1" + key6Id @?= Just "2011-04-29" + key7Id @?= Just "1" + key0Use @?= Just Enc + key1Use @?= Just Sig + key2Use @?= Just Sig + key3Use @?= Just Enc + a6 @?= Just (Signed RS256) + a8 @?= Just (Signed RS256) + diff --git a/tests/Tests/JwsSpec.hs b/tests/Tests/JwsSpec.hs --- a/tests/Tests/JwsSpec.hs +++ b/tests/Tests/JwsSpec.hs @@ -81,15 +81,24 @@ let Just k31 = decodeStrict' a31jwk fst (decode RNG [k31] a31) @?= fmap Jws a31decoded + context "when using an unsecured JWT" $ + it "decodes the JWT to the expected header and payload" $ + fst (decode RNG [] jwt61) @?= Right (Unsecured jwt61Payload) + + signWithHeader sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload] where hdrPayload = B.intercalate "." $ map B64.encode [hdr, payload] -hmacRoundTrip a msg = let Right encoded = Jws.hmacEncode a "asecretkey" msg +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 encoded = fst $ Jws.rsaEncode RNG a rsaPrivateKey msg +rsaRoundTrip a msg = let Right (Jwt encoded) = fst $ Jws.rsaEncode RNG a rsaPrivateKey msg in Jws.rsaDecode rsaPublicKey encoded @?= Right (defJwsHdr {jwsAlg = a}, msg) + +-- Unsecured JWT from section 6.1 +jwt61 = "eyJhbGciOiJub25lIn0.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ." +jwt61Payload = a11Payload a11Header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" :: B.ByteString a11Payload = "{\"iss\":\"joe\",\r\n \"exp\":1300819380,\r\n \"http://example.com/is_root\":true}"