jose-jwt 0.2 → 0.3

raw patch · 10 files changed

+303/−72 lines, 10 filesdep +crypto-pubkey-typesdep ~crypto-pubkeydep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: crypto-pubkey-types

Dependency ranges changed: crypto-pubkey, mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Jose/Internal/Crypto.hs +32/−7
• Jose/Jwa.hs +3/−3
• Jose/Jwe.hs +41/−5
• Jose/Jwk.hs +96/−36
• Jose/Jws.hs +47/−10
• Jose/Jwt.hs +42/−1
• Jose/Types.hs +8/−4
• jose-jwt.cabal +7/−3
• tests/Tests/JwsSpec.hs +20/−3

@@ -0,0 +1,7 @@+0.3+---++* New support for JWS validation using elliptic curve algorithms.+* Added `Jwt.encode` function which takes a JWK argument, allowing key data (currently the key ID) to be encoded in the token header.++

@@ -11,6 +11,7 @@     , rsaVerify     , rsaEncrypt     , rsaDecrypt+    , ecVerify     , encryptPayload     , decryptPayload     , generateCmkAndIV@@ -19,7 +20,10 @@     ) where +import           Control.Applicative import           Crypto.Cipher.Types (AuthTag(..))+import           Crypto.Number.Serialize (os2ip)+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15 import qualified Crypto.PubKey.RSA.OAEP as OAEP@@ -66,7 +70,7 @@         -> ByteString         -- ^ Message to sign         -> Either JwtError ByteString    -- ^ The signature rsaSign blinder a key msg = do-    hash <- maybe (Left $ BadAlgorithm $ T.pack $ "Not an RSA algorithm: " ++ show a) return $ lookupRSAHash a+    hash <- lookupRSAHash a     either (const $ Left BadCrypto) Right $ PKCS15.sign blinder hash key msg   where @@ -80,18 +84,39 @@           -> ByteString    -- ^ The signature to check           -> Bool          -- ^ Whether the signature is correct rsaVerify a key msg sig = case lookupRSAHash a of-    Just hash -> PKCS15.verify hash key msg sig+    Right hash -> PKCS15.verify hash key msg sig+    _          -> False++-- | Verify the signature for a message using an EC public key.+--+-- Returns false if the check fails or if the 'Alg' value is not+-- an EC signature algorithm.+ecVerify :: JwsAlg          -- ^ The signature algorithm. Used to obtain the hash function.+         -> ECDSA.PublicKey -- ^ The key to check the signature with+         -> ByteString      -- ^ The message/content+         -> ByteString      -- ^ The signature to check+         -> Bool            -- ^ Whether the signature is correct+ecVerify a key msg sig = case lookupECHash a of+    Just hash -> let (r, s) = B.splitAt (B.length sig `div` 2) sig+                 in  ECDSA.verify hash key (ECDSA.Signature (os2ip r) (os2ip s)) msg     Nothing   -> False  hmacHashes :: [(JwsAlg, HashDescr)] hmacHashes = [(HS256, hashDescrSHA256), (HS384, hashDescrSHA384), (HS512, hashDescrSHA512)] -lookupRSAHash :: JwsAlg -> Maybe HashDescr-lookupRSAHash alg = case alg of-    RS256 -> Just hashDescrSHA256-    RS384 -> Just hashDescrSHA384-    RS512 -> Just hashDescrSHA512+lookupECHash :: JwsAlg -> Maybe HashFunction+lookupECHash alg = hashFunction <$> case alg of+    ES256 -> Just hashDescrSHA256+    ES384 -> Just hashDescrSHA384+    ES512 -> Just hashDescrSHA512     _     -> Nothing++lookupRSAHash :: JwsAlg -> Either JwtError HashDescr+lookupRSAHash alg = case alg of+    RS256 -> Right hashDescrSHA256+    RS384 -> Right hashDescrSHA384+    RS512 -> Right hashDescrSHA512+    _     -> Left . BadAlgorithm . T.pack $ "Not an RSA algorithm: " ++ show alg  -- | Generates the symmetric key (content management key) and IV --

