packages feed

jose-jwt 0.3.1 → 0.4

raw patch · 13 files changed

+258/−96 lines, 13 filesdep +aeson-qqdep −cprng-aesdep ~crypto-pubkey-typesPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson-qq

Dependencies removed: cprng-aes

Dependency ranges changed: crypto-pubkey-types

API changes (from Hackage documentation)

- Jose.Jwt: data Jwt
+ Jose.Jwt: Claims :: ByteString -> Payload
+ Jose.Jwt: Jwt :: ByteString -> Jwt
+ Jose.Jwt: Nested :: Jwt -> Payload
+ Jose.Jwt: Unsecured :: !ByteString -> JwtContent
+ Jose.Jwt: data JwtContent
+ Jose.Jwt: data Payload
+ Jose.Jwt: newtype Jwt
+ Jose.Jwt: unJwt :: Jwt -> ByteString
- Jose.Jwe: jwkEncode :: CPRG g => g -> JweAlg -> Enc -> Jwk -> ByteString -> (Either JwtError ByteString, g)
+ Jose.Jwe: jwkEncode :: CPRG g => g -> JweAlg -> Enc -> Jwk -> Payload -> (Either JwtError Jwt, g)
- Jose.Jwe: rsaEncode :: CPRG g => g -> JweAlg -> Enc -> PublicKey -> ByteString -> (ByteString, g)
+ Jose.Jwe: rsaEncode :: CPRG g => g -> JweAlg -> Enc -> PublicKey -> ByteString -> (Jwt, g)
- Jose.Jws: hmacEncode :: JwsAlg -> ByteString -> ByteString -> Either JwtError ByteString
+ Jose.Jws: hmacEncode :: JwsAlg -> ByteString -> ByteString -> Either JwtError Jwt
- Jose.Jws: jwkEncode :: CPRG g => g -> JwsAlg -> Jwk -> ByteString -> (Either JwtError ByteString, g)
+ Jose.Jws: jwkEncode :: CPRG g => g -> JwsAlg -> Jwk -> Payload -> (Either JwtError Jwt, g)
- Jose.Jws: rsaEncode :: CPRG g => g -> JwsAlg -> PrivateKey -> ByteString -> (Either JwtError ByteString, g)
+ Jose.Jws: rsaEncode :: CPRG g => g -> JwsAlg -> PrivateKey -> ByteString -> (Either JwtError Jwt, g)
- Jose.Jwt: Jwe :: !Jwe -> Jwt
+ Jose.Jwt: Jwe :: !Jwe -> JwtContent
- Jose.Jwt: Jws :: !Jws -> Jwt
+ Jose.Jwt: Jws :: !Jws -> JwtContent
- Jose.Jwt: decode :: CPRG g => g -> [Jwk] -> ByteString -> (Either JwtError Jwt, g)
+ Jose.Jwt: decode :: CPRG g => g -> [Jwk] -> ByteString -> (Either JwtError JwtContent, g)
- Jose.Jwt: encode :: CPRG g => g -> [Jwk] -> Alg -> Maybe Enc -> ByteString -> (Either JwtError ByteString, g)
+ Jose.Jwt: encode :: CPRG g => g -> [Jwk] -> Alg -> Maybe Enc -> Payload -> (Either JwtError Jwt, g)

Files

CHANGELOG.md view
@@ -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 ----- 
Jose/Jwe.hs view
@@ -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
Jose/Jwk.hs view
@@ -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
Jose/Jws.hs view
@@ -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)
Jose/Jwt.hs view
@@ -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"
Jose/Types.hs view
@@ -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
+ benchmarks/Keys.hs view
@@ -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+    }+
benchmarks/bench.hs view
@@ -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           ]       ]
doctests.hs view
@@ -1,2 +1,2 @@ import Test.DocTest-main = doctest ["-XOverloadedStrings", "Jose.Jws", "Jose.Jwe"]+main = doctest ["-XOverloadedStrings", "Jose.Jwt", "Jose.Jws", "Jose.Jwe"]
jose-jwt.cabal view
@@ -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
tests/Tests/JweSpec.hs view
@@ -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]
+ tests/Tests/JwkSpec.hs view
@@ -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)+
tests/Tests/JwsSpec.hs view
@@ -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}"