diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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. + + diff --git a/Jose/Internal/Crypto.hs b/Jose/Internal/Crypto.hs --- a/Jose/Internal/Crypto.hs +++ b/Jose/Internal/Crypto.hs @@ -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 -- diff --git a/Jose/Jwa.hs b/Jose/Jwa.hs --- a/Jose/Jwa.hs +++ b/Jose/Jwa.hs @@ -21,19 +21,19 @@ -- | A subset of the signature algorithms from the -- . -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 -- . data JweAlg = RSA1_5 | RSA_OAEP deriving (Eq, Show, Read) --- TODO: AES_192_CBC_HMAC_SHA_384 ?? -- | Content encryption algorithms from the -- . +-- 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 diff --git a/Jose/Jwe.hs b/Jose/Jwe.hs --- a/Jose/Jwe.hs +++ b/Jose/Jwe.hs @@ -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 diff --git a/Jose/Jwk.hs b/Jose/Jwk.hs --- a/Jose/Jwk.hs +++ b/Jose/Jwk.hs @@ -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)) diff --git a/Jose/Jws.hs b/Jose/Jws.hs --- a/Jose/Jws.hs +++ b/Jose/Jws.hs @@ -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 diff --git a/Jose/Jwt.hs b/Jose/Jwt.hs --- a/Jose/Jwt.hs +++ b/Jose/Jwt.hs @@ -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) diff --git a/Jose/Types.hs b/Jose/Types.hs --- a/Jose/Types.hs +++ b/Jose/Types.hs @@ -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" 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.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 diff --git a/tests/Tests/JwsSpec.hs b/tests/Tests/JwsSpec.hs --- a/tests/Tests/JwsSpec.hs +++ b/tests/Tests/JwsSpec.hs @@ -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,