@@ -21,19 +21,19 @@  -- | A subset of the signature algorithms from the -- <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-31#section-3 JWA Spec>.-data JwsAlg = None | HS256 | HS384 | HS512 | RS256 | RS384 | RS512 deriving (Eq, Show, Read)+data JwsAlg = None | HS256 | HS384 | HS512 | RS256 | RS384 | RS512 | ES256 | ES384 | ES512 deriving (Eq, Show, Read)  -- | A subset of the key management algorithms from the -- <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-31#section-5 JWA Spec>. data JweAlg = RSA1_5 | RSA_OAEP deriving (Eq, Show, Read) --- TODO: AES_192_CBC_HMAC_SHA_384 ?? -- | Content encryption algorithms from the -- <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-31#section-5 JWA Spec>.+-- The optional algorithms A192CBC-HS384 and A192GCM are not supported yet. data Enc = A128CBC_HS256 | A256CBC_HS512 | A128GCM | A256GCM deriving (Eq, Show)  algs :: [(Text, Alg)]-algs = [("none", Signed None), ("HS256", Signed HS256), ("HS384", Signed HS384), ("HS512", Signed HS512), ("RS256", Signed RS256), ("RS384", Signed RS384), ("RS512", Signed RS512), ("RSA1_5", Encrypted RSA1_5), ("RSA-OAEP", Encrypted RSA_OAEP)]+algs = [("none", Signed None), ("HS256", Signed HS256), ("HS384", Signed HS384), ("HS512", Signed HS512), ("RS256", Signed RS256), ("RS384", Signed RS384), ("RS512", Signed RS512), ("ES256", Signed ES256), ("ES384", Signed ES384), ("ES512", Signed ES512), ("RSA1_5", Encrypted RSA1_5), ("RSA-OAEP", Encrypted RSA_OAEP)]  algName :: Alg -> Text algName a = fromJust $ lookup a algNames

