diff --git a/Jose/Internal/Base64.hs b/Jose/Internal/Base64.hs new file mode 100644 --- /dev/null +++ b/Jose/Internal/Base64.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide #-} + +-- | JWT-style base64 encoding and decoding + +module Jose.Internal.Base64 where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Base64.URL as B64 + +import Jose.Types + +-- | Base64 URL encode without padding. +encode :: ByteString -> ByteString +encode = strip . B64.encode + where + strip "" = "" + strip bs = case BC.last bs of + '=' -> strip $ B.init bs + _ -> bs + +-- | Base64 decode. +decode :: ByteString -> Either JwtError ByteString +decode bs = either (Left . Base64Error) Right $ B64.decode bsPadded + where + bsPadded = case B.length bs `mod` 4 of + 3 -> bs `BC.snoc` '=' + 2 -> bs `B.append` "==" + _ -> bs + diff --git a/Jose/Internal/Crypto.hs b/Jose/Internal/Crypto.hs new file mode 100644 --- /dev/null +++ b/Jose/Internal/Crypto.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune #-} + +-- | Internal functions for encrypting and signing / decrypting +-- and verifying JWT content. + +module Jose.Internal.Crypto + ( hmacSign + , hmacVerify + , rsaSign + , rsaVerify + , rsaEncrypt + , rsaDecrypt + , encryptPayload + , decryptPayload + , generateCmkAndIV + , pad + , unpad + ) +where + +import Crypto.Cipher.Types (AuthTag(..)) +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15 +import qualified Crypto.PubKey.RSA.OAEP as OAEP +import Crypto.Random (CPRG, cprgGenerate) +import qualified Crypto.Cipher.AES as AES +import Crypto.PubKey.HashDescr +import Crypto.MAC.HMAC (hmac) +import Data.Byteable (constEqBytes) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Maybe (fromMaybe) +import qualified Data.Serialize as Serialize +import Data.Word (Word64, Word8) + +import Jose.Jwa +import Jose.Types (JwtError(..)) + +-- | Sign a message with an HMAC key. +hmacSign :: JwsAlg -- ^ HMAC algorithm to use + -> ByteString -- ^ Key + -> ByteString -- ^ The message/content + -> ByteString -- ^ HMAC output +hmacSign a k m = hmac (hashFunction hash) 64 k m + where + hash = fromMaybe (error $ "Not an HMAC alg: " ++ show a) $ lookup a hmacHashes + +-- | Verify the HMAC for a given message. +-- Returns false if the MAC is incorrect or the 'Alg' is not an HMAC. +hmacVerify :: JwsAlg -- ^ HMAC Algorithm to use + -> ByteString -- ^ Key + -> ByteString -- ^ The message/content + -> ByteString -- ^ The signature to check + -> Bool -- ^ Whether the signature is correct +hmacVerify a key msg sig = case lookup a hmacHashes of + Just _ -> constEqBytes (hmacSign a key msg) sig + Nothing -> False + +-- TODO: Check PKCS15.sign error conditions to see whether they apply + +-- | Sign a message using an RSA private key. +rsaSign :: JwsAlg -- ^ Algorithm to use. Must be one of @RSA256@, @RSA384@ or @RSA512@. + -> RSA.PrivateKey -- ^ Private key to sign with + -> ByteString -- ^ Message to sign + -> ByteString -- ^ The signature +rsaSign a key = either (error "Signing failed") id . PKCS15.sign Nothing hash key + where + hash = fromMaybe (error $ "Not an RSA Algorithm " ++ show a) $ lookupRSAHash a + +-- | Verify the signature for a message using an RSA public key. +-- Returns false if the check fails or if the 'Alg' value is not +-- an RSA signature algorithm. +rsaVerify :: JwsAlg -- ^ The signature algorithm. Used to obtain the hash function. + -> RSA.PublicKey -- ^ The key to check the signature with + -> ByteString -- ^ The message/content + -> 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 + 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 + _ -> Nothing + +-- | Generates the symmetric key (content management key) and IV +-- used to encrypt a message. +generateCmkAndIV :: CPRG g + => g -- ^ The random number generator + -> Enc -- ^ The encryption algorithm to be used + -> (B.ByteString, B.ByteString, g) -- ^ The key, IV and generator +generateCmkAndIV g e = (cmk, iv, g'') + where + (cmk, g') = cprgGenerate (keySize e) g + (iv, g'') = cprgGenerate (ivSize e) g' -- iv for aes gcm or cbc + +keySize :: Enc -> Int +keySize A128GCM = 16 +keySize A256GCM = 32 +keySize A128CBC_HS256 = 32 +keySize A256CBC_HS512 = 64 + +ivSize :: Enc -> Int +ivSize A128GCM = 12 +ivSize A256GCM = 12 +ivSize _ = 16 + +-- | Encrypts a message (typically a symmetric key) using RSA. +rsaEncrypt :: CPRG g + => g -- ^ Random number generator + -> JweAlg -- ^ The algorithm (either @RSA1_5@ or @RSA_OAEP@) + -> RSA.PublicKey -- ^ The encryption key + -> B.ByteString -- ^ The message to encrypt + -> (B.ByteString, g) -- ^ The encrypted messaged and new generator +rsaEncrypt gen a pubKey content = (ct, g') + where + encrypt = case a of + RSA1_5 -> PKCS15.encrypt gen + RSA_OAEP -> OAEP.encrypt gen oaepParams +-- TODO: Check that we can't cause any errors here with our RSA public key + (Right ct, g') = encrypt pubKey content + +-- | Decrypts an RSA encrypted message. +rsaDecrypt :: JweAlg -- ^ The RSA algorithm to use + -> RSA.PrivateKey -- ^ The decryption key + -> B.ByteString -- ^ The encrypted content + -> Either JwtError B.ByteString -- ^ The decrypted key +rsaDecrypt a rsaKey jweKey = do + decrypt <- decryptAlg + either (\_ -> Left BadCrypto) Right $ decrypt rsaKey jweKey + where + decryptAlg = case a of + RSA1_5 -> Right $ PKCS15.decrypt Nothing + RSA_OAEP -> Right $ OAEP.decrypt Nothing oaepParams + +oaepParams :: OAEP.OAEPParams +oaepParams = OAEP.defaultOAEPParams (hashFunction hashDescrSHA1) + +-- TODO: Need to check key length and IV are is valid for enc. + +-- | Decrypt an AES encrypted message. +decryptPayload :: Enc -- ^ Encryption algorithm + -> ByteString -- ^ Content management key + -> ByteString -- ^ IV + -> ByteString -- ^ Additional authentication data + -> ByteString -- ^ The integrity protection value to be checked + -> ByteString -- ^ The encrypted JWT payload + -> Either JwtError ByteString +decryptPayload e cek iv aad sig ct = do + (plaintext, tag) <- case e of + A128GCM -> decryptedGCM + A256GCM -> decryptedGCM + _ -> decryptedCBC + if tag == AuthTag sig + then return plaintext + else Left BadSignature + where + decryptedGCM = Right $ AES.decryptGCM (AES.initAES cek) iv aad ct + + decryptedCBC = do + let (macKey, encKey) = B.splitAt (B.length cek `div` 2) cek + let al = fromIntegral (B.length aad) * 8 :: Word64 + plaintext <- unpad $ AES.decryptCBC (AES.initAES encKey) iv ct + let mac = authTag e macKey $ B.concat [aad, iv, ct, Serialize.encode al] + return (plaintext, mac) + +-- | Encrypt a message using AES. +encryptPayload :: Enc -- ^ Encryption algorithm + -> ByteString -- ^ Content management key + -> ByteString -- ^ IV + -> ByteString -- ^ Additional authenticated data + -> ByteString -- ^ The message/JWT claims + -> (ByteString, AuthTag) -- ^ Ciphertext claims and signature tag +encryptPayload e cek iv aad msg = case e of + A128GCM -> aesgcm + A256GCM -> aesgcm + _ -> (aescbc, sig) + where + aesgcm = AES.encryptGCM (AES.initAES cek) iv aad msg + (macKey, encKey) = B.splitAt (B.length cek `div` 2) cek + aescbc = AES.encryptCBC (AES.initAES encKey) iv (pad msg) + al = fromIntegral (B.length aad) * 8 :: Word64 + sig = authTag e macKey $ B.concat [aad, iv, aescbc, Serialize.encode al] + +authTag :: Enc -> ByteString -> ByteString -> AuthTag +authTag e k m = AuthTag $ B.take tLen $ hmacSign a k m + where + (tLen, a) = case e of + A128CBC_HS256 -> (16, HS256) + -- A192_CBC_HS384 -> (24, HS384) + A256CBC_HS512 -> (32, HS512) + _ -> error "TODO" + +unpad :: ByteString -> Either JwtError ByteString +unpad bs + | padLen > 16 || padLen /= B.length padding = Left BadCrypto + | B.any (/= padByte) padding = Left BadCrypto + | otherwise = Right pt + where + len = B.length bs + padByte = B.last bs + padLen = fromIntegral padByte + (pt, padding) = B.splitAt (len - padLen) bs + +pad :: ByteString -> ByteString +pad bs = B.append bs $ padding + where + lastBlockSize = B.length bs `mod` 16 + padByte = fromIntegral $ 16 - lastBlockSize :: Word8 + padding = B.replicate (fromIntegral padByte) padByte + diff --git a/Jose/Jwa.hs b/Jose/Jwa.hs new file mode 100644 --- /dev/null +++ b/Jose/Jwa.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune #-} + +module Jose.Jwa + ( Alg (..) + , JwsAlg (..) + , JweAlg (..) + , Enc (..) + , encName + ) +where + +import Control.Applicative (pure) +import Data.Aeson +import Data.Text (Text) +import Data.Maybe (fromJust) +import Data.Tuple (swap) + +-- | General representation of the @alg@ JWT header value. +data Alg = Signed JwsAlg | Encrypted JweAlg deriving (Eq, Show) + +-- | A subset of the signature algorithms from the +-- . +data JwsAlg = None | HS256 | HS384 | HS512 | RS256 | RS384 | RS512 deriving (Eq, Show) + +-- | A subset of the key management algorithms from the +-- . +data JweAlg = RSA1_5 | RSA_OAEP deriving (Eq, Show) + +-- TODO: AES_192_CBC_HMAC_SHA_384 ?? +-- | Content encryption algorithms from the +-- . +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)] + +algName :: Alg -> Text +algName a = fromJust $ lookup a algNames + +algNames :: [(Alg, Text)] +algNames = map swap algs + +encs :: [(Text, Enc)] +encs = [("A128CBC-HS256", A128CBC_HS256), ("A256CBC-HS512", A256CBC_HS512), ("A128GCM", A128GCM), ("A256GCM", A256GCM)] + +encName :: Enc -> Text +encName e = fromJust $ lookup e encNames + +encNames :: [(Enc, Text)] +encNames = map swap encs + +instance FromJSON Alg where + parseJSON = withText "Alg" $ \t -> + maybe (fail "Unsupported alg") pure $ lookup t algs + +instance ToJSON Alg where + toJSON = String . algName + +instance FromJSON JwsAlg where + parseJSON = withText "JwsAlg" $ \t -> case lookup t algs of + Just (Signed a) -> pure a + _ -> fail ("Unsupported JWS algorithm") + +instance ToJSON JwsAlg where + toJSON a = String . algName $ Signed a + +instance FromJSON JweAlg where + parseJSON = withText "JweAlg" $ \t -> case lookup t algs of + Just (Encrypted a) -> pure a + _ -> fail ("Unsupported JWE algorithm") + +instance ToJSON JweAlg where + toJSON a = String . algName $ Encrypted a + +instance FromJSON Enc where + parseJSON = withText "Enc" $ \t -> + maybe (fail "Unsupported enc") pure $ lookup t encs + +instance ToJSON Enc where + toJSON = String . encName + diff --git a/Jose/Jwe.hs b/Jose/Jwe.hs new file mode 100644 --- /dev/null +++ b/Jose/Jwe.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | JWE RSA encrypted token support. +-- +-- Example usage: +-- +-- >>> import Jose.Jwe +-- >>> import Jose.Jwa +-- >>> import Crypto.Random.AESCtr +-- >>> 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" +-- >>> rsaDecode kPr jwt +-- Right (JweHeader {jweAlg = RSA_OAEP, jweEnc = A128GCM, jweTyp = Nothing, jweCty = Nothing, jweZip = Nothing, jweKid = Nothing},"secret claims") + +module Jose.Jwe where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Crypto.Cipher.Types (AuthTag(..)) +import Crypto.PubKey.RSA (PrivateKey, PublicKey) +import Crypto.Random.API (CPRG) +import Jose.Types +import qualified Jose.Internal.Base64 as B64 +import Jose.Internal.Crypto +import Jose.Jwa + +-- | Creates a JWE. +rsaEncode :: CPRG g + => g -- ^ Random number generator + -> JweAlg -- ^ RSA algorithm to use (@RSA_OAEP@ or @RSA1_5@) + -> Enc -- ^ Content encryption algorithm + -> 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'') + where + hdr = encodeHeader defJweHdr {jweAlg = a, jweEnc = e} + (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 :: PrivateKey -- ^ Decryption key + -> ByteString -- ^ The encoded JWE + -> Either JwtError Jwe -- ^ The decoded JWT, unless an error occurs +rsaDecode rsaKey jwt = do + checkDots + let components = BC.split '.' jwt + let aad = head components + [h, ek, iv, payload, sig] <- mapM B64.decode components + hdr <- case parseHeader h of + Right (JweH jweHdr) -> return jweHdr + _ -> Left BadHeader + let alg = jweAlg hdr + cek <- rsaDecrypt alg rsaKey ek + claims <- decryptPayload (jweEnc hdr) cek iv aad sig payload + return (hdr, claims) + where + checkDots = case BC.count '.' jwt of + 4 -> Right () + _ -> Left $ BadDots 4 + diff --git a/Jose/Jwk.hs b/Jose/Jwk.hs new file mode 100644 --- /dev/null +++ b/Jose/Jwk.hs @@ -0,0 +1,268 @@ +{-# LANGUAGE OverloadedStrings, BangPatterns, DeriveGeneric #-} +{-# OPTIONS_HADDOCK prune #-} + +module Jose.Jwk + ( KeyType + , KeyUse + , KeyId + , Jwk (..) + , JwkSet (..) + , findMatchingJwsKeys + , findMatchingJweKeys + ) +where + +import Control.Applicative (pure) +import qualified Crypto.PubKey.RSA as RSA +import Crypto.Number.Serialize +import Data.Aeson (genericToJSON, Value(..), FromJSON(..), ToJSON(..), withText) +import Data.Aeson.Types (Parser, Options (..), defaultOptions) +import Data.ByteString (ByteString) +import Data.Text (Text) +import qualified Data.Text.Encoding as TE +import GHC.Generics (Generic) + +import qualified Jose.Internal.Base64 as B64 +import Jose.Jwa +import Jose.Types (JwsHeader(..), JweHeader(..)) + +data KeyType = Rsa + | Ec + | Oct + deriving (Eq, Show) + +data EcCurve = P_256 + | P_384 + | P_521 + deriving (Eq,Show) + +data KeyUse = Sig + | 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) + | SymmetricJwk ByteString (Maybe KeyId) (Maybe KeyUse) (Maybe Alg) + deriving (Show) + +data JwkSet = JwkSet + { keys :: [Jwk] + } deriving (Show, Generic) + +canDecodeJws :: JwsAlg -> Jwk -> Bool +canDecodeJws al jwk = case al of + HS256 -> mustBeSymmetric + HS384 -> mustBeSymmetric + HS512 -> mustBeSymmetric + RS256 -> mustBeRsa + RS384 -> mustBeRsa + RS512 -> mustBeRsa + -- Not yet supported (EC) + _ -> False + where + mustBeRsa = not mustBeSymmetric + mustBeSymmetric = case jwk of + SymmetricJwk _ _ _ _ -> True + _ -> False + +canDecodeJwe :: JweAlg -> Jwk -> Bool +canDecodeJwe _ jwk = case jwk of -- JWE + RsaPrivateJwk _ _ _ _ -> True + _ -> False + +jwkId :: Jwk -> Maybe KeyId +jwkId key = case key of + RsaPublicJwk _ keyId _ _ -> keyId + RsaPrivateJwk _ keyId _ _ -> keyId + SymmetricJwk _ keyId _ _ -> keyId + +findKeyById :: [Jwk] -> KeyId -> Maybe Jwk +findKeyById [] _ = Nothing +findKeyById (key:ks) keyId = case jwkId key of + Nothing -> findKeyById ks keyId + Just v -> if v == keyId + then Just key + else findKeyById ks keyId + +-- TODO filter by key use +findMatchingJwsKeys :: [Jwk] -> JwsHeader -> [Jwk] +findMatchingJwsKeys jwks hdr = filter (canDecodeJws (jwsAlg hdr)) $ filterById (jwsKid hdr) jwks + +filterById :: Maybe KeyId -> [Jwk] -> [Jwk] +filterById keyId jwks = case keyId of + Just i -> maybe jwks (\key -> [key]) $ findKeyById jwks i + Nothing -> jwks + +findMatchingJweKeys :: [Jwk] -> JweHeader -> [Jwk] +findMatchingJweKeys jwks hdr = filter (canDecodeJwe (jweAlg hdr)) $ filterById (jweKid hdr) jwks + +newtype JwkBytes = JwkBytes {bytes :: ByteString} deriving (Show) + +instance FromJSON KeyType where + parseJSON = withText "KeyType" $ \t -> + case t of + "RSA" -> pure Rsa + "EC" -> pure Ec + "oct" -> pure Ec + _ -> fail "unsupported key type" + +instance ToJSON KeyType where + toJSON kt = case kt of + Rsa -> String "RSA" + Ec -> String "EC" + Oct -> String "oct" + +instance FromJSON KeyUse where + parseJSON = withText "KeyUse" $ \t -> + case t of + "sig" -> pure Sig + "enc" -> pure Enc + _ -> fail "'use' value must be either 'sig' or 'enc'" + +instance ToJSON KeyUse where + toJSON ku = case ku of + Sig -> String "sig" + Enc -> String "enc" + +instance FromJSON EcCurve where + parseJSON = withText "EcCurve" $ \t -> + case t of + "P-256" -> pure P_256 + "P-384" -> pure P_384 + "P-521" -> pure P_521 + _ -> fail "unsupported 'crv' value" + +instance ToJSON EcCurve where + toJSON c = case c of + P_256 -> String "P-256" + P_384 -> String "P-384" + P_521 -> String "P-521" + +instance FromJSON JwkBytes where + parseJSON = withText "JwkBytes" $ \t -> + case B64.decode (TE.encodeUtf8 t) of + Left _ -> fail "could not base64 decode bytes" + Right b -> pure $ JwkBytes b + +instance ToJSON JwkBytes where + toJSON (JwkBytes b) = String . TE.decodeUtf8 $ B64.encode b + +instance FromJSON Jwk where + parseJSON o@(Object _) = do + jwkData <- parseJSON o :: Parser JwkData + case (createJwk jwkData) of + Left err -> fail err + Right jwk -> return jwk + parseJSON _ = fail "Jwk must be a JSON object" + +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 + } + where + i2b 0 = Nothing + i2b i = Just . JwkBytes . i2osp $ i + + createPubData pubKey mId mUse mAlg = defJwk + { n = Just . JwkBytes . i2osp $ RSA.public_n pubKey + , e = Just . JwkBytes . i2osp $ RSA.public_e pubKey + , kid = mId + , use = mUse + , alg = mAlg + } +instance ToJSON JwkSet +instance FromJSON JwkSet + +aesonOptions :: Options +aesonOptions = defaultOptions { omitNothingFields = True } + +data JwkData = J + { kty :: KeyType + -- There's probably a better way to parse this + -- than encoding all the possible key params + -- but this will do for now. + , n :: Maybe JwkBytes + , e :: Maybe JwkBytes + , d :: Maybe JwkBytes + , p :: Maybe JwkBytes + , q :: Maybe JwkBytes + , dp :: Maybe JwkBytes + , dq :: Maybe JwkBytes + , qi :: Maybe JwkBytes + , k :: Maybe JwkBytes + , crv :: Maybe EcCurve + , x :: Maybe JwkBytes + , y :: Maybe JwkBytes + , use :: Maybe KeyUse + , alg :: Maybe Alg + , kid :: Maybe Text + , x5u :: Maybe Text + , x5c :: Maybe [Text] + , x5t :: Maybe Text + } deriving (Show, Generic) + +instance FromJSON JwkData +instance ToJSON JwkData where + toJSON = genericToJSON aesonOptions + +defJwk :: JwkData +defJwk = J + { kty = Rsa + , n = Nothing + , e = Nothing + , d = Nothing + , p = Nothing + , q = Nothing + , dp = Nothing + , dq = Nothing + , qi = Nothing + , k = Nothing + , crv = Nothing + , x = Nothing + , y = Nothing + , use = Just Sig + , alg = Nothing + , kid = Nothing + , x5u = Nothing + , x5c = Nothing + , x5t = Nothing + } + +createJwk :: JwkData -> Either String Jwk +createJwk kd = case kd of + J Rsa (Just nb) (Just eb) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing u a i _ _ _ -> + return $ RsaPublicJwk (rsaPub nb eb) i u a + J Rsa (Just nb) (Just eb) (Just db) mp mq mdp mdq mqi Nothing Nothing Nothing Nothing u a i _ _ _ -> + 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" + 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 mb = maybe 0 (os2ip . bytes) mb + diff --git a/Jose/Jws.hs b/Jose/Jws.hs new file mode 100644 --- /dev/null +++ b/Jose/Jws.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | JWS HMAC and RSA signed token support. +-- +-- Example usage with HMAC: +-- +-- >>> import Jose.Jws +-- >>> import Jose.Jwa +-- >>> let jwt = hmacEncode HS256 "secretmackey" "secret claims" +-- >>> jwt +-- "eyJhbGciOiJIUzI1NiJ9.c2VjcmV0IGNsYWltcw.Hk9VZbfMHEC_IGVHnAi25HgWR91XMneqYCl7F5izQkM" +-- >>> hmacDecode "wrongkey" jwt +-- Left BadSignature +-- >>> hmacDecode "secretmackey" jwt +-- Right (JwsHeader {jwsAlg = HS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Nothing},"secret claims") + +module Jose.Jws + ( hmacEncode + , hmacDecode + , rsaEncode + , rsaDecode + ) +where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Crypto.PubKey.RSA (PrivateKey, PublicKey) +import Jose.Types +import qualified Jose.Internal.Base64 as B64 +import Jose.Internal.Crypto +import Jose.Jwa + +-- | Create a JWS with an HMAC for validation. +hmacEncode :: JwsAlg -- ^ The MAC algorithm to use + -> ByteString -- ^ The MAC key + -> ByteString -- ^ The JWT claims (token content) + -> ByteString -- ^ The encoded JWS token +hmacEncode a key = encode (hmacSign a key) $ defJwsHdr {jwsAlg = a} + +-- | Decodes and validates an HMAC signed JWS. +hmacDecode :: ByteString -- ^ The HMAC key + -> ByteString -- ^ The JWS token to decode + -> Either JwtError Jws -- ^ The decoded token if successful +hmacDecode key = decode (\alg -> hmacVerify alg key) + +-- | Creates a JWS with an RSA signature. +rsaEncode :: JwsAlg -- ^ The RSA algorithm to use + -> PrivateKey -- ^ The key to sign with + -> ByteString -- ^ The JWT claims (token content) + -> ByteString -- ^ The encoded JWS token +rsaEncode a k = encode (rsaSign a k) $ defJwsHdr {jwsAlg = a} + +-- | 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 (\alg -> rsaVerify alg key) + +encode :: (ByteString -> ByteString) -> JwsHeader -> ByteString -> ByteString +encode sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload] + where + hdrPayload = B.intercalate "." $ map B64.encode [encodeHeader hdr, payload] + +type JwsVerifier = JwsAlg -> ByteString -> ByteString -> Bool + +decode :: JwsVerifier -> ByteString -> Either JwtError Jws +decode verify jwt = do + checkDots + let (hdrPayload, sig) = spanEndDot jwt + sigBytes <- B64.decode sig + [h, payload] <- mapM B64.decode $ BC.split '.' hdrPayload + hdr <- case parseHeader h of + Right (JwsH jwsHdr) -> return jwsHdr + _ -> Left BadHeader + if verify (jwsAlg hdr) hdrPayload sigBytes + then Right (hdr, payload) + else Left BadSignature + where + checkDots = case (BC.count '.' jwt) of + 2 -> Right () + _ -> Left $ BadDots 2 + spanEndDot bs = let (toDot, end) = BC.spanEnd (/= '.') bs + in (B.init toDot, end) + diff --git a/Jose/Jwt.hs b/Jose/Jwt.hs new file mode 100644 --- /dev/null +++ b/Jose/Jwt.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK prune #-} + +module Jose.Jwt + ( module Jose.Types + , decode + ) +where + +import Crypto.PubKey.RSA (PrivateKey(..)) +import Data.ByteString (ByteString) +import Data.List (find) +import qualified Data.ByteString.Char8 as BC + +import qualified Jose.Internal.Base64 as B64 +import Jose.Types +import Jose.Jwk + +import qualified Jose.Jws as Jws +import qualified Jose.Jwe as Jwe + + +-- | 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 :: JwkSet -- ^ The keys to use for decoding + -> ByteString -- ^ The encoded JWT + -> Either JwtError Jwt -- ^ The decoded JWT, if successful +decode keySet jwt = do + let components = BC.split '.' jwt + hdr <- (B64.decode $ head components) >>= parseHeader + ks <- findKeys hdr (keys keySet) + -- Now we have one or more suitable keys. + -- Try each in turn until successful + let decodeWith = case hdr of + JwsH _ -> decodeWithJws + _ -> decodeWithJwe + let decodings = map decodeWith ks + maybe (Left $ KeyError "None of the keys was able to decode the JWT") id $ find (isRight) decodings + where + decodeWithJws :: Jwk -> Either JwtError Jwt + decodeWithJws k = fmap Jws $ case k of + RsaPublicJwk kPub _ _ _ -> Jws.rsaDecode kPub jwt + RsaPrivateJwk kPr _ _ _ -> Jws.rsaDecode (private_pub kPr) jwt + SymmetricJwk kb _ _ _ -> Jws.hmacDecode kb jwt + + decodeWithJwe :: Jwk -> Either JwtError Jwt + decodeWithJwe k = fmap Jwe $ case k of + RsaPrivateJwk kPr _ _ _ -> Jwe.rsaDecode kPr jwt + _ -> Left $ KeyError "Not a JWE key (shoudln't happen)" + isRight (Left _) = False + isRight (Right _) = True + +findKeys :: JwtHeader -> [Jwk] -> Either JwtError [Jwk] +findKeys hdr jwks = checkKeys $ case hdr of + JweH h -> findMatchingJweKeys jwks h + JwsH h -> findMatchingJwsKeys jwks h + where + -- TODO Move checks to JWK and support better error messages + checkKeys [] = Left $ KeyError "No suitable key was found to decode the JWT" + checkKeys ks = return ks diff --git a/Jose/Types.hs b/Jose/Types.hs new file mode 100644 --- /dev/null +++ b/Jose/Types.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} +{-# OPTIONS_HADDOCK prune #-} + +module Jose.Types + ( Jwt (..) + , Jwe + , Jws + , JwtHeader (..) + , JwsHeader (..) + , JweHeader (..) + , JwtError (..) + , parseHeader + , encodeHeader + , defJwsHdr + , defJweHdr + ) +where + +import Data.Aeson +import Data.Aeson.Types +import Data.Char (toUpper, toLower) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as BL +import qualified Data.HashMap.Strict as H +import GHC.Generics +import Data.Text (Text) + +import Jose.Jwa (JweAlg(..), JwsAlg (..), Enc(..)) + +-- | 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 + +data JwtHeader = JweH JweHeader + | JwsH JwsHeader + + +-- | Header content for a JWS. +data JwsHeader = JwsHeader { + jwsAlg :: JwsAlg + , jwsTyp :: Maybe Text + , jwsCty :: Maybe Text + , jwsKid :: Maybe Text + } deriving (Eq, Show, Generic) + +-- | Header content for a JWE. +data JweHeader = JweHeader { + jweAlg :: JweAlg + , jweEnc :: Enc + , jweTyp :: Maybe Text + , jweCty :: Maybe Text + , jweZip :: Maybe Text + , jweKid :: Maybe Text + } deriving (Eq, Show, Generic) + +defJwsHdr :: JwsHeader +defJwsHdr = JwsHeader None Nothing Nothing Nothing + +defJweHdr :: JweHeader +defJweHdr = JweHeader RSA_OAEP A128GCM Nothing Nothing Nothing Nothing + +-- | Decoding errors. +data JwtError = --Empty + KeyError Text -- ^ No suitable key or wrong key type + | BadDots Int -- ^ Wrong number of "." characters in the JWT + | BadHeader -- ^ Header couldn't be decoded or contains bad data + | BadSignature -- ^ Signature is invalid + | BadCrypto -- ^ A cryptographic operation failed + | Base64Error String -- ^ A base64 decoding error + deriving (Eq, Show) + +instance ToJSON JwsHeader where + toJSON = genericToJSON jwsOptions + +instance FromJSON JwsHeader where + parseJSON = genericParseJSON jwsOptions + +instance ToJSON JweHeader where + toJSON = genericToJSON jweOptions + +instance FromJSON JweHeader where + parseJSON = genericParseJSON jweOptions + +instance FromJSON JwtHeader where + parseJSON v@(Object o) = case H.lookup "enc" o of + Nothing -> fmap JwsH $ parseJSON v + _ -> fmap JweH $ parseJSON v + parseJSON _ = fail "JwtHeader must be an object" + +encodeHeader :: ToJSON a => a -> ByteString +encodeHeader h = BL.toStrict $ encode h + +parseHeader :: ByteString -> Either JwtError JwtHeader +parseHeader hdr = maybe (Left BadHeader) Right $ decodeStrict hdr + +jwsOptions :: Options +jwsOptions = prefixOptions "jws" + +jweOptions :: Options +jweOptions = prefixOptions "jwe" + +prefixOptions :: String -> Options +prefixOptions prefix = omitNothingOptions + { fieldLabelModifier = dropPrefix $ length prefix + , constructorTagModifier = addPrefix prefix + } + where + omitNothingOptions = defaultOptions { omitNothingFields = True } + dropPrefix l s = let remainder = drop l s + in (toLower . head) remainder : tail remainder + + addPrefix p s = p ++ toUpper (head s) : tail s diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2014, Luke Taylor + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/benchmarks/bench.hs b/benchmarks/bench.hs new file mode 100644 --- /dev/null +++ b/benchmarks/bench.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Criterion.Main +import Crypto.Random +import Jose.Jws +import Jose.Jwa +import Keys + +main = do + rng <- cprgCreate `fmap` createEntropyPool :: IO SystemRNG + let msg = "The best laid schemes o' mice and men" + + 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 + ] + ] diff --git a/jose-jwt.cabal b/jose-jwt.cabal new file mode 100644 --- /dev/null +++ b/jose-jwt.cabal @@ -0,0 +1,98 @@ +Name: jose-jwt +Version: 0.1 +Synopsis: JSON Object Signing and Encryption Library +Homepage: http://github.com/tekul/jose-jwt +Bug-Reports: http://github.com/tekul/jose-jwt/issues +Description: + . + Intended to provide support for the JOSE suite of IETF (draft) + standards and the closely related JWT (JSON web token) spec + (). + . + Both signed and encrypted JWTs are supported, as well as simple + JWK format keys. + . + The library is currently intended to support work on an OpenID + Connect implementation and the APIs should not be considered + complete, stable or secure for all use cases. + +Author: Luke Taylor +Maintainer: Luke Taylor +License: BSD3 +License-File: LICENSE +Build-Type: Simple +Cabal-Version: >= 1.16 +Category: JSON, Cryptography + +Source-Repository head + Type: git + Location: git://github.com/tekul/jose-jwt.git + +Library + Default-Language: Haskell2010 + Exposed-modules: Jose.Jwt + , Jose.Jws + , Jose.Jwe + , Jose.Jwa + , Jose.Jwk + , Jose.Internal.Base64 + , Jose.Internal.Crypto + Other-Modules: Jose.Types + Build-Depends: base >= 4 && < 5 + , mtl >= 2.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-random >= 0.0.7 + , crypto-numbers >= 0.2 + , cipher-aes >= 0.2.6 + , aeson >= 0.7 + , text >= 0.11 + , unordered-containers >= 0.2 + , base64-bytestring >= 1 + Ghc-Options: -Wall + +Test-suite tests + Default-Language: Haskell2010 + Type: exitcode-stdio-1.0 + Other-Modules: Tests.JwsSpec + , Tests.JweSpec + Build-depends: jose-jwt + , base + , bytestring + , base64-bytestring + , cryptohash + , crypto-pubkey + , crypto-random + , crypto-cipher-types + , cipher-aes + , cprng-aes + , either >= 4.0 + , mtl + , text + , aeson + , hspec >= 1.6 + , HUnit >= 1.2 + , QuickCheck >= 2.4 + Ghc-options: -Wall -rtsopts -fno-warn-missing-signatures + Hs-source-dirs: tests + Main-is: tests.hs + +Benchmark bench-jwt + Default-Language: Haskell2010 + Hs-source-dirs: benchmarks + Main-is: bench.hs + Type: exitcode-stdio-1.0 + Build-depends: jose-jwt + , base + , bytestring + , criterion + , crypto-pubkey + , crypto-random + + Ghc-Options: -Wall -O2 + diff --git a/tests/Tests/JweSpec.hs b/tests/Tests/JweSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/JweSpec.hs @@ -0,0 +1,241 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Tests.JweSpec where + +import Control.Applicative +import Data.Aeson (eitherDecode) +import Data.Bits (xor) +import Data.Either.Combinators +import qualified Data.ByteString as B +import Test.Hspec +import Test.HUnit hiding (Test) +import Test.QuickCheck + +import qualified Crypto.PubKey.RSA as RSA +import Crypto.PubKey.RSA.Prim (dp) +import Crypto.PubKey.MaskGenFunction +import Crypto.PubKey.HashDescr +import Crypto.Cipher.Types (AuthTag(..)) +import Crypto.Random (CPRG(..)) +import Jose.Jwt +import qualified Jose.Jwe as Jwe +import Jose.Jwa +import qualified Jose.Jwk as Jwk +import Jose.Internal.Crypto +import qualified Jose.Internal.Base64 as B64 + +-------------------------------------------------------------------------------- +-- JWE Appendix Data Tests (plus quickcheck) +-------------------------------------------------------------------------------- + +spec :: Spec +spec = + describe "JWE encoding and decoding" $ do + context "when using JWE Appendix 1 data" $ do + let a1Header = defJweHdr {jweAlg = RSA_OAEP, jweEnc = A256GCM} + + it "generates the expected IV and CMK from the RNG" $ do + let g = RNG $ B.append a1cek a1iv + generateCmkAndIV g A256GCM @?= (a1cek, a1iv, RNG "") + + it "generates the expected RSA-encrypted content key" $ do + let g = RNG $ a1oaepSeed + rsaEncrypt g RSA_OAEP a1PubKey a1cek @?= (a1jweKey, RNG "") + + it "encrypts the payload to the expected ciphertext and authentication tag" $ do + let aad = B64.encode . encodeHeader $ a1Header + encryptPayload A256GCM a1cek a1iv aad a1Payload @?= (a1Ciphertext, AuthTag a1Tag) + + 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 "") + + it "decodes the JWT to the expected header and payload" $ do + Jwe.rsaDecode a1PrivKey a1 @?= Right (a1Header, a1Payload) + + it "decodes the JWK to the correct RSA key values" $ do + let Right (Jwk.RsaPrivateJwk (RSA.PrivateKey pubKey d 0 0 0 0 0) _ _ _) = eitherDecode a1jwk + RSA.public_n pubKey @?= a1RsaModulus + RSA.public_e pubKey @?= rsaExponent + d @?= a1RsaPrivateExponent + + 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 + rsaEncrypt g RSA1_5 a2PubKey a2cek @?= (a2jweKey, RNG "") + + it "encrypts the payload to the expected ciphertext and authentication tag" $ do + 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 "") + + it "decrypts the ciphertext to the correct payload" $ do + decryptPayload A128CBC_HS256 a2cek a2iv aad a2Tag a2Ciphertext @?= Right a2Payload + + it "decodes the JWT to the expected header and payload" $ do + Jwe.rsaDecode 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 + it "unpad is the inverse of pad" $ property $ + \bs -> (fromRight' . unpad . pad) bs == bs + 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) + where + encodeDecode = Jwe.rsaDecode a2PrivKey $ fst $ Jwe.rsaEncode g a e a2PubKey msg + +-- A decidedly non-random, random number generator which allows specific +-- sequences of bytes to be supplied which match the JWE test data. +data RNG = RNG B.ByteString deriving (Eq, Show) + +genBytes :: Int -> RNG -> (B.ByteString, RNG) +genBytes 0 g = (B.empty, g) +genBytes n (RNG bs) = (bytes, RNG next) + where + (bytes, next) = if B.null bs + then error "RNG is empty" + else B.splitAt n bs + +instance CPRG RNG where + cprgCreate = undefined + cprgSetReseedThreshold = undefined + cprgGenerate = genBytes + cprgGenerateWithEntropy = undefined + cprgFork = undefined + +-------------------------------------------------------------------------------- +-- JWE Appendix 1 Test Data +-------------------------------------------------------------------------------- + +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." + +a1cek = B.pack [177, 161, 244, 128, 84, 143, 225, 115, 63, 180, 3, 255, 107, 154, 212, 246, 138, 7, 110, 91, 112, 46, 34, 105, 47, 130, 203, 46, 122, 234, 64, 252] + +a1iv = B.pack [227, 197, 117, 252, 2, 219, 233, 68, 180, 225, 77, 219] + +a1aad = B.pack [101, 121, 74, 104, 98, 71, 99, 105, 79, 105, 74, 83, 85, 48, 69, 116, 84, 48, 70, 70, 85, 67, 73, 115, 73, 109, 86, 117, 89, 121, 73, 54, 73, 107, 69, 121, 78, 84, 90, 72, 81, 48, 48, 105, 102, 81] + +a1Ciphertext = B.pack [229, 236, 166, 241, 53, 191, 115, 196, 174, 43, 73, 109, 39, 122, 233, 96, 140, 206, 120, 52, 51, 237, 48, 11, 190, 219, 186, 80, 111, 104, 50, 142, 47, 167, 59, 61, 181, 127, 196, 21, 40, 82, 242, 32, 123, 143, 168, 226, 73, 216, 176, 144, 138, 247, 106, 60, 16, 205, 160, 109, 64, 63, 192] + +a1Tag = B.pack [92, 80, 104, 49, 133, 25, 161, 215, 173, 101, 219, 211, 136, 91, 210, 145] + +Right a1jweKey = B64.decode "OKOawDo13gRp2ojaHV7LFpZcgV7T6DVZKTyKOMTYUmKoTCVJRgckCL9kiMT03JGeipsEdY3mx_etLbbWSrFr05kLzcSr4qKAq7YN7e9jwQRb23nfa6c9d-StnImGyFDbSv04uVuxIp5Zms1gNxKKK2Da14B8S4rzVRltdYwam_lDp5XnZAYpQdb76FdIKLaVmqgfwX7XWRxv2322i-vDxRfqNzo_tETKzpVLzfiwQyeyPGLBIO56YJ7eObdv0je81860ppamavo35UgoRdbYaBcoh9QcfylQr66oc6vFWXRcZ_ZT2LawVCWTIy3brGPi6UklfCpIMfIjf7iGdXKHzg" + +a1jwk = "{\"kty\":\"RSA\", \"n\":\"oahUIoWw0K0usKNuOR6H4wkf4oBUXHTxRvgb48E-BVvxkeDNjbC4he8rUWcJoZmds2h7M70imEVhRU5djINXtqllXI4DFqcI1DgjT9LewND8MW2Krf3Spsk_ZkoFnilakGygTwpZ3uesH-PFABNIUYpOiN15dsQRkgr0vEhxN92i2asbOenSZeyaxziK72UwxrrKoExv6kc5twXTq4h-QChLOln0_mtUZwfsRaMStPs6mS6XrgxnxbWhojf663tuEQueGC-FCMfra36C9knDFGzKsNa7LZK2djYgyD3JR_MB_4NUJW_TqOQtwHYbxevoJArm-L5StowjzGy-_bq6Gw\", \"e\":\"AQAB\", \"d\":\"kLdtIj6GbDks_ApCSTYQtelcNttlKiOyPzMrXHeI-yk1F7-kpDxY4-WY5NWV5KntaEeXS1j82E375xxhWMHXyvjYecPT9fpwR_M9gV8n9Hrh2anTpTD93Dt62ypW3yDsJzBnTnrYu1iwWRgBKrEYY46qAZIrA2xAwnm2X7uGR1hghkqDp0Vqj3kbSCz1XyfCs6_LehBwtxHIyh8Ripy40p24moOAbgxVw3rxT_vlt3UVe4WO3JkJOzlpUf-KTVI2Ptgm-dARxTEtE-id-4OJr0h-K-VFs3VSndVTIznSxfyrj8ILL6MG_Uv8YAu7VILSB3lOW085-4qE3DzgrTjgyQ\" }" + +a1RsaModulus = 20407373051396142380600281265251892119308905183562582378265551916401741797298132714477564366125574073854325621181754666299468042787718090965019045494120492365709229334674806858420600185271825023335981142192553851711447185679749878133484409202142610505370119489349112667599681596271324052456163162582257897587607185901342235063647947816589525124013368466111231306949063172170503467209564034546753006291531308789606255762727496010190006847721118463557533668762287451483156476421856126198680670740028037673487624895510756370816101325723975021588898704953504010419555312457504338174094966173304768490140232017447246019099 + +rsaExponent = 65537 :: Integer + +a1RsaPrivateExponent = 18268766796654718362565236454995853620820821188251417451980738596264305499270399136757621249007756005599271096771478165267306874014871487538744562309757162619646837295513011635819128008143685281506609665247035139326775637222412463191989209202137797209813686014322033219332678022668756745556718137625135245640638710814390273901357613670762406363679831247433360271391936119294533419667412739496199381069233394069901435128732415071218792819358792459421008659625326677236263304891550388749907992141902573512326268421915766834378108391128385175130554819679860804655689526143903449732010240859012168194104458903308465660105 + +a1oaepSeed = extractOaepSeed a1PrivKey a1jweKey + +(a1PubKey, a1PrivKey) = createKeyPair a1RsaModulus a1RsaPrivateExponent + + +-------------------------------------------------------------------------------- +-- JWE Appendix 2 Test Data +-------------------------------------------------------------------------------- + +a2Payload = "Live long and prosper." + +a2cek = B.pack [4, 211, 31, 197, 84, 157, 252, 254, 11, 100, 157, 250, 63, 170, 106, 206, 107, 124, 212, 45, 111, 107, 9, 219, 200, 177, 0, 240, 143, 156, 44, 207] + +--a2cek = B.pack [203, 165, 180, 113, 62, 195, 22, 98, 91, 153, 210, 38, 112, 35, 230, 236] + +--a2cik = B.pack [218, 24, 160, 17, 160, 50, 235, 35, 216, 209, 100, 174, 155, 163, 10, 117, 180, 111, 172, 200, 127, 201, 206, 173, 40, 45, 58, 170, 35, 93, 9, 60] + +a2iv = B.pack [3, 22, 60, 12, 43, 67, 104, 105, 108, 108, 105, 99, 111, 116, 104, 101] + +a2Ciphertext = B.pack [40, 57, 83, 181, 119, 33, 133, 148, 198, 185, 243, 24, 152, 230, 6, 75, 129, 223, 127, 19, 210, 82, 183, 230, 168, 33, 215, 104, 143, 112, 56, 102] + +a2Tag = B.pack [246, 17, 244, 190, 4, 95, 98, 3, 231, 0, 115, 157, 242, 203, 100, 191] + +Right a2jweKey = B64.decode "UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A" + + +a2RsaModulus = 22402924734748322419583087865046136971812964522608965289668050862528140628890468829261358173206844190609885548664216273129288787509446229835492005268681636400878070687042995563617837593077316848511917526886594334868053765054121327206058496913599608196082088434862911200952954663261204130886151917541465131565772711448256433529200865576041706962504490609565420543616528240562874975930318078653328569211055310553145904641192292907110395318778917935975962359665382660933281263049927785938817901532807037136641587608303638483543899849101763615990006657357057710971983052920787558713523025279998057051825799400286243909447 + +a2RsaPrivateExponent = 10643756465292254988457796463889735064030094089452909840615134957452106668931481879498770304395097541282329162591478128330968231330113176654221501869950411410564116254672288216799191435916328405513154035654178369543717138143188973636496077305930253145572851787483810154020967535132278148578697716656066036003388130625459567907864689911133288140117207430454310073863484450086676106606775792171446149215594844607410066899028283290532626577379520547350399030663657813726123700613989625283009134539244470878688076926304079342487789922656366430636978871435674556143884272163840709196449089335092169596187792960067104244313 + +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 + +a2seed = extractPKCS15Seed a2PrivKey a2jweKey + + +-------------------------------------------------------------------------------- +-- Quickcheck Stuff +-------------------------------------------------------------------------------- + +-- 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] + +instance Arbitrary JWEAlgs where + arbitrary = do + a <- elements [RSA1_5, RSA_OAEP] + e <- elements [A128CBC_HS256, A256CBC_HS512, A128GCM, A256GCM] + return $ JWEAlgs a e + +instance Arbitrary RNG where + arbitrary = (RNG . B.pack) <$> vector 600 + + + +-------------------------------------------------------------------------------- +-- Utility Functions +-------------------------------------------------------------------------------- + +createKeyPair n d = (pubKey, privKey) + where + privKey = RSA.PrivateKey + { RSA.private_pub = pubKey + , RSA.private_d = d + , RSA.private_q = 0 + , RSA.private_p = 0 + , RSA.private_dP = 0 + , RSA.private_dQ = 0 + , RSA.private_qinv = 0 + } + pubKey = RSA.PublicKey + { RSA.public_size = 256 + , RSA.public_n = n + , RSA.public_e = rsaExponent + } + + -- Extracts the random padding bytes from the decrypted content key + -- allowing them to be used in the test RNG +extractOaepSeed :: RSA.PrivateKey -> B.ByteString -> B.ByteString +extractOaepSeed key ct = B.pack $ B.zipWith xor maskedSeed seedMask + where + em = dp Nothing key ct + sha1 = hashFunction hashDescrSHA1 + hashLen = B.length $ sha1 B.empty + em0 = B.tail em + (maskedSeed, maskedDB) = B.splitAt hashLen em0 + seedMask = mgf1 sha1 maskedDB hashLen + + -- Decrypt, drop the 02 at the start and take the bytes up to the next 0 +extractPKCS15Seed :: RSA.PrivateKey -> B.ByteString -> B.ByteString +extractPKCS15Seed key ct = B.takeWhile (/= 0) . B.drop 2 $ dp Nothing key ct + diff --git a/tests/Tests/JwsSpec.hs b/tests/Tests/JwsSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tests/JwsSpec.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Tests.JwsSpec where + +import Test.Hspec +import Test.HUnit hiding (Test) + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 () +import qualified Crypto.Hash.SHA256 as SHA256 +import Crypto.MAC.HMAC (hmac) +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as RSAPKCS15 +import Crypto.PubKey.HashDescr + +import Jose.Jwt +import Jose.Jwa +import qualified Jose.Internal.Base64 as B64 +import qualified Jose.Jws as Jws + +{-- Examples from the JWS appendix A --} + +spec :: Spec +spec = + describe "JWS encoding and decoding" $ do + context "when using JWS Appendix A.1 data" $ do + it "decodes the JWT to the expected header and payload" $ + Jws.hmacDecode hmacKey a11 @?= Right (defJwsHdr {jwsAlg = HS256, jwsTyp = Just "JWT"}, a11Payload) + + it "encodes the payload to the expected JWT" $ + encode a11mac a11Header a11Payload @?= a11 + + context "when using JWS Appendix A.2 data" $ do + it "decodes the JWT to the expected header and payload" $ + Jws.rsaDecode rsaPublicKey a21 @?= Right (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 + + it "encodes/decodes using RS256" $ + rsaRoundTrip RS256 a21Payload + + it "encodes/decodes using RS384" $ + rsaRoundTrip RS384 a21Payload + + it "encodes/decodes using RS512" $ + rsaRoundTrip RS512 a21Payload + +encode sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload] + where + hdrPayload = B.intercalate "." $ map B64.encode [hdr, payload] + +rsaRoundTrip a msg = Jws.rsaDecode rsaPublicKey (Jws.rsaEncode a rsaPrivateKey msg) @?= Right (defJwsHdr {jwsAlg = a}, msg) + +a11Header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" :: B.ByteString +a11Payload = "{\"iss\":\"joe\",\r\n \"exp\":1300819380,\r\n \"http://example.com/is_root\":true}" +a11 = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk" + +a21Header = "{\"alg\":\"RS256\"}" :: B.ByteString +a21Payload = a11Payload +a21 = "eyJhbGciOiJSUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.cC4hiUPoj9Eetdgtv3hF80EGrhuB__dzERat0XF9g2VtQgr9PJbu3XOiZj5RZmh7AAuHIm4Bh-0Qc_lF5YKt_O8W2Fp5jujGbds9uJdbF9CUAr7t1dnZcAcQjbKBYNX4BAynRFdiuB--f_nZLgrnbyTyWzO75vRK5h6xBArLIARNPvkSjtQBMHlb1L07Qe7K0GarZRmB_eSN9383LcOLn6_dO--xi12jzDwusC-eOkHWEsqtFZESc6BfI7noOPqvhJ1phCnvWh6IeYI2w9QOYEUipUTI8np6LbgGY9Fs98rqVt5AXLIhWkWywlVmtVrBp0igcN_IoypGlUPQGe77Rw" + +hmacKey = 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] + +-- N +rsaModulus :: Integer +rsaModulus = 20446702916744654562596343388758805860065209639960173505037453331270270518732245089773723012043203236097095623402044690115755377345254696448759605707788965848889501746836211206270643833663949992536246985362693736387185145424787922241585721992924045675229348655595626434390043002821512765630397723028023792577935108185822753692574221566930937805031155820097146819964920270008811327036286786392793593121762425048860211859763441770446703722015857250621107855398693133264081150697423188751482418465308470313958250757758547155699749157985955379381294962058862159085915015369381046959790476428631998204940879604226680285601 + + +rsaExponent = 65537 :: Integer + +-- D +rsaPrivateExponent :: Integer +rsaPrivateExponent = 2358310989939619510179986262349936882924652023566213765118606431955566700506538911356936879137503597382515919515633242482643314423192704128296593672966061810149316320617894021822784026407461403384065351821972350784300967610143459484324068427674639688405917977442472804943075439192026107319532117557545079086537982987982522396626690057355718157403493216553255260857777965627529169195827622139772389760130571754834678679842181142252489617665030109445573978012707793010592737640499220015083392425914877847840457278246402760955883376999951199827706285383471150643561410605789710883438795588594095047409018233862167884701 + +rsaPrivateKey = RSA.PrivateKey + { RSA.private_pub = rsaPublicKey + , RSA.private_d = rsaPrivateExponent + , RSA.private_q = 0 + , RSA.private_p = 0 + , RSA.private_dP = 0 + , RSA.private_dQ = 0 + , RSA.private_qinv = 0 + } + +rsaPublicKey = RSA.PublicKey + { RSA.public_size = 256 + , RSA.public_n = rsaModulus + , RSA.public_e = rsaExponent + } + +a11mac = hmac SHA256.hash 64 hmacKey + diff --git a/tests/tests.hs b/tests/tests.hs new file mode 100644 --- /dev/null +++ b/tests/tests.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +