jose-jwt (empty) → 0.1
raw patch · 15 files changed
+1427/−0 lines, 15 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HUnit, QuickCheck, aeson, base, base64-bytestring, byteable, bytestring, cereal, cipher-aes, containers, cprng-aes, criterion, crypto-cipher-types, crypto-numbers, crypto-pubkey, crypto-random, cryptohash, either, hspec, jose-jwt, mtl, text, unordered-containers
Files
- Jose/Internal/Base64.hs +32/−0
- Jose/Internal/Crypto.hs +218/−0
- Jose/Jwa.hs +82/−0
- Jose/Jwe.hs +67/−0
- Jose/Jwk.hs +268/−0
- Jose/Jws.hs +85/−0
- Jose/Jwt.hs +62/−0
- Jose/Types.hs +117/−0
- LICENSE +29/−0
- Setup.hs +4/−0
- benchmarks/bench.hs +22/−0
- jose-jwt.cabal +98/−0
- tests/Tests/JweSpec.hs +241/−0
- tests/Tests/JwsSpec.hs +100/−0
- tests/tests.hs +2/−0
+ Jose/Internal/Base64.hs view
@@ -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+
+ Jose/Internal/Crypto.hs view
@@ -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+
+ Jose/Jwa.hs view
@@ -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+-- <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)++-- | 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)++-- 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>.+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+
+ Jose/Jwe.hs view
@@ -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+
+ Jose/Jwk.hs view
@@ -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+
+ Jose/Jws.hs view
@@ -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)+
+ Jose/Jwt.hs view
@@ -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
+ Jose/Types.hs view
@@ -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
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ benchmarks/bench.hs view
@@ -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+ ]+ ]
+ jose-jwt.cabal view
@@ -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+ (<http://tools.ietf.org/html/draft-ietf-oauth-json-web-token-25/>).+ .+ 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 <tekul.hs@gmail.com>+Maintainer: Luke Taylor <tekul.hs@gmail.com>+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+
+ tests/Tests/JweSpec.hs view
@@ -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+
+ tests/Tests/JwsSpec.hs view
@@ -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+
+ tests/tests.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+