@@ -14,10 +14,16 @@ -- >>> fst $ rsaDecode g'' kPr jwt -- Right (JweHeader {jweAlg = RSA_OAEP, jweEnc = A128GCM, jweTyp = Nothing, jweCty = Nothing, jweZip = Nothing, jweKid = Nothing},"secret claims") -module Jose.Jwe where+module Jose.Jwe+    ( jwkEncode+    , rsaEncode+    , rsaDecode+    )+where +import Control.Arrow (first) import Crypto.Cipher.Types (AuthTag(..))-import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder)+import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder, private_pub) import Crypto.Random.API (CPRG) import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -26,7 +32,25 @@ import qualified Jose.Internal.Base64 as B64 import Jose.Internal.Crypto import Jose.Jwa+import Jose.Jwk +-- | Create a JWE using a JWK.+-- The key and algorithms must be consistent or an error+-- will be returned.+jwkEncode :: CPRG g+          => g                               -- ^ Random number generator+          -> JweAlg                          -- ^ Algorithm to use for key encryption+          -> Enc                             -- ^ Content encryption algorithm+          -> Jwk                             -- ^ The key to use to encrypt the content key+          -> 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+    _                         -> (Left $ KeyError "Only RSA JWKs can be used for encoding", rng)+  where+    hdr kid = defJweHdr {jweAlg = a, jweEnc = e, jweKid = kid}+ -- | Creates a JWE. rsaEncode :: CPRG g           => g               -- ^ Random number generator@@ -35,15 +59,26 @@           -> PublicKey       -- ^ RSA key to encrypt with           -> ByteString      -- ^ The JWT claims (content)           -> (ByteString, g) -- ^ The encoded JWE and new generator-rsaEncode rng a e pubKey claims = (jwe, rng'')+rsaEncode rng a e = rsaEncodeInternal rng (defJweHdr {jweAlg = a, jweEnc = e})++rsaEncodeInternal :: CPRG g+                  => g+                  -> JweHeader+                  -> PublicKey+                  -> ByteString+                  -> (ByteString, g)+rsaEncodeInternal rng h pubKey claims = (jwe, rng'')   where-    hdr = encodeHeader defJweHdr {jweAlg = a, jweEnc = e}+    a   = jweAlg h+    e   = jweEnc h+    hdr = encodeHeader h     (cmk, iv, rng') = generateCmkAndIV rng e     (jweKey, rng'') = rsaEncrypt rng' a pubKey cmk     aad = B64.encode hdr     (ct, AuthTag sig) = encryptPayload e cmk iv aad claims     jwe = B.intercalate "." $ map B64.encode [hdr, jweKey, iv, ct, sig] + -- | Decrypts a JWE. rsaDecode :: CPRG g           => g@@ -61,7 +96,8 @@         [h, ek, iv, payload, sig] <- mapM B64.decode components         hdr <- case parseHeader h of             Right (JweH jweHdr) -> return jweHdr-            _                   -> Left BadHeader+            Right (JwsH _)      -> Left (BadHeader "Header is for a JWS")+            Left e              -> Left e         let alg = jweAlg hdr         cek    <- rsaDecrypt (Just b) alg pk ek         claims <- decryptPayload (jweEnc hdr) cek iv aad sig payload

@@ -7,13 +7,17 @@     , KeyId     , Jwk (..)     , JwkSet (..)+    , validateForJws     , findMatchingJwsKeys     , findMatchingJweKeys     ) where  import           Control.Applicative (pure)+import           Control.Monad (when) import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.Types.PubKey.ECC as ECC import           Crypto.Number.Serialize import           Data.Aeson (genericToJSON, Value(..), FromJSON(..), ToJSON(..), withText) import           Data.Aeson.Types (Parser, Options (..), defaultOptions)@@ -24,7 +28,7 @@  import qualified Jose.Internal.Base64 as B64 import           Jose.Jwa-import           Jose.Types (JwsHeader(..), JweHeader(..))+import           Jose.Types (JwtError(..), KeyId, JwsHeader(..), JweHeader(..))  data KeyType = Rsa              | Ec@@ -40,10 +44,10 @@              | Enc                deriving (Eq,Show) -type KeyId   = Text- 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)          | SymmetricJwk  ByteString (Maybe KeyId) (Maybe KeyUse) (Maybe Alg)            deriving (Show, Eq) @@ -51,33 +55,65 @@     { keys :: [Jwk]     } deriving (Show, Eq, Generic) -canDecodeJws :: JwsAlg -> Jwk -> Bool-canDecodeJws al jwk = case al of+validateForJws :: JwsAlg -> Jwk -> Either JwtError ()+validateForJws a jwk = do+    when (jwkUse jwk == Just Enc) $ Left (KeyError "JWK is for encryption only")+    either (Left . KeyError) (const $ Right ()) $ case a of         HS256 -> mustBeSymmetric         HS384 -> mustBeSymmetric         HS512 -> mustBeSymmetric         RS256 -> mustBeRsa         RS384 -> mustBeRsa         RS512 -> mustBeRsa-        -- Not yet supported (EC)-        _     -> False+        ES256 -> mustBeEc+        ES384 -> mustBeEc+        ES512 -> mustBeEc+        None  -> Left "JWS with alg 'None' does not require a key"  where-    mustBeRsa       = not mustBeSymmetric+    mustBeRsa       = case jwk of+        RsaPrivateJwk {} -> Right ()+        RsaPublicJwk  {} -> Right ()+        _                -> Left "JWK must be an RSA key"     mustBeSymmetric = case jwk of-        SymmetricJwk {} -> True-        _               -> False+        SymmetricJwk {}  -> Right ()+        _                -> Left "JWK must be symmetric"+    mustBeEc        = case jwk of+        EcPrivateJwk {}  -> Right ()+        EcPublicJwk  {}  -> Right ()+        _                -> Left "JWK must be an EC key" +canDecodeJws :: JwsAlg -> Jwk -> Bool+canDecodeJws al jwk = either (const False) (const True) $ validateForJws al jwk+ canDecodeJwe :: JweAlg -> Jwk -> Bool-canDecodeJwe _ jwk = case jwk of    -- JWE+canDecodeJwe _ jwk = jwkUse jwk /= Just Sig &&+    case jwk of         RsaPrivateJwk {} -> True         _                -> False +curve :: EcCurve -> ECC.Curve+curve c = ECC.getCurveByName $ case c of+    P_256 -> ECC.SEC_p256r1+    P_384 -> ECC.SEC_p384r1+    P_521 -> ECC.SEC_p521r1+ jwkId :: Jwk -> Maybe KeyId jwkId key = case key of     RsaPublicJwk  _ keyId _ _ -> keyId     RsaPrivateJwk _ keyId _ _ -> keyId+    EcPublicJwk   _ keyId _ _ -> keyId+    EcPrivateJwk  _ keyId _ _ -> keyId     SymmetricJwk  _ keyId _ _ -> keyId ++jwkUse :: Jwk -> Maybe KeyUse+jwkUse key = case key of+    RsaPublicJwk  _ _ u _ -> u+    RsaPrivateJwk _ _ u _ -> u+    EcPublicJwk   _ _ u _ -> u+    EcPrivateJwk  _ _ u _ -> u+    SymmetricJwk  _ _ u _ -> u+ findKeyById :: [Jwk] -> KeyId -> Maybe Jwk findKeyById [] _       = Nothing findKeyById (key:ks) keyId = case jwkId key of@@ -159,33 +195,54 @@  instance ToJSON Jwk where     toJSON jwk = toJSON $ case jwk of-                   RsaPublicJwk pubKey mId mUse mAlg ->-                      createPubData pubKey mId mUse mAlg-                   RsaPrivateJwk privKey mId mUse mAlg ->-                      let pubData = createPubData (RSA.private_pub privKey) mId mUse mAlg-                      in  pubData-                            { d  = Just . JwkBytes . i2osp $ RSA.private_d privKey-                            , p  = i2b $ RSA.private_p    privKey-                            , q  = i2b $ RSA.private_q    privKey-                            , dp = i2b $ RSA.private_dP   privKey-                            , dq = i2b $ RSA.private_dQ   privKey-                            , qi = i2b $ RSA.private_qinv privKey-                            }-                   SymmetricJwk bs mId mUse mAlg ->-                      defJwk-                            { kty = Oct-                            , k   = Just $ JwkBytes bs-                            , kid = mId-                            , use = mUse-                            , alg = mAlg-                            }+        RsaPublicJwk pubKey mId mUse mAlg ->+          createPubData pubKey mId mUse mAlg+        RsaPrivateJwk privKey mId mUse mAlg ->+            let pubData = createPubData (RSA.private_pub privKey) mId mUse mAlg+            in  pubData+                { d  = Just . JwkBytes . i2osp $ RSA.private_d privKey+                , p  = i2b $ RSA.private_p    privKey+                , q  = i2b $ RSA.private_q    privKey+                , dp = i2b $ RSA.private_dP   privKey+                , dq = i2b $ RSA.private_dQ   privKey+                , qi = i2b $ RSA.private_qinv privKey+                }+        SymmetricJwk bs mId mUse mAlg -> defJwk+            { kty = Oct+            , k   = Just $ JwkBytes bs+            , kid = mId+            , use = mUse+            , alg = mAlg+            }++        EcPublicJwk pubKey mId mUse mAlg -> defJwk+            { kty = Ec+            , x   = fst (ecPoint pubKey)+            , y   = snd (ecPoint pubKey)+            , kid = mId+            , use = mUse+            , alg = mAlg+            }++        EcPrivateJwk kp mId mUse mAlg -> defJwk+            { kty = Ec+            , x   = fst (ecPoint (ECDSA.toPublicKey kp))+            , y   = snd (ecPoint (ECDSA.toPublicKey kp))+            , d   = i2b (ECDSA.private_d (ECDSA.toPrivateKey kp))+            , kid = mId+            , use = mUse+            , alg = mAlg+            }       where         i2b 0 = Nothing         i2b i = Just . JwkBytes . i2osp $ i+        ecPoint pk = case ECDSA.public_q pk of+            ECC.Point xi yi -> (i2b xi, i2b yi)+            _             -> (Nothing, Nothing)          createPubData pubKey mId mUse mAlg = defJwk-                              { n   = Just . JwkBytes . i2osp $ RSA.public_n pubKey-                              , e   = Just . JwkBytes . i2osp $ RSA.public_e pubKey+                              { n   = i2b (RSA.public_n pubKey)+                              , e   = i2b (RSA.public_e pubKey)                               , kid = mId                               , use = mUse                               , alg = mAlg@@ -256,13 +313,16 @@         return $ RsaPrivateJwk (RSA.PrivateKey (rsaPub nb eb) (os2ip $ bytes db) (os2mip mp) (os2mip mq) (os2mip mdp) (os2mip mdq) (os2mip mqi)) i u a     J Oct Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just kb) Nothing Nothing Nothing u a i Nothing Nothing Nothing ->         return $ SymmetricJwk (bytes kb) i u a-    J Ec _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ->-        Left "Elliptic curve keys are not supported yet"-    _ -> Left "Invalid key data"+    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+    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."   where     rsaPub  nb eb  = let m  = os2ip $ bytes nb                          ex = os2ip $ bytes eb                      in RSA.PublicKey (rsaSize m 1) m ex     rsaSize m i    = if (2 ^ (i * 8)) > m then i else rsaSize m (i+1)     os2mip         = maybe 0 (os2ip . bytes)+    ecPoint xb yb  = ECC.Point (os2ip (bytes xb)) (os2ip (bytes yb)) 

@@ -15,33 +15,57 @@ -- Right (JwsHeader {jwsAlg = HS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Nothing},"public claims")  module Jose.Jws-    ( hmacEncode+    ( jwkEncode+    , hmacEncode     , hmacDecode     , rsaEncode     , rsaDecode+    , ecDecode     ) where  import Control.Applicative import Control.Monad (unless)+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder) import Crypto.Random (CPRG) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC+ import Jose.Types import qualified Jose.Internal.Base64 as B64 import Jose.Internal.Crypto import Jose.Jwa+import Jose.Jwk (Jwk (..)) +-- | Create a JWS signed with a JWK.+-- The key and algorithm must be consistent or an error+-- will be returned.+jwkEncode :: (CPRG g)+          => g+          -> JwsAlg                          -- ^ The algorithm to use+          -> Jwk                             -- ^ The key to sign with+          -> ByteString                      -- ^ The public JWT claims+          -> (Either JwtError ByteString, g) -- ^ The encoded token, if successful+jwkEncode rng a key payload = case key of+    RsaPrivateJwk kPr kid _ _ -> rsaEncodeInternal rng a kPr (sigTarget a kid payload)+    SymmetricJwk  k   kid _ _ -> (hmacEncodeInternal a k (sigTarget a kid payload), rng)+    _                         -> (Left $ BadAlgorithm "EC signing is not supported", rng)+ -- | Create a JWS with an HMAC for validation. 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 = let st = sigTarget a payload-                           in  (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st+hmacEncode a key payload = hmacEncodeInternal a key (sigTarget a Nothing payload) +hmacEncodeInternal :: JwsAlg+                   -> ByteString+                   -> ByteString+                   -> Either JwtError ByteString+hmacEncodeInternal a key st = (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st+ -- | Decodes and validates an HMAC signed JWS. hmacDecode :: ByteString          -- ^ The HMAC key            -> ByteString          -- ^ The JWS token to decode@@ -55,26 +79,38 @@           -> 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 = (sign blinder, rng')+rsaEncode rng a pk payload = rsaEncodeInternal rng a pk (sigTarget a Nothing payload)++rsaEncodeInternal :: CPRG g+                  => g+                  -> JwsAlg+                  -> PrivateKey+                  -> ByteString+                  -> (Either JwtError ByteString, g)+rsaEncodeInternal rng a pk st = (sign blinder, rng')   where     (blinder, rng') = generateBlinder rng (public_n $ private_pub pk) -    st = sigTarget a payload-     sign b = case rsaSign (Just b) a pk st of         Right sig -> Right $ B.concat [st, ".", B64.encode sig]         err       -> err - -- | Decode and validate an RSA signed JWS. rsaDecode :: PublicKey            -- ^ The key to check the signature with           -> ByteString           -- ^ The encoded JWS           -> Either JwtError Jws  -- ^ The decoded token if successful rsaDecode key = decode (`rsaVerify` key) -sigTarget :: JwsAlg -> ByteString -> ByteString-sigTarget a payload = B.intercalate "." $ map B64.encode [encodeHeader $ defJwsHdr {jwsAlg = a}, payload] +-- | Decode and validate an EC signed JWS+ecDecode :: ECDSA.PublicKey       -- ^ The key to check the signature with+         -> ByteString            -- ^ The encoded JWS+         -> 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]+ type JwsVerifier = JwsAlg -> ByteString -> ByteString -> Bool  decode :: JwsVerifier -> ByteString -> Either JwtError Jws@@ -85,7 +121,8 @@     [h, payload] <- mapM B64.decode $ BC.split '.' hdrPayload     hdr <- case parseHeader h of         Right (JwsH jwsHdr) -> return jwsHdr-        _                   -> Left BadHeader+        Right (JweH _)      -> Left (BadHeader "Header is for a JWE")+        Left e              -> Left e     if verify (jwsAlg hdr) hdrPayload sigBytes       then Right (hdr, payload)       else Left BadSignature

@@ -1,8 +1,26 @@ {-# LANGUAGE OverloadedStrings, FlexibleContexts #-} {-# OPTIONS_HADDOCK prune #-} +-- | High-level JWT encoding and decoding.+--+-- Example usage:+--+-- >>> import Jose.Jwe+-- >>> import Jose.Jwa+-- >>> import Jose.Jwk+-- >>> 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 Just jwk = decodeStrict jsonJwk :: Maybe Jwk+-- >>> let (Right jwtEncoded, g')  = encode g jwk (Signed RS256) Nothing "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")+ module Jose.Jwt     ( module Jose.Types+    , encode     , decode     , decodeClaims     )@@ -10,6 +28,7 @@  import Control.Error import Control.Monad.State.Strict+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Crypto.PubKey.RSA (PrivateKey(..)) import Crypto.Random (CPRG) import Data.Aeson (decodeStrict')@@ -21,17 +40,37 @@ import qualified Jose.Internal.Base64 as B64 import Jose.Types import Jose.Jwk+import Jose.Jwa  import qualified Jose.Jws as Jws import qualified Jose.Jwe as Jwe  +-- | Use the supplied JWK to create a JWT.+--+encode :: (CPRG g)+       => g                               -- ^ Random number generator.+       -> Jwk                             -- ^ The key. 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 encode JWT, if successful+encode rng jwk alg enc msg = flip runState rng $ runEitherT $ case alg of+    Signed a    -> do+        unless (isNothing enc) $ left (BadAlgorithm "Enc cannot be set for a JWS")+        hoistEither (validateForJws a jwk)+        hoistEither =<< state (\g -> Jws.jwkEncode g a jwk msg)+    Encrypted a -> case enc of+        Nothing   -> left (BadAlgorithm "Enc must be supplied for a JWE")+        Just e    -> hoistEither =<< state (\g -> Jwe.jwkEncode g a e jwk msg)++ -- | Uses the supplied keys to decode a JWT. -- Locates a matching key by header @kid@ value where possible -- or by suitable key type. -- The JWK @use@ and @alg@ options are currently ignored. decode :: CPRG g-       => 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@@ -52,6 +91,8 @@     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         SymmetricJwk  kb   _ _ _ -> Jws.hmacDecode kb jwt      decodeWithJwe :: CPRG g => Jwk -> EitherT JwtError (State g) (Maybe Jwt)

@@ -11,6 +11,7 @@     , JweHeader (..)     , JwtError (..)     , IntDate (..)+    , KeyId     , parseHeader     , encodeHeader     , defJwsHdr@@ -28,6 +29,7 @@ import Data.Int (Int64) import Data.Time.Clock.POSIX import Data.Text (Text)+import qualified Data.Text as T import Data.Vector (singleton) import GHC.Generics @@ -46,13 +48,15 @@                | JwsH JwsHeader                  deriving (Show) +type KeyId   = Text + -- | Header content for a JWS. data JwsHeader = JwsHeader {     jwsAlg :: JwsAlg   , jwsTyp :: Maybe Text   , jwsCty :: Maybe Text-  , jwsKid :: Maybe Text+  , jwsKid :: Maybe KeyId   } deriving (Eq, Show, Generic)  -- | Header content for a JWE.@@ -62,7 +66,7 @@   , jweTyp :: Maybe Text   , jweCty :: Maybe Text   , jweZip :: Maybe Text-  , jweKid :: Maybe Text+  , jweKid :: Maybe KeyId   } deriving (Eq, Show, Generic)  newtype IntDate = IntDate POSIXTime deriving (Show, Eq, Ord)@@ -108,7 +112,7 @@ data JwtError = KeyError Text      -- ^ No suitable key or wrong key type               | BadAlgorithm Text  -- ^ The supplied algorithm is invalid               | BadDots Int        -- ^ Wrong number of "." characters in the JWT-              | BadHeader          -- ^ Header couldn't be decoded or contains bad data+              | BadHeader Text     -- ^ Header couldn't be decoded or contains bad data               | BadClaims          -- ^ Claims part couldn't be decoded or contains bad data               | BadSignature       -- ^ Signature is invalid               | BadCrypto          -- ^ A cryptographic operation failed@@ -137,7 +141,7 @@ encodeHeader h = BL.toStrict $ encode h  parseHeader :: ByteString -> Either JwtError JwtHeader-parseHeader hdr = maybe (Left BadHeader) return $ decodeStrict hdr+parseHeader hdr = either (Left . BadHeader . T.pack) return $ eitherDecodeStrict' hdr  jwsOptions :: Options jwsOptions = prefixOptions "jws"

@@ -1,5 +1,5 @@ Name:               jose-jwt-Version:            0.2+Version:            0.3 Synopsis:           JSON Object Signing and Encryption Library Homepage:           http://github.com/tekul/jose-jwt Bug-Reports:        http://github.com/tekul/jose-jwt/issues@@ -24,6 +24,9 @@ Cabal-Version:      >= 1.16 Category:           JSON, Cryptography +Extra-Source-Files:+    CHANGELOG.md+ Source-Repository head   Type:             git   Location:         git://github.com/tekul/jose-jwt.git@@ -39,14 +42,15 @@                     , Jose.Internal.Crypto   Other-Modules:      Jose.Types   Build-Depends:      base >= 4 && < 5-                    , mtl >= 2.1+                    , mtl >= 2.1.3.1                     , bytestring >= 0.9                     , byteable >= 0.1.1                     , cereal >= 0.4                     , containers >= 0.4                     , cryptohash >= 0.8                     , crypto-cipher-types >= 0.0.9-                    , crypto-pubkey >= 0.1.2+                    , crypto-pubkey >= 0.2.5+                    , crypto-pubkey-types >= 0.4                     , crypto-random >= 0.0.7                     , crypto-numbers >= 0.2                     , cipher-aes >= 0.2.6

@@ -42,7 +42,7 @@           Jws.hmacDecode hmacKey a11 @?= a11decoded          it "encodes the payload to the expected JWT" $-          encode a11mac a11Header a11Payload @?= a11+          signWithHeader a11mac a11Header a11Payload @?= a11          it "decodes the payload using the JWK" $ do           let Just k11 = decodeStrict' a11jwk@@ -58,9 +58,13 @@         it "decodes the JWT to the expected header and payload" $           Jws.rsaDecode rsaPublicKey a21 @?= Right (defJwsHdr {jwsAlg = RS256}, a21Payload) +        it "decodes the JWT to the expected header and payload with the JWK" $ do+          let Just k21 = decodeStrict' a21jwk+          fst (decode RNG [k21] a21) @?= (Right $ Jws (defJwsHdr {jwsAlg = RS256}, a21Payload))+         it "encodes the payload to the expected JWT" $ do           let sign = either (error "Sign failed") id . RSAPKCS15.sign Nothing hashDescrSHA256 rsaPrivateKey-          encode sign a21Header a21Payload @?= a21+          signWithHeader sign a21Header a21Payload @?= a21          it "encodes/decodes using RS256" $           rsaRoundTrip RS256 a21Payload@@ -71,7 +75,13 @@         it "encodes/decodes using RS512" $           rsaRoundTrip RS512 a21Payload -encode sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload]+      context "when using JWS Appendix A.3 data" $ do+        let a31decoded = Right (defJwsHdr {jwsAlg = ES256}, a31Payload)+        it "decodes the JWT to the expected header and payload" $ do+          let Just k31 = decodeStrict' a31jwk+          fst (decode RNG [k31] a31) @?= fmap Jws a31decoded++signWithHeader sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload]   where     hdrPayload = B.intercalate "." $ map B64.encode [hdr, payload] @@ -90,6 +100,13 @@ a21Header = "{\"alg\":\"RS256\"}" :: B.ByteString a21Payload = a11Payload a21 = "eyJhbGciOiJSUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.cC4hiUPoj9Eetdgtv3hF80EGrhuB__dzERat0XF9g2VtQgr9PJbu3XOiZj5RZmh7AAuHIm4Bh-0Qc_lF5YKt_O8W2Fp5jujGbds9uJdbF9CUAr7t1dnZcAcQjbKBYNX4BAynRFdiuB--f_nZLgrnbyTyWzO75vRK5h6xBArLIARNPvkSjtQBMHlb1L07Qe7K0GarZRmB_eSN9383LcOLn6_dO--xi12jzDwusC-eOkHWEsqtFZESc6BfI7noOPqvhJ1phCnvWh6IeYI2w9QOYEUipUTI8np6LbgGY9Fs98rqVt5AXLIhWkWywlVmtVrBp0igcN_IoypGlUPQGe77Rw"+a21jwk = "{\"kty\":\"RSA\", \"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\"}"++a31Header = "{\"alg\":\"ES256\"}" :: B.ByteString+a31Payload = a11Payload+a31 = "eyJhbGciOiJFUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.DtEhU3ljbEg8L38VWAfUAqOyKAM6-Xx-F4GawxaepmXFCgfTjDxw5djxLa8ISlSApmWQxfKTUJqPP3-Kg6NU1Q"+a31jwk = "{\"kty\":\"EC\", \"crv\":\"P-256\", \"x\":\"f83OJ3D2xF1Bg8vub9tLe1gHMzV76e8Tus9uPHvRVEU\", \"y\":\"x_FEzRu9m36HLN_tue659LNpXW6pCyStikYjKIWI5a0\", \"d\":\"jpsQnnGQmL-YBIffH1136cspYG6-0iY7X1fCE9-E9LI\" }"+  hmacKey = B.pack [     3, 35, 53, 75, 43, 15, 165, 188, 131, 126, 6, 101, 119, 123, 166,