jose-jwt-botan (empty) → 0.12.0
raw patch · 23 files changed
+3343/−0 lines, 23 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HUnit, QuickCheck, aeson, attoparsec, base, botan-low, bytestring, cereal, criterion, crypton, deepseq, doctest, hspec, jose, jose-jwt-botan, lens, mtl, optparse-applicative, ram, text, time, transformers, vector
Files
- CHANGELOG.md +164/−0
- Jose/Internal/Base64.hs +25/−0
- Jose/Internal/Crypto.hs +468/−0
- Jose/Internal/Parser.hs +141/−0
- Jose/Jwa.hs +78/−0
- Jose/Jwe.hs +170/−0
- Jose/Jwk.hs +538/−0
- Jose/Jws.hs +197/−0
- Jose/Jwt.hs +159/−0
- Jose/Types.hs +222/−0
- LICENSE +30/−0
- README.md +68/−0
- Setup.hs +4/−0
- benchmarks/Keys.hs +23/−0
- benchmarks/bench.hs +84/−0
- benchmarks/loadtest-jwt/Main.hs +98/−0
- doctests.hs +2/−0
- jose-jwt-botan.cabal +127/−0
- tests/Tests/JweSpec.hs +335/−0
- tests/Tests/JwkSpec.hs +137/−0
- tests/Tests/JwsSpec.hs +243/−0
- tests/jwks.json +17/−0
- tests/tests.hs +13/−0
+ CHANGELOG.md view
@@ -0,0 +1,164 @@+0.12.0+------++* Use botan for es256 verification, this makes the verification ~x9 faster and reduces time by ~89% by @steve-chavez in #1.+* Fix JWS key selection not stopping at first success by @steve-chavez in #2++0.11.0+------++* Update `crypton` version to >= 1.1.0 and replace the `memory` package with the `ram` package to match `crypton` changes.++0.10.0+------++* Change to using crypton (see #41).++0.9.6+-----++* Updated aeson package bound to include 2.2++0.9.5+-----++* Support for mtl 2.3++0.9.4+-----++* Support for aeson 2++0.9.3+-----++* Add upper bound < 1.6 for aeson dependency+* Add Num Instance for IntDate++0.9.2+-----++* Add `UnsupportedJwt` constructor to `Jwk` type which wraps the JSON value. This prevents failure loading keys which have `alg` or `kty` values which we don't support (see #31).++0.9.1+-----++* Fix for tests broken due to [different aeson key ordering](https://github.com/commercialhaskell/stackage/issues/5878).++0.9.0+-----++* Support for EdDSA signing algorithms as defined in [RFC 8037](https://tools.ietf.org/html/rfc8037).++0.8.0+-----++* The result of the `Jose.Jwt.decodeClaims` function is now polymorphic so it can be used with any `FromJSON` type.+* Only ghc 8 upwards are now supported.+* the RSA-OAEP-256 algorithm is now supported.++0.7.8+-----++* Switch from EitherT to ExceptT to allow compiling with latest version of 'either' package.++0.7.7+-----++* User ByteArray and ScrubbedBytes from memory package in preference to ByteString in internal crypto code.++0.7.6+-----++* Fixed exception when JWT contained invalid Base64 (issue #15).+* Add generateSymmetricKey utility function to Jwk module.++0.7.5+-----++* A JWT parser is now used to separate parsing and decoding into separate stages (internal change).++0.7.4+-----++* Stricter checking of AES key lengths when looking for a valid JWK to encode/decode an AES-KW JWT.++0.7.3+-----++* Add JSON test data to extra-source-files.++0.7.2+-----++* Remove test dependency on aeson-qq++0.7.1+-----++* Update cryptonite version to 0.19 to avoid security issues+* Fix broken benchmark code+* Better error message for invalid key length when using AES keywrap++0.7+---++* Add support for AES key wrap in JWEs.+* Support A192GCM and A192CBC-HS384 algorithms.+* Switch to cryptonite library.++0.6.2+-----++* Remove dependency on `errors` package.++0.6.1+-----++* Minor internal changes to fix build on GHC 7.10.++0.6+---++* Change KeyId type to allow use of a UTCTime string for the identifier.+* Internal crypto fixes to prevent exceptions from external libraries.++0.5+---++* Add JwtEncoding type. Changes API of `Jwt.encode` and `Jwt.decode`.++0.4.2+-----++* Fix in the code for finding suitable JWKs for encoding/decoding.++0.4.1.1+-------++* Added `doctest` flag to cabal file to allow doctests to be disabled.++0.4.1+-----++* Add cprng-aes dependency to doctests to stop test failure on travis and nixos hydra builds.++0.4+---++* Changed use of `Jwt` type to represent an encoded JWT.+* Introduced `Payload` type to allow setting the `cty` header value correctly for nested JWTs.+* Added an explicit `Unsecured` type for a decoded JWT, to make it obvious when the content is not signed or encrypted.+* Fixed some bugs in JSON encoding and decoding of EC JWKs.++0.3.1+-----++Changed the signature of `Jwt.encode` to take a list of `Jwk` rather than a single key. The key will be selected from+the list based on the specified algorithms.++0.3+---++* New support for JWS validation using elliptic curve algorithms.+* Added `Jwt.encode` function which takes a JWK argument, allowing key data (currently the key ID) to be encoded in the token header.
+ Jose/Internal/Base64.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts, CPP #-}+{-# OPTIONS_HADDOCK hide #-}++-- | JWT-style base64 encoding and decoding++module Jose.Internal.Base64 where++#if MIN_VERSION_mtl(2,2,1)+import Control.Monad.Except+#else+import Control.Monad.Error+#endif++import Data.ByteArray+import Data.ByteArray.Encoding++import Jose.Types++-- | Base64 URL encode without padding.+encode :: (ByteArrayAccess input, ByteArray output) => input -> output+encode = convertToBase Base64URLUnpadded++-- | Base64 decode.+decode :: (ByteArrayAccess input, ByteArray output, MonadError JwtError m) => input -> m output+decode bs = either (throwError . Base64Error) return $ convertFromBase Base64URLUnpadded bs
+ Jose/Internal/Crypto.hs view
@@ -0,0 +1,468 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK prune #-}++-- | Internal functions for encrypting and signing / decrypting+-- and verifying JWT content.++module Jose.Internal.Crypto+ ( hmacSign+ , hmacVerify+ , ed25519Verify+ , ed448Verify+ , rsaSign+ , rsaVerify+ , rsaEncrypt+ , rsaDecrypt+ , ecVerify+ , encryptPayload+ , decryptPayload+ , generateCmkAndIV+ , keyWrap+ , keyUnwrap+ , pad+ , unpad+ )+where+++import qualified Botan.Low.Error as Botan+import qualified Botan.Low.MPI as Botan+import qualified Botan.Low.PubKey as Botan+import qualified Botan.Low.PubKey.ECDSA as Botan+import qualified Botan.Low.PubKey.Sign as Botan+import qualified Botan.Low.PubKey.Verify as Botan+import Control.Exception (bracket, catch, displayException)+import Control.Monad (when, unless)+import Crypto.Error+import Crypto.Cipher.AES+import Crypto.Cipher.Types hiding (IV)+import Crypto.Hash.Algorithms+import Crypto.Number.Serialize (i2osp, os2ip)+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Types as ECC+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+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 (MonadRandom, getRandomBytes)+import Crypto.MAC.HMAC (HMAC (..), hmac)+import Data.Bits (xor)+import Data.Bifunctor (first)+import Data.ByteArray (ByteArray, ScrubbedBytes)+import qualified Data.ByteArray as BA+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.Serialize as Serialize+import qualified Data.Text as T+import Data.Word (Word64, Word8)+import System.IO.Unsafe (unsafePerformIO)++import Jose.Jwa+import Jose.Types (JwtError(..))+import Jose.Internal.Parser (IV(..), Tag(..))++rightToMaybe :: Either a b -> Maybe b+rightToMaybe (Right x) = Just x+rightToMaybe Left{} = Nothing++-- | Sign a message with an HMAC key.+hmacSign :: JwsAlg -- ^ HMAC algorithm to use+ -> ByteString -- ^ Key+ -> ByteString -- ^ The message/content+ -> Either JwtError ByteString -- ^ HMAC output+hmacSign a k m = case a of+ HS256 -> Right $ BA.convert (hmac k m :: HMAC SHA256)+ HS384 -> Right $ BA.convert (hmac k m :: HMAC SHA384)+ HS512 -> Right $ BA.convert (hmac k m :: HMAC SHA512)+ _ -> Left $ BadAlgorithm $ T.pack $ "Not an HMAC algorithm: " ++ show a++-- | 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 = either (const False) (`BA.constEq` sig) $ hmacSign a key msg+++-- | Verify an Ed25519 signed message+ed25519Verify :: JwsAlg+ -> Ed25519.PublicKey+ -> ByteString+ -- ^ The message/content+ -> ByteString+ -- ^ The signature to check+ -> Bool+ -- ^ Whether the signature is correct+ed25519Verify EdDSA pubKey msg sig =+ case Ed25519.signature sig of+ CryptoPassed sig_ ->+ Ed25519.verify pubKey msg sig_+ _ -> False+ed25519Verify _ _ _ _ = False+++-- | Verify an Ed448 signed message+ed448Verify :: JwsAlg+ -> Ed448.PublicKey+ -> ByteString+ -- ^ The message/content+ -> ByteString+ -- ^ The signature to check+ -> Bool+ -- ^ Whether the signature is correct+ed448Verify EdDSA pubKey msg sig =+ case Ed448.signature sig of+ CryptoPassed sig_ ->+ Ed448.verify pubKey msg sig_+ _ -> False+ed448Verify _ _ _ _ = False+++-- | Sign a message using an RSA private key.+--+-- The failure condition should only occur if the algorithm is not an RSA+-- algorithm, or the RSA key is too small, causing the padding of the+-- signature to fail. With real-world RSA keys this shouldn't happen in practice.+rsaSign :: Maybe RSA.Blinder -- ^ RSA blinder+ -> JwsAlg -- ^ Algorithm to use. Must be one of @RSA256@, @RSA384@ or @RSA512@+ -> RSA.PrivateKey -- ^ Private key to sign with+ -> ByteString -- ^ Message to sign+ -> Either JwtError ByteString -- ^ The signature+rsaSign blinder a key msg = case a of+ RS256 -> go SHA256+ RS384 -> go SHA384+ RS512 -> go SHA512+ _ -> Left . BadAlgorithm . T.pack $ "Not an RSA algorithm: " ++ show a+ where+ go h = either (const $ Left BadCrypto) Right $ PKCS15.sign blinder (Just h) key msg++-- | 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 a of+ RS256 -> go SHA256+ RS384 -> go SHA384+ RS512 -> go SHA512+ _ -> False+ where+ go h = PKCS15.verify (Just h) key msg sig++-- | Verify the signature for a message using an EC public key.+--+-- Returns false if the check fails or if the 'Alg' value is not+-- an EC signature algorithm.+ecVerify :: JwsAlg -- ^ The signature algorithm. Used to obtain the hash function.+ -> ECDSA.PublicKey -- ^ The key to check the signature with+ -> ByteString -- ^ The message/content+ -> ByteString -- ^ The signature to check+ -> Either JwtError Bool -- ^ Whether the signature is correct+ecVerify a key msg sig = case a of+ ES256 -> case ECDSA.public_q key of+ ECC.Point x y -> unsafePerformIO $+ -- Here we catch the BotanException and raise it to a Left, text-icu does something similar+ -- https://github.com/haskell/text-icu/blob/413cc4bcceed473bd10a2e854ddb0f41e56c5cc9/Data/Text/ICU/Regex/Pure.hs#L116-L119+ (Right <$> verifyES256 (i2osp x) (i2osp y) msg sig) `catch`+ \(err :: Botan.SomeBotanException) -> return (Left (BotanError (T.pack (displayException err))))+ ECC.PointO -> Right False+ ES384 -> go SHA384+ ES512 -> go SHA512+ _ -> Right False+ where+ (r, s) = B.splitAt (B.length sig `div` 2) sig+ ecSig = ECDSA.Signature (os2ip r) (os2ip s)+ go h = Right (ECDSA.verify h key ecSig msg)+-- Use NOINLINE to prevent the action execution more than once as recommended by GHC docs+-- https://downloads.haskell.org/ghc/latest/docs/libraries/base-4.22.0.0-66f8/GHC-IO-Unsafe.html#v:unsafePerformIO+{-# NOINLINE ecVerify #-}++-- ES256 is really just a convention to combine the P-256 curve, the SHA-256 hash and the R || S signature+verifyES256 :: ByteString -> ByteString -> ByteString -> ByteString -> IO Bool+verifyES256 xBytes yBytes message signature =+ -- brackets are used to ensure the allocated objects from botan are released+ bracket Botan.mpInit Botan.mpDestroy $ \x ->+ bracket Botan.mpInit Botan.mpDestroy $ \y -> do+ -- Awkard interface as mentioned in the API docs but this sets x and y+ Botan.mpFromBin x xBytes+ Botan.mpFromBin y yBytes+ let p256curve = "secp256r1"+ -- Botan throws an exception on invalid keys, see BOTAN_FFI_ERROR_BAD_PARAMETER on+ -- https://github.com/randombit/botan/blob/3.12.0/src/lib/ffi/ffi_pkey_algs.cpp#L120-L140 which is mapped to BadParameterException.+ -- Here we catch the exception as a normal verification failure, this so the upper level `decode` function+ -- doesn't abort when trying the verification with another key.+ loadKey = (Just <$> Botan.pubKeyLoadECDSA x y p256curve) `catch` \(_ :: Botan.BadParameterException) -> pure Nothing+ bracket loadKey (mapM_ Botan.pubKeyDestroy) $ \loaded -> case loaded of+ Nothing -> pure False+ Just pubKey ->+ -- StandardFormatSignature is R || S+ bracket (Botan.verifyCreate pubKey "SHA-256" Botan.StandardFormatSignature) Botan.verifyDestroy $ \ctx -> do+ Botan.verifyUpdate ctx message+ Botan.verifyFinish ctx signature++-- | Generates the symmetric key (content management key) and IV+--+-- Used to encrypt a message.+generateCmkAndIV :: MonadRandom m+ => Enc+ -- ^ The encryption algorithm to be used+ -> m (ScrubbedBytes, ScrubbedBytes)+ -- ^ The key, IV+generateCmkAndIV e = do+ cmk <- getRandomBytes (keySize e)+ iv <- getRandomBytes (ivSize e) -- iv for aes gcm or cbc+ return (cmk, iv)+ where+ keySize A128GCM = 16+ keySize A192GCM = 24+ keySize A256GCM = 32+ keySize A128CBC_HS256 = 32+ keySize A192CBC_HS384 = 48+ keySize A256CBC_HS512 = 64++ ivSize A128GCM = 12+ ivSize A192GCM = 12+ ivSize A256GCM = 12+ ivSize _ = 16++-- | Encrypts a message (typically a symmetric key) using RSA.+rsaEncrypt :: (MonadRandom m, ByteArray msg, ByteArray out)+ => RSA.PublicKey+ -- ^ The encryption key+ -> JweAlg+ -- ^ The algorithm (@RSA1_5@, @RSA_OAEP@, or @RSA_OAEP_256@)+ -> msg+ -- ^ The message to encrypt+ -> m (Either JwtError out)+ -- ^ The encrypted message+rsaEncrypt k a msg = fmap BA.convert <$> case a of+ RSA1_5 -> mapErr (PKCS15.encrypt k bs)+ RSA_OAEP -> mapErr (OAEP.encrypt (OAEP.defaultOAEPParams SHA1) k bs)+ RSA_OAEP_256 -> mapErr (OAEP.encrypt (OAEP.defaultOAEPParams SHA256) k bs)+ _ -> return (Left (BadAlgorithm "Not an RSA algorithm"))+ where+ bs = BA.convert msg+ mapErr = fmap (first (const BadCrypto))++-- | Decrypts an RSA encrypted message.+rsaDecrypt :: ByteArray ct+ => Maybe RSA.Blinder+ -> RSA.PrivateKey+ -- ^ The decryption key+ -> JweAlg+ -- ^ The RSA algorithm to use+ -> ct+ -- ^ The encrypted content+ -> Either JwtError ScrubbedBytes+ -- ^ The decrypted key+rsaDecrypt blinder rsaKey a ct = BA.convert <$> case a of+ RSA1_5 -> mapErr (PKCS15.decrypt blinder rsaKey bs)+ RSA_OAEP -> mapErr (OAEP.decrypt blinder (OAEP.defaultOAEPParams SHA1) rsaKey bs)+ RSA_OAEP_256 -> mapErr (OAEP.decrypt blinder (OAEP.defaultOAEPParams SHA256) rsaKey bs)+ _ -> Left (BadAlgorithm "Not an RSA algorithm")+ where+ bs = BA.convert ct+ mapErr = first (const BadCrypto)++-- Dummy type to constrain Cipher type+data C c = C++initCipher :: BlockCipher c => C c -> ScrubbedBytes -> Either JwtError c+initCipher _ k = mapFail (cipherInit k)++-- Map CryptoFailable to JwtError+mapFail :: CryptoFailable a -> Either JwtError a+mapFail (CryptoPassed a) = return a+mapFail (CryptoFailed e) = Left $ case e of+ CryptoError_KeySizeInvalid -> KeyError "cipher key length is invalid"+ _ -> BadCrypto+++-- | Decrypt an AES encrypted message.+decryptPayload :: forall ba. (ByteArray ba)+ => Enc+ -- ^ Encryption algorithm+ -> ScrubbedBytes+ -- ^ Content encryption key+ -> IV+ -- ^ IV+ -> ba+ -- ^ Additional authentication data+ -> Tag+ -- ^ The integrity protection value to be checked+ -> ba+ -- ^ The encrypted JWT payload+ -> Maybe ba+decryptPayload enc cek iv_ aad tag_ ct = case (enc, iv_, tag_) of+ (A128GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES128) b t+ (A192GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES192) b t+ (A256GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES256) b t+ (A128CBC_HS256, IV16 b, Tag16 t) -> doCBC (C :: C AES128) b t SHA256 16+ (A192CBC_HS384, IV16 b, Tag24 t) -> doCBC (C :: C AES192) b t SHA384 24+ (A256CBC_HS512, IV16 b, Tag32 t) -> doCBC (C :: C AES256) b t SHA512 32+ _ -> Nothing -- This shouldn't be possible if the JWT was parsed first+ where+ (cbcMacKey, cbcEncKey) = BA.splitAt (BA.length cek `div` 2) cek :: (ScrubbedBytes, ScrubbedBytes)+ al = fromIntegral (BA.length aad) * 8 :: Word64++ doGCM :: BlockCipher c => C c -> ByteString -> ByteString -> Maybe ba+ doGCM c iv tag = do+ cipher <- rightToMaybe (initCipher c cek)+ aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv)+ aeadSimpleDecrypt aead aad ct (AuthTag $ BA.convert tag)++ doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> ByteString -> ByteString -> a -> Int -> Maybe ba+ doCBC c iv tag a tagLen = do+ checkMac a tag iv tagLen+ cipher <- rightToMaybe (initCipher c cbcEncKey)+ iv' <- makeIV iv+ unless (BA.length ct `mod` blockSize cipher == 0) Nothing+ unpad $ cbcDecrypt cipher iv' ct++ checkMac :: HashAlgorithm a => a -> ByteString -> ByteString -> Int -> Maybe ()+ checkMac a tag iv l = do+ let mac = BA.take l $ BA.convert $ doMac a iv :: BA.Bytes+ unless (tag `BA.constEq` mac) Nothing++ doMac :: HashAlgorithm a => a -> ByteString -> HMAC a+ doMac _ iv = hmac cbcMacKey (BA.concat [BA.convert aad, iv, BA.convert ct, Serialize.encode al] :: ByteString)++-- | Encrypt a message using AES.+encryptPayload :: forall ba iv. (ByteArray ba, ByteArray iv)+ => Enc+ -- ^ Encryption algorithm+ -> ScrubbedBytes+ -- ^ Content management key+ -> iv+ -- ^ IV+ -> ba+ -- ^ Additional authenticated data+ -> ba+ -- ^ The message/JWT claims+ -> Maybe (AuthTag, ba)+ -- ^ Ciphertext claims and signature tag+encryptPayload e cek iv aad msg = case e of+ A128GCM -> doGCM (C :: C AES128)+ A192GCM -> doGCM (C :: C AES192)+ A256GCM -> doGCM (C :: C AES256)+ A128CBC_HS256 -> doCBC (C :: C AES128) SHA256 16+ A192CBC_HS384 -> doCBC (C :: C AES192) SHA384 24+ A256CBC_HS512 -> doCBC (C :: C AES256) SHA512 32+ where+ (cbcMacKey, cbcEncKey) = BA.splitAt (BA.length cek `div` 2) cek :: (ScrubbedBytes, ScrubbedBytes)+ al = fromIntegral (BA.length aad) * 8 :: Word64++ doGCM c = do+ cipher <- rightToMaybe (initCipher c cek)+ aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv)+ return $ aeadSimpleEncrypt aead aad msg 16++ doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> a -> Int -> Maybe (AuthTag, ba)+ doCBC c a tagLen = do+ cipher <- rightToMaybe (initCipher c cbcEncKey)+ iv' <- makeIV iv+ let ct = cbcEncrypt cipher iv' (pad msg)+ mac = doMac a ct+ tag = BA.take tagLen (BA.convert mac)+ return (AuthTag tag, ct)++ doMac :: HashAlgorithm a => a -> ba -> HMAC a+ doMac _ ct = hmac cbcMacKey (BA.concat [BA.convert aad, BA.convert iv, BA.convert ct, Serialize.encode al] :: ByteString)++unpad :: (ByteArray ba) => ba -> Maybe ba+unpad bs+ | padLen > 16 || padLen /= BA.length padding = Nothing+ | BA.any (/= padByte) padding = Nothing+ | otherwise = return pt+ where+ len = BA.length bs+ padByte = BA.index bs (len-1)+ padLen = fromIntegral padByte+ (pt, padding) = BA.splitAt (len - padLen) bs++pad :: (ByteArray ba) => ba -> ba+pad bs = BA.append bs padding+ where+ lastBlockSize = BA.length bs `mod` 16+ padByte = fromIntegral $ 16 - lastBlockSize :: Word8+ padding = BA.replicate (fromIntegral padByte) padByte+++-- Key wrapping and unwrapping functions++-- | <https://tools.ietf.org/html/rfc3394#section-2.2.1>+keyWrap :: ByteArray ba => JweAlg -> ScrubbedBytes -> ScrubbedBytes -> Either JwtError ba+keyWrap alg kek cek = case alg of+ A128KW -> doKeyWrap (C :: C AES128)+ A192KW -> doKeyWrap (C :: C AES192)+ A256KW -> doKeyWrap (C :: C AES256)+ _ -> Left (BadAlgorithm "Not a keywrap algorithm")+ where+ l = BA.length cek+ n = l `div` 8+ iv = BA.replicate 8 166 :: ByteString++ doKeyWrap c = do+ when (l < 16 || l `mod` 8 /= 0) (Left (KeyError "Invalid content key"))+ cipher <- initCipher c kek+ let p = toBlocks cek+ (r0, r) = foldl (doRound (ecbEncrypt cipher) 1) (BA.convert iv, p) [0..5]+ Right $ BA.concat (r0 : r)++ doRound _ _ (a, []) _ = (a, [])+ doRound enc i (a, r:rs) j =+ let b = enc $ BA.concat [a, r]+ t = fromIntegral ((n*j) + i) :: Word8+ a' = txor t (BA.take 8 b)+ r' = BA.drop 8 b+ next = doRound enc (i+1) (a', rs) j+ in (fst next, r' : snd next)++txor :: ByteArray ba => Word8 -> ba -> ba+txor t b =+ let n = BA.length b+ lastByte = BA.index b (n-1)+ initBytes = BA.take (n-1) b+ in BA.snoc initBytes (lastByte `xor` t)++toBlocks :: ByteArray ba => ba -> [ba]+toBlocks bytes+ | BA.null bytes = []+ | otherwise = let (b, bs') = BA.splitAt 8 bytes+ in b : toBlocks bs'++keyUnwrap :: ByteArray ba => ScrubbedBytes -> JweAlg -> ba -> Either JwtError ScrubbedBytes+keyUnwrap kek alg encK = case alg of+ A128KW -> doUnWrap (C :: C AES128)+ A192KW -> doUnWrap (C :: C AES192)+ A256KW -> doUnWrap (C :: C AES256)+ _ -> Left (BadAlgorithm "Not a keywrap algorithm")+ where+ l = BA.length encK+ n = (l `div` 8) - 1+ iv = BA.replicate 8 166++ doUnWrap c = do+ when (l < 24 || l `mod` 8 /= 0) (Left BadCrypto)+ cipher <- initCipher c kek+ let r = toBlocks encK+ (p0, p) = foldl (doRound (ecbDecrypt cipher) n) (head r, reverse (tail r)) (reverse [0..5])+ unless (p0 == iv) (Left BadCrypto)+ Right $ BA.concat (reverse p)++ doRound _ _ (a, []) _ = (a, [])+ doRound dec i (a, r:rs) j =+ let b = dec $ BA.concat [txor t a, r]+ t = fromIntegral ((n*j) + i) :: Word8+ a' = BA.take 8 b+ r' = BA.drop 8 b+ next = doRound dec (i-1) (a', rs) j+ in (fst next, r' : snd next)
+ Jose/Internal/Parser.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune #-}++-- | Parses encoded JWTs into data structures which can be handled++module Jose.Internal.Parser+ ( parseJwt+ , DecodableJwt (..)+ , EncryptedCEK (..)+ , Payload (..)+ , IV (..)+ , Tag (..)+ , AAD (..)+ , Sig (..)+ , SigTarget (..)+ )+where++import Data.Bifunctor (first)+import Data.Aeson (eitherDecodeStrict')+import Data.Attoparsec.ByteString (Parser)+import qualified Data.Attoparsec.ByteString as P+import qualified Data.Attoparsec.ByteString.Char8 as PC+import Data.ByteArray.Encoding (convertFromBase, Base(..))+import Data.ByteString (ByteString)+import qualified Data.ByteString as B++import Jose.Jwa+import Jose.Types (JwtError(..), JwtHeader(..), JwsHeader(..), JweHeader(..))+++data DecodableJwt+ = Unsecured ByteString+ | DecodableJws JwsHeader Payload Sig SigTarget+ | DecodableJwe JweHeader EncryptedCEK IV Payload Tag AAD+++data Tag+ = Tag16 ByteString+ | Tag24 ByteString+ | Tag32 ByteString+++data IV+ = IV12 ByteString+ | IV16 ByteString+++newtype Sig = Sig ByteString+newtype SigTarget = SigTarget ByteString+newtype AAD = AAD ByteString+newtype Payload = Payload ByteString+newtype EncryptedCEK = EncryptedCEK ByteString+++parseJwt :: ByteString -> Either JwtError DecodableJwt+parseJwt bs = first (const BadCrypto) $ P.parseOnly jwt bs+++jwt :: Parser DecodableJwt+jwt = do+ (hdr, raw) <- jwtHeader+ case hdr of+ UnsecuredH -> Unsecured <$> base64Chunk+ JwsH h -> do+ payloadB64 <- PC.takeWhile ('.' /=) <* PC.char '.'+ payload <- b64Decode payloadB64+ s <- sig (jwsAlg h)+ pure $ DecodableJws h (Payload payload) s (SigTarget (B.concat [raw, ".", payloadB64]))+ JweH h ->+ DecodableJwe+ <$> pure h+ <*> encryptedCEK+ <*> iv (jweEnc h)+ <*> encryptedPayload+ <*> authTag (jweEnc h)+ <*> pure (AAD raw)+++sig :: JwsAlg -> Parser Sig+sig _ = do+ t <- P.takeByteString >>= b64Decode+ pure (Sig t)+++authTag :: Enc -> Parser Tag+authTag e = do+ t <- P.takeByteString >>= b64Decode+ case e of+ A128GCM -> tag16 t+ A192GCM -> tag16 t+ A256GCM -> tag16 t+ A128CBC_HS256 -> tag16 t+ A192CBC_HS384 -> tag24 t+ A256CBC_HS512 -> tag32 t+ where+ badTag = "invalid auth tag"+ tag16 t = if B.length t /= 16 then fail badTag else pure (Tag16 t)+ tag24 t = if B.length t /= 24 then fail badTag else pure (Tag24 t)+ tag32 t = if B.length t /= 32 then fail badTag else pure (Tag32 t)+++iv :: Enc -> Parser IV+iv e = do+ bs <- base64Chunk+ case e of+ A128GCM -> iv12 bs+ A192GCM -> iv12 bs+ A256GCM -> iv12 bs+ _ -> iv16 bs+ where+ iv12 bs = if B.length bs /= 12 then fail "invalid iv" else pure (IV12 bs)+ iv16 bs = if B.length bs /= 16 then fail "invalid iv" else pure (IV16 bs)+++encryptedCEK :: Parser EncryptedCEK+encryptedCEK = EncryptedCEK <$> base64Chunk+++encryptedPayload :: Parser Payload+encryptedPayload = Payload <$> base64Chunk+++jwtHeader :: P.Parser (JwtHeader, ByteString)+jwtHeader = do+ hdrB64 <- PC.takeWhile ('.' /=) <* PC.char '.'+ hdrBytes <- b64Decode hdrB64 :: P.Parser ByteString+ hdr <- parseHdr hdrBytes+ return (hdr, hdrB64)+ where+ parseHdr bs = either fail return (eitherDecodeStrict' bs)+++base64Chunk :: P.Parser ByteString+base64Chunk = do+ bs <- PC.takeWhile ('.' /=) <* PC.char '.'+ b64Decode bs+++b64Decode :: ByteString -> P.Parser ByteString+b64Decode bs = either (const (fail "Invalid Base64")) return $ convertFromBase Base64URLUnpadded bs
+ Jose/Jwa.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}++module Jose.Jwa+ ( Alg (..)+ , JwsAlg (..)+ , JweAlg (..)+ , Enc (..)+ )+where++import Data.Aeson+import Data.Text (Text)+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+-- <https://tools.ietf.org/html/rfc7518#section-3 JWA Spec>.+data JwsAlg = None | HS256 | HS384 | HS512 | RS256 | RS384 | RS512 | ES256 | ES384 | ES512 | EdDSA deriving (Eq, Show, Read)++-- | A subset of the key management algorithms from the+-- <https://tools.ietf.org/html/rfc7518#section-4 JWA Spec>.+data JweAlg = RSA1_5 | RSA_OAEP | RSA_OAEP_256 | A128KW | A192KW | A256KW deriving (Eq, Show, Read)++-- | Content encryption algorithms from the+-- <https://tools.ietf.org/html/rfc7518#section-5 JWA Spec>.+data Enc = A128CBC_HS256 | A192CBC_HS384 | A256CBC_HS512 | A128GCM | A192GCM | 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), ("ES256", Signed ES256), ("ES384", Signed ES384), ("ES512", Signed ES512), ("EdDSA", Signed EdDSA), ("RSA1_5", Encrypted RSA1_5), ("RSA-OAEP", Encrypted RSA_OAEP), ("RSA-OAEP-256", Encrypted RSA_OAEP_256), ("A128KW", Encrypted A128KW), ("A192KW", Encrypted A192KW), ("A256KW", Encrypted A256KW)]++algName :: Alg -> Text+algName a = let Just n = lookup a algNames in n++algNames :: [(Alg, Text)]+algNames = map swap algs++encs :: [(Text, Enc)]+encs = [("A128CBC-HS256", A128CBC_HS256), ("A256CBC-HS512", A256CBC_HS512), ("A192CBC-HS384", A192CBC_HS384), ("A128GCM", A128GCM), ("A192GCM", A192GCM), ("A256GCM", A256GCM)]++encName :: Enc -> Text+encName e = let Just n = lookup e encNames in n++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,170 @@+{-# LANGUAGE OverloadedStrings #-}++-- | JWE encrypted token support.+--+-- To create a JWE, you need to select two algorithms. One is an AES algorithm+-- used to encrypt the content of your token (for example, @A128GCM@), for which+-- a single-use key is generated internally. The second is used to encrypt+-- this content-encryption key and can be either an RSA or AES-keywrap algorithm.+-- You need to generate a suitable key to use with this, or load one from storage.+--+-- AES is much faster and creates shorter tokens, but both the encoder and decoder+-- of the token need to have a copy of the key, which they must keep secret. With+-- RSA anyone can send you a JWE if they have a copy of your public key.+--+-- In the example below, we show encoding and decoding using a 2048 bit RSA key pair+-- (256 bytes). If using RSA, use one of the @RSA_OAEP@ algorithms. @RSA1_5@ is+-- deprecated due to <https://robotattack.org/ known vulnerabilities>.+--+-- >>> import Jose.Jwe+-- >>> import Jose.Jwa+-- >>> import Jose.Jwk (generateRsaKeyPair, generateSymmetricKey, KeyUse(Enc), KeyId)+-- >>> (kPub, kPr) <- generateRsaKeyPair 256 (KeyId "My RSA Key") Enc Nothing+-- >>> Right (Jwt jwt) <- jwkEncode RSA_OAEP A128GCM kPub (Claims "secret claims")+-- >>> Right (Jwe (hdr, claims)) <- jwkDecode kPr jwt+-- >>> claims+-- "secret claims"+--+-- Using 128-bit AES keywrap is very similar, the main difference is that+-- we generate a 128-bit symmetric key (16 bytes):+--+-- >>> aesKey <- generateSymmetricKey 16 (KeyId "My Keywrap Key") Enc Nothing+-- >>> Right (Jwt jwt) <- jwkEncode A128KW A128GCM aesKey (Claims "more secret claims")+-- >>> Right (Jwe (hdr, claims)) <- jwkDecode aesKey jwt+-- >>> claims+-- "more secret claims"++module Jose.Jwe+ ( jwkEncode+ , jwkDecode+ , rsaEncode+ , rsaDecode+ )+where++import Control.Monad.Trans (lift)+import Control.Monad.Trans.Except+import Crypto.Cipher.Types (AuthTag(..))+import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder, private_pub)+import Crypto.Random (MonadRandom)+import qualified Data.Aeson as A+import Data.ByteArray (ByteArray, ScrubbedBytes)+import qualified Data.ByteArray as BA+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Maybe (isNothing)+import Jose.Types+import qualified Jose.Internal.Base64 as B64+import Jose.Internal.Crypto+import Jose.Jwa+import Jose.Jwk+import qualified Jose.Internal.Parser as P++-- | Create a JWE using a JWK.+-- The key and algorithms must be consistent or an error+-- will be returned.+jwkEncode :: MonadRandom m+ => JweAlg -- ^ Algorithm to use for key encryption+ -> Enc -- ^ Content encryption algorithm+ -> Jwk -- ^ The key to use to encrypt the content key+ -> Payload -- ^ The token content (claims or nested JWT)+ -> m (Either JwtError Jwt) -- ^ The encoded JWE if successful+jwkEncode a e jwk payload = runExceptT $ case jwk of+ RsaPublicJwk kPub kid _ _ -> doEncode (hdr kid) e (doRsa kPub) bytes+ RsaPrivateJwk kPr kid _ _ -> doEncode (hdr kid) e (doRsa (private_pub kPr)) bytes+ SymmetricJwk kek kid _ _ -> doEncode (hdr kid) e (ExceptT . return . keyWrap a (BA.convert kek)) bytes+ _ -> throwE $ KeyError "JWK cannot encode a JWE"+ where+ doRsa kPub = ExceptT . rsaEncrypt kPub a+ hdr :: Maybe KeyId -> B.ByteString+ hdr kid = BL.toStrict $+ BL.concat+ [ "{\"alg\":"+ , A.encode a+ , ",\"enc\":"+ , A.encode e+ , maybe "" (\c -> BL.concat [",\"cty\":\"", c, "\"" ]) contentType+ , if isNothing kid then "" else BL.concat [",\"kid\":", A.encode kid ]+ , "}"+ ]++ (contentType, bytes) = case payload of+ Claims c -> (Nothing, c)+ Nested (Jwt b) -> (Just "JWT", b)+++-- | Try to decode a JWE using a JWK.+-- If the key type does not match the content encoding algorithm,+-- an error will be returned.+jwkDecode :: MonadRandom m+ => Jwk+ -> ByteString+ -> m (Either JwtError JwtContent)+jwkDecode jwk jwt = runExceptT $ case jwk of+ RsaPrivateJwk kPr _ _ _ -> do+ blinder <- lift $ generateBlinder (public_n $ private_pub kPr)+ e <- doDecode (rsaDecrypt (Just blinder) kPr) jwt+ return (Jwe e)+ SymmetricJwk kb _ _ _ -> fmap Jwe (doDecode (keyUnwrap (BA.convert kb)) jwt)+ UnsupportedJwk _ -> throwE (KeyError "Unsupported JWK cannot be used to decode JWE")+ _ -> throwE $ KeyError "This JWK cannot decode a JWE"+++doDecode :: MonadRandom m+ => (JweAlg -> ByteString -> Either JwtError ScrubbedBytes)+ -> ByteString+ -> ExceptT JwtError m Jwe+doDecode decodeCek jwt = do+ encodedJwt <- ExceptT (return (P.parseJwt jwt))+ case encodedJwt of+ P.DecodableJwe hdr (P.EncryptedCEK ek) iv (P.Payload payload) tag (P.AAD aad) -> do+ let alg = jweAlg hdr+ enc = jweEnc hdr+ (dummyCek, _) <- lift $ generateCmkAndIV enc+ let decryptedCek = either (const dummyCek) id $ decodeCek alg ek+ cek = if BA.length decryptedCek == BA.length dummyCek+ then decryptedCek+ else dummyCek+ claims <- maybe (throwE BadCrypto) return $ decryptPayload enc cek iv aad tag payload+ return (hdr, claims)++ _ -> throwE (BadHeader "Content is not a JWE")+++doEncode :: (MonadRandom m, ByteArray ba)+ => ByteString+ -> Enc+ -> (ScrubbedBytes -> ExceptT JwtError m ByteString)+ -> ba+ -> ExceptT JwtError m Jwt+doEncode hdr e encryptKey claims = do+ (cmk, iv) <- lift (generateCmkAndIV e)+ let aad = B64.encode hdr+ (signature, ciphertext) = case encryptPayload e cmk iv aad claims of+ Just (AuthTag sig, ct) -> (sig, ct)+ Nothing -> error "encryptPayload failed! Shouldn't happen with valid key and iv"+ jweKey <- encryptKey cmk+ let jwe = B.intercalate "." $ map B64.encode [hdr, jweKey, BA.convert iv, BA.convert ciphertext, BA.convert signature]+ return (Jwt jwe)++-- | Creates a JWE with the content key encoded using RSA.+rsaEncode :: MonadRandom m+ => 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)+ -> m (Either JwtError Jwt) -- ^ The encoded JWE+rsaEncode a e kPub claims = runExceptT $ doEncode hdr e (ExceptT . rsaEncrypt kPub a) claims+ where+ hdr = BL.toStrict $ BL.concat ["{\"alg\":", A.encode a, ",", "\"enc\":", A.encode e, "}"]+++-- | Decrypts a JWE.+rsaDecode :: MonadRandom m+ => PrivateKey -- ^ Decryption key+ -> ByteString -- ^ The encoded JWE+ -> m (Either JwtError Jwe) -- ^ The decoded JWT, unless an error occurs+rsaDecode pk jwt = runExceptT $ do+ blinder <- lift $ generateBlinder (public_n $ private_pub pk)+ doDecode (rsaDecrypt (Just blinder) pk) jwt
+ Jose/Jwk.hs view
@@ -0,0 +1,538 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric, RecordWildCards, CPP #-}+{-# OPTIONS_HADDOCK prune #-}++module Jose.Jwk+ ( EcCurve (..)+ , KeyUse (..)+ , KeyId+ , Jwk (..)+ , JwkSet (..)+ , isPublic+ , isPrivate+ , jwkId+ , jwkUse+ , canDecodeJws+ , canDecodeJwe+ , canEncodeJws+ , canEncodeJwe+ , generateRsaKeyPair+ , generateSymmetricKey+ )+where++import Control.Monad (unless)+import Crypto.Error (CryptoFailable(..))+import Crypto.Random (MonadRandom, getRandomBytes)+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.ECC.Types as ECC+import Crypto.Number.Serialize+import Data.Aeson (fromJSON, genericToJSON, Object, Result(..), Value(..), FromJSON(..), ToJSON(..), withText)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KM+#else+import qualified Data.HashMap.Strict as H+#endif+import Data.Aeson.Types (Parser, Options (..), defaultOptions)+import qualified Data.ByteArray as BA+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Maybe (isNothing, fromMaybe)+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 (KeyId, JwsHeader(..), JweHeader(..))++data KeyType = Rsa+ | Ec+ | Okp+ | Oct+ deriving (Eq)++data EcCurve = P_256+ | P_384+ | P_521+ deriving (Eq,Show)++data KeyUse = Sig+ | Enc+ deriving (Eq,Show)++data Jwk = RsaPublicJwk !RSA.PublicKey !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg)+ | RsaPrivateJwk !RSA.PrivateKey !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg)+ | EcPublicJwk !ECDSA.PublicKey !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) !EcCurve+ | EcPrivateJwk !ECDSA.KeyPair !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) !EcCurve+ | Ed25519PrivateJwk !Ed25519.SecretKey !Ed25519.PublicKey !(Maybe KeyId)+ | Ed25519PublicJwk !Ed25519.PublicKey !(Maybe KeyId)+ | Ed448PrivateJwk !Ed448.SecretKey !Ed448.PublicKey !(Maybe KeyId)+ | Ed448PublicJwk !Ed448.PublicKey !(Maybe KeyId)+ | SymmetricJwk !ByteString !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg)+ | UnsupportedJwk Object+ deriving (Show, Eq)++newtype JwkSet = JwkSet+ { keys :: [Jwk]+ } deriving (Show, Eq, Generic)++generateRsaKeyPair :: (MonadRandom m)+ => Int+ -> KeyId+ -> KeyUse+ -> Maybe Alg+ -> m (Jwk, Jwk)+generateRsaKeyPair nBytes id' kuse kalg = do+ (kPub, kPr) <- RSA.generate nBytes 65537+ return (RsaPublicJwk kPub (Just id') (Just kuse) kalg, RsaPrivateJwk kPr (Just id') (Just kuse) kalg)++generateSymmetricKey :: (MonadRandom m)+ => Int+ -> KeyId+ -> KeyUse+ -> Maybe Alg+ -> m Jwk+generateSymmetricKey size id' kuse kalg = do+ k <- getRandomBytes size+ return $ SymmetricJwk k (Just id') (Just kuse) kalg++isPublic :: Jwk -> Bool+isPublic RsaPublicJwk {} = True+isPublic EcPublicJwk {} = True+isPublic _ = False++isPrivate :: Jwk -> Bool+isPrivate RsaPrivateJwk {} = True+isPrivate EcPrivateJwk {} = True+isPrivate _ = False++canDecodeJws :: JwsHeader -> Jwk -> Bool+canDecodeJws hdr jwk = jwkUse jwk /= Just Enc &&+ keyIdCompatible (jwsKid hdr) jwk &&+ algCompatible (Signed (jwsAlg hdr)) jwk &&+ case (jwsAlg hdr, jwk) of+ (EdDSA, Ed25519PublicJwk {}) -> True+ (EdDSA, Ed25519PrivateJwk {}) -> True+ (EdDSA, Ed448PublicJwk {}) -> True+ (EdDSA, Ed448PrivateJwk {}) -> True+ (RS256, RsaPublicJwk {}) -> True+ (RS384, RsaPublicJwk {}) -> True+ (RS512, RsaPublicJwk {}) -> True+ (RS256, RsaPrivateJwk {}) -> True+ (RS384, RsaPrivateJwk {}) -> True+ (RS512, RsaPrivateJwk {}) -> True+ (HS256, SymmetricJwk {}) -> True+ (HS384, SymmetricJwk {}) -> True+ (HS512, SymmetricJwk {}) -> True+ (ES256, EcPublicJwk {}) -> True+ (ES384, EcPublicJwk {}) -> True+ (ES512, EcPublicJwk {}) -> True+ (ES256, EcPrivateJwk {}) -> True+ (ES384, EcPrivateJwk {}) -> True+ (ES512, EcPrivateJwk {}) -> True+ _ -> False++canEncodeJws :: JwsAlg -> Jwk -> Bool+canEncodeJws a jwk = jwkUse jwk /= Just Enc &&+ algCompatible (Signed a) jwk &&+ case (a, jwk) of+ (EdDSA, Ed25519PrivateJwk {}) -> True+ (EdDSA, Ed448PrivateJwk {}) -> True+ (RS256, RsaPrivateJwk {}) -> True+ (RS384, RsaPrivateJwk {}) -> True+ (RS512, RsaPrivateJwk {}) -> True+ (HS256, SymmetricJwk {}) -> True+ (HS384, SymmetricJwk {}) -> True+ (HS512, SymmetricJwk {}) -> True+ (ES256, EcPrivateJwk {}) -> True+ (ES384, EcPrivateJwk {}) -> True+ (ES512, EcPrivateJwk {}) -> True+ _ -> False++canDecodeJwe :: JweHeader -> Jwk -> Bool+canDecodeJwe hdr jwk = jwkUse jwk /= Just Sig &&+ keyIdCompatible (jweKid hdr) jwk &&+ algCompatible (Encrypted (jweAlg hdr)) jwk &&+ case (jweAlg hdr, jwk) of+ (RSA1_5, RsaPrivateJwk {}) -> True+ (RSA_OAEP, RsaPrivateJwk {}) -> True+ (RSA_OAEP_256, RsaPrivateJwk {}) -> True+ (A128KW, SymmetricJwk k _ _ _) -> B.length k == 16+ (A192KW, SymmetricJwk k _ _ _) -> B.length k == 24+ (A256KW, SymmetricJwk k _ _ _) -> B.length k == 32+ _ -> False++canEncodeJwe :: JweAlg -> Jwk -> Bool+canEncodeJwe a jwk = jwkUse jwk /= Just Sig &&+ algCompatible (Encrypted a) jwk &&+ case (a, jwk) of+ (RSA1_5, RsaPublicJwk {}) -> True+ (RSA_OAEP, RsaPublicJwk {}) -> True+ (RSA_OAEP_256, RsaPublicJwk {}) -> True+ (RSA1_5, RsaPrivateJwk {}) -> True+ (RSA_OAEP, RsaPrivateJwk {}) -> True+ (RSA_OAEP_256, RsaPrivateJwk {}) -> True+ (A128KW, SymmetricJwk k _ _ _) -> B.length k == 16+ (A192KW, SymmetricJwk k _ _ _) -> B.length k == 24+ (A256KW, SymmetricJwk k _ _ _) -> B.length k == 32+ _ -> False++keyIdCompatible :: Maybe KeyId -> Jwk -> Bool+keyIdCompatible Nothing _ = True+keyIdCompatible id' jwk = id' == jwkId jwk++algCompatible :: Alg -> Jwk -> Bool+algCompatible a k' = case jwkAlg k' of+ Nothing -> True+ Just ka -> a == ka++ecCurve :: Text -> Maybe (EcCurve, ECC.Curve)+ecCurve c = case c of+ "P-256" -> Just (P_256, ECC.getCurveByName ECC.SEC_p256r1)+ "P-384" -> Just (P_384, ECC.getCurveByName ECC.SEC_p384r1)+ "P-521" -> Just (P_521, ECC.getCurveByName ECC.SEC_p521r1)+ _ -> Nothing++ecCurveName :: EcCurve -> Text+ecCurveName c = case c of+ P_256 -> "P-256"+ P_384 -> "P-384"+ P_521 -> "P-521"++jwkId :: Jwk -> Maybe KeyId+jwkId key = case key of+ Ed25519PrivateJwk _ _ keyId -> keyId+ Ed25519PublicJwk _ keyId -> keyId+ Ed448PrivateJwk _ _ keyId -> keyId+ Ed448PublicJwk _ keyId -> keyId+ RsaPublicJwk _ keyId _ _ -> keyId+ RsaPrivateJwk _ keyId _ _ -> keyId+ EcPublicJwk _ keyId _ _ _ -> keyId+ EcPrivateJwk _ keyId _ _ _ -> keyId+ SymmetricJwk _ keyId _ _ -> keyId+ UnsupportedJwk _ -> Nothing++jwkUse :: Jwk -> Maybe KeyUse+jwkUse key = case key of+ Ed25519PrivateJwk {} -> Just Sig+ Ed25519PublicJwk _ _ -> Just Sig+ Ed448PrivateJwk {} -> Just Sig+ Ed448PublicJwk _ _ -> Just Sig+ RsaPublicJwk _ _ u _ -> u+ RsaPrivateJwk _ _ u _ -> u+ EcPublicJwk _ _ u _ _ -> u+ EcPrivateJwk _ _ u _ _ -> u+ SymmetricJwk _ _ u _ -> u+ UnsupportedJwk _ -> Nothing++jwkAlg :: Jwk -> Maybe Alg+jwkAlg key = case key of+ Ed25519PrivateJwk {} -> Just (Signed EdDSA)+ Ed25519PublicJwk _ _ -> Just (Signed EdDSA)+ Ed448PrivateJwk {} -> Just (Signed EdDSA)+ Ed448PublicJwk _ _ -> Just (Signed EdDSA)+ RsaPublicJwk _ _ _ a -> a+ RsaPrivateJwk _ _ _ a -> a+ EcPublicJwk _ _ _ a _ -> a+ EcPrivateJwk _ _ _ a _ -> a+ SymmetricJwk _ _ _ a -> a+ UnsupportedJwk _ -> Nothing+++newtype JwkBytes = JwkBytes {bytes :: ByteString} deriving (Show)++instance FromJSON KeyType where+ parseJSON = withText "KeyType" $ \t ->+ case t of+ "RSA" -> pure Rsa+ "OKP" -> pure Okp+ "EC" -> pure Ec+ "oct" -> pure Oct+ _ -> fail "unsupported key type"++instance ToJSON KeyType where+ toJSON kt = case kt of+ Rsa -> String "RSA"+ Okp -> String "OKP"+ 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 (Object k) = parseJwk k+ parseJSON _ = fail "Jwk must be a JSON object"++parseJwk :: Object -> Parser Jwk+parseJwk k =+ case (checkAlg, checkKty) of+ (Success _, Success _) -> do+ jwkData <- parseJSON (Object k) :: Parser JwkData+ case createJwk jwkData of+ Left err -> fail err+ Right jwk -> return jwk+ _ -> pure (UnsupportedJwk k)+ where+#if MIN_VERSION_aeson(2,0,0)+ algValue = fromMaybe Null (KM.lookup "alg" k)+ -- kty is required so if it's missing here we do nothing and allow decoding to fail+ -- later+ ktyValue = fromMaybe Null (KM.lookup "kty" k)+#else+ algValue = fromMaybe Null (H.lookup "alg" k)+ ktyValue = fromMaybe Null (H.lookup "kty" k)+#endif+ checkAlg = fromJSON algValue :: Result (Maybe Alg)+ checkKty = fromJSON ktyValue :: Result (Maybe KeyType)++instance ToJSON Jwk where+ toJSON jwk = case jwk of+ RsaPublicJwk pubKey mId mUse mAlg ->+ toJSON $ createPubData pubKey mId mUse mAlg+ RsaPrivateJwk privKey mId mUse mAlg ->+ let pubData = createPubData (RSA.private_pub privKey) mId mUse mAlg+ in toJSON $ 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+ }++ Ed25519PrivateJwk kPr kPub kid_ -> toJSON $ defJwk+ { kty = Okp+ , crv = Just "Ed25519"+ , d = Just (JwkBytes (BA.convert kPr))+ , x = Just (JwkBytes (BA.convert kPub))+ , kid = kid_+ }++ Ed25519PublicJwk kPub kid_ -> toJSON $ defJwk+ { kty = Okp+ , crv = Just "Ed25519"+ , x = Just (JwkBytes (BA.convert kPub))+ , kid = kid_+ }++ Ed448PrivateJwk kPr kPub kid_ -> toJSON $ defJwk+ { kty = Okp+ , crv = Just "Ed448"+ , d = Just (JwkBytes (BA.convert kPr))+ , x = Just (JwkBytes (BA.convert kPub))+ , kid = kid_+ }++ Ed448PublicJwk kPub kid_ -> toJSON $ defJwk+ { kty = Okp+ , crv = Just "Ed448"+ , x = Just (JwkBytes (BA.convert kPub))+ , kid = kid_+ }+++ SymmetricJwk bs mId mUse mAlg -> toJSON $ defJwk+ { kty = Oct+ , k = Just $ JwkBytes bs+ , kid = mId+ , use = mUse+ , alg = mAlg+ }++ EcPublicJwk pubKey mId mUse mAlg c -> toJSON $ defJwk+ { kty = Ec+ , x = fst (ecPoint pubKey)+ , y = snd (ecPoint pubKey)+ , kid = mId+ , use = mUse+ , alg = mAlg+ , crv = Just (ecCurveName c)+ }++ EcPrivateJwk kp mId mUse mAlg c -> toJSON $ defJwk+ { kty = Ec+ , x = fst (ecPoint (ECDSA.toPublicKey kp))+ , y = snd (ecPoint (ECDSA.toPublicKey kp))+ , d = i2b (ECDSA.private_d (ECDSA.toPrivateKey kp))+ , kid = mId+ , use = mUse+ , alg = mAlg+ , crv = Just (ecCurveName c)+ }++ UnsupportedJwk k -> Object k+ where+ i2b 0 = Nothing+ i2b i = Just . JwkBytes . i2osp $ i+ ecPoint pk = case ECDSA.public_q pk of+ ECC.Point xi yi -> (i2b xi, i2b yi)+ _ -> (Nothing, Nothing)++ createPubData pubKey mId mUse mAlg = defJwk+ { n = i2b (RSA.public_n pubKey)+ , e = i2b (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 Text+ , x :: Maybe JwkBytes+ , y :: Maybe JwkBytes+ , use :: Maybe KeyUse+ , alg :: Maybe Alg+ , kid :: Maybe KeyId+ , x5u :: Maybe Text+ , x5c :: Maybe [Text]+ , x5t :: Maybe Text+ } deriving (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 J {..} = case kty of+ Rsa -> do+ nb <- note "n is required for an RSA key" n+ eb <- note "e is required for an RSA key" e+ checkNoEc+ let kPub = rsaPub nb eb+ case d of+ Nothing -> do+ unless (isNothing (sequence [p, q, dp, dq, qi])) (Left "RSA private parameters can't be set for a public key")+ return (RsaPublicJwk kPub kid use alg)+ Just db -> return $ RsaPrivateJwk (RSA.PrivateKey kPub (os2ip (bytes db)) (os2mip p) (os2mip q) (os2mip dp) (os2mip dq) (os2mip qi)) kid use alg+ Oct -> do+ kb <- note "k is required for a symmetric key" k+ unless (isNothing (sequence [n, e, d, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for a symmetric key")+ checkNoEc+ return $ SymmetricJwk (bytes kb) kid use alg+ Okp -> do+ crv' <- note "crv is required for an OKP key" crv+ x' <- note "x is required for an OKP key" x+ unless (isNothing (sequence [n, e, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for an OKP key")+ case crv' of+ "Ed25519" -> case d of+ Just db -> do+ secKey <- createOkpKey Ed25519.secretKey (bytes db)+ pubKey <- createOkpKey Ed25519.publicKey (bytes x')+ unless (pubKey == Ed25519.toPublic secKey) (Left "Public key x doesn't match private key d")+ return (Ed25519PrivateJwk secKey pubKey kid)+ Nothing -> do+ pubKey <- createOkpKey Ed25519.publicKey (bytes x')+ return (Ed25519PublicJwk pubKey kid)+ "Ed448" -> case d of+ Just db -> do+ secKey <- createOkpKey Ed448.secretKey (bytes db)+ pubKey <- createOkpKey Ed448.publicKey (bytes x')+ unless (pubKey == Ed448.toPublic secKey) (Left "Public key x doesn't match private key d")+ return (Ed448PrivateJwk secKey pubKey kid)+ Nothing -> do+ pubKey <- createOkpKey Ed448.publicKey (bytes x')+ return (Ed448PublicJwk pubKey kid)++ _ -> Left "Unknown or unsupported OKP type"+ Ec -> do+ crv' <- note "crv is required for an elliptic curve key" crv+ (crv'', c) <- note "crv must be a valid EC curve name" (ecCurve crv')+ ecPt <- ecPoint+ unless (isNothing (sequence [n, e, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for an elliptic curve key")+ case d of+ Nothing -> return $ EcPublicJwk (ECDSA.PublicKey c ecPt) kid use alg crv''+ Just db -> return $ EcPrivateJwk (ECDSA.KeyPair c ecPt (os2ip (bytes db))) kid use alg crv''+ where+ checkNoEc = unless (isNothing crv) (Left "Elliptic curve type can't be set for an RSA key") >>+ unless (isNothing (sequence [x, y])) (Left "Elliptic curve coordinates can't be set for an RSA key")+ createOkpKey f ba = case f ba of+ CryptoPassed k_ -> Right k_+ _ -> Left "Invalid OKP key data"++ note err = maybe (Left err) Right+ os2mip = maybe 0 (os2ip . bytes)+ 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)+ ecPoint = do+ xb <- note "x is required for an EC key" x+ yb <- note "y is required for an EC key" y+ return $ ECC.Point (os2ip (bytes xb)) (os2ip (bytes yb))
+ Jose/Jws.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE OverloadedStrings #-}++-- | JWS HMAC and RSA signed token support.+--+-- Example usage with HMAC:+--+-- >>> import Jose.Jws+-- >>> import Jose.Jwa+-- >>> let Right (Jwt jwt) = hmacEncode HS256 "secretmackey" "public claims"+-- >>> jwt+-- "eyJhbGciOiJIUzI1NiJ9.cHVibGljIGNsYWltcw.GDV7RdBrCYfCtFCZZGPy_sWry4GwfX3ckMywXUyxBsc"+-- >>> hmacDecode "wrongkey" jwt+-- Left BadSignature+-- >>> hmacDecode "secretmackey" jwt+-- Right (JwsHeader {jwsAlg = HS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Nothing},"public claims")++module Jose.Jws+ ( jwkEncode+ , hmacEncode+ , hmacDecode+ , rsaEncode+ , rsaDecode+ , ecDecode+ , ed25519Encode+ , ed25519Decode+ , ed448Encode+ , ed448Decode+ )+where++import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder)+import Crypto.Random (MonadRandom)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B++import Jose.Types+import qualified Jose.Internal.Base64 as B64+import Jose.Internal.Crypto+import qualified Jose.Internal.Parser as P+import Jose.Jwa+import Jose.Jwk (Jwk (..))++-- | Create a JWS signed with a JWK.+-- The key and algorithm must be consistent or an error+-- will be returned.+jwkEncode :: MonadRandom m+ => JwsAlg -- ^ The algorithm to use+ -> Jwk -- ^ The key to sign with+ -> Payload -- ^ The public JWT claims+ -> m (Either JwtError Jwt) -- ^ The encoded token, if successful+jwkEncode a key payload = case key of+ RsaPrivateJwk kPr kid _ _ -> rsaEncodeInternal a kPr (sigTarget a kid payload)+ SymmetricJwk k kid _ _ -> return $ hmacEncodeInternal a k (sigTarget a kid payload)+ Ed25519PrivateJwk kPr kPub kid -> return $+ case a of+ EdDSA -> Right $ ed25519EncodeInternal kPr kPub (sigTarget EdDSA kid payload)+ _ -> Left (KeyError "Algorithm cannot be used with an Ed25519 key")+ Ed448PrivateJwk kPr kPub kid -> return $+ case a of+ EdDSA -> Right $ ed448EncodeInternal kPr kPub (sigTarget EdDSA kid payload)+ _ -> Left (KeyError "Algorithm cannot be used with an Ed448 key")+ _ -> return $ Left $ BadAlgorithm "EC signing is not supported"++-- | Create a JWS with an HMAC for validation.+hmacEncode :: JwsAlg -- ^ The MAC algorithm to use+ -> ByteString -- ^ The MAC key+ -> ByteString -- ^ The public JWT claims (token content)+ -> Either JwtError Jwt -- ^ The encoded JWS token+hmacEncode a key payload = hmacEncodeInternal a key (sigTarget a Nothing (Claims payload))++hmacEncodeInternal :: JwsAlg+ -> ByteString+ -> ByteString+ -> Either JwtError Jwt+hmacEncodeInternal a key st = Jwt . (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st++-- | Decodes and validates an HMAC signed JWS.+hmacDecode :: ByteString -- ^ The HMAC key+ -> ByteString -- ^ The JWS token to decode+ -> Either JwtError Jws -- ^ The decoded token if successful+hmacDecode key = decode (`hmacVerify` key)++-- | Creates a JWS with an RSA signature.+rsaEncode :: MonadRandom m+ => JwsAlg -- ^ The RSA algorithm to use+ -> PrivateKey -- ^ The key to sign with+ -> ByteString -- ^ The public JWT claims (token content)+ -> m (Either JwtError Jwt) -- ^ The encoded JWS token+rsaEncode a pk payload = rsaEncodeInternal a pk (sigTarget a Nothing (Claims payload))++rsaEncodeInternal :: MonadRandom m+ => JwsAlg+ -> PrivateKey+ -> ByteString+ -> m (Either JwtError Jwt)+rsaEncodeInternal a pk st = do+ blinder <- generateBlinder (public_n $ private_pub pk)+ return $ sign blinder+ where+ sign b = case rsaSign (Just b) a pk st of+ Right sig -> Right . Jwt $ B.concat [st, ".", B64.encode sig]+ Left e -> Left e+++ed25519Decode :: Ed25519.PublicKey+ -> ByteString+ -> Either JwtError Jws+ed25519Decode key = decode (`ed25519Verify` key)+++ed25519Encode :: Ed25519.SecretKey+ -> Ed25519.PublicKey+ -> ByteString+ -> Jwt+ed25519Encode kPr kPub payload =+ ed25519EncodeInternal kPr kPub (sigTarget EdDSA Nothing (Claims payload))+++ed25519EncodeInternal :: Ed25519.SecretKey+ -> Ed25519.PublicKey+ -> ByteString+ -> Jwt+ed25519EncodeInternal kPr kPub signMe =+ let+ sig = Ed25519.sign kPr kPub signMe+ in+ Jwt (B.concat [signMe, ".", B64.encode sig])+++ed448Decode :: Ed448.PublicKey+ -> ByteString+ -> Either JwtError Jws+ed448Decode key = decode (`ed448Verify` key)+++ed448Encode :: Ed448.SecretKey+ -> Ed448.PublicKey+ -> ByteString+ -> Jwt+ed448Encode kPr kPub payload =+ ed448EncodeInternal kPr kPub (sigTarget EdDSA Nothing (Claims payload))+++ed448EncodeInternal :: Ed448.SecretKey+ -> Ed448.PublicKey+ -> ByteString+ -> Jwt+ed448EncodeInternal kPr kPub signMe =+ let+ sig = Ed448.sign kPr kPub signMe+ in+ Jwt (B.concat [signMe, ".", B64.encode sig])+++-- | Decode and validate an RSA signed JWS.+rsaDecode :: PublicKey -- ^ The key to check the signature with+ -> ByteString -- ^ The encoded JWS+ -> Either JwtError Jws -- ^ The decoded token if successful+rsaDecode key = decode (`rsaVerify` key)+++-- | Decode and validate an EC signed JWS+ecDecode :: ECDSA.PublicKey -- ^ The key to check the signature with+ -> ByteString -- ^ The encoded JWS+ -> Either JwtError Jws -- ^ The decoded token if successful+ecDecode key = decodeEither (`ecVerify` key)++sigTarget :: JwsAlg -> Maybe KeyId -> Payload -> ByteString+sigTarget a kid payload = B.intercalate "." $ map B64.encode [encodeHeader hdr, bytes]+ where+ hdr = defJwsHdr {jwsAlg = a, jwsKid = kid, jwsCty = contentType}+ (contentType, bytes) = case payload of+ Claims c -> (Nothing, c)+ Nested (Jwt b) -> (Just "JWT", b)++type JwsVerifier = JwsAlg -> ByteString -> ByteString -> Bool+++decode :: JwsVerifier -> ByteString -> Either JwtError Jws+decode verify jwt = decodeEither (\alg msg sig -> Right (verify alg msg sig)) jwt++-- helper for making ecVerify (returns Either .. Bool) work with the other verify algorithms like rsaVerify (all return Bool)+decodeEither :: (JwsAlg -> ByteString -> ByteString -> Either JwtError Bool)+ -> ByteString+ -> Either JwtError Jws+decodeEither verify jwt = do+ decodableJwt <- P.parseJwt jwt+ case decodableJwt of+ P.DecodableJws hdr (P.Payload p) (P.Sig sig) (P.SigTarget signed) ->+ case verify (jwsAlg hdr) signed sig of+ Left err -> Left err+ Right True -> Right (hdr, p)+ Right False -> Left BadSignature+ _ -> Left (BadHeader "JWT is not a JWS")
+ Jose/Jwt.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}+{-# OPTIONS_HADDOCK prune #-}++-- | High-level JWT encoding and decoding.+--+-- See the Jose.Jws and Jose.Jwe modules for specific JWS and JWE examples.+--+-- Example usage with a key stored as a JWK:+--+-- >>> import Jose.Jwe+-- >>> import Jose.Jwa+-- >>> import Jose.Jwk+-- >>> import Data.ByteString+-- >>> import Data.Aeson (decodeStrict)+-- >>> let jsonJwk = "{\"kty\":\"RSA\", \"kid\":\"mykey\", \"n\":\"ofgWCuLjybRlzo0tZWJjNiuSfb4p4fAkd_wWJcyQoTbji9k0l8W26mPddxHmfHQp-Vaw-4qPCJrcS2mJPMEzP1Pt0Bm4d4QlL-yRT-SFd2lZS-pCgNMsD1W_YpRPEwOWvG6b32690r2jZ47soMZo9wGzjb_7OMg0LOL-bSf63kpaSHSXndS5z5rexMdbBYUsLA9e-KXBdQOS-UTo7WTBEMa2R2CapHg665xsmtdVMTBQY4uDZlxvb3qCo5ZwKh9kG4LT6_I5IhlJH7aGhyxXFvUK-DWNmoudF8NAco9_h9iaGNj8q2ethFkMLs91kzk2PAcDTW9gb54h4FRWyuXpoQ\", \"e\":\"AQAB\", \"d\":\"Eq5xpGnNCivDflJsRQBXHx1hdR1k6Ulwe2JZD50LpXyWPEAeP88vLNO97IjlA7_GQ5sLKMgvfTeXZx9SE-7YwVol2NXOoAJe46sui395IW_GO-pWJ1O0BkTGoVEn2bKVRUCgu-GjBVaYLU6f3l9kJfFNS3E0QbVdxzubSu3Mkqzjkn439X0M_V51gfpRLI9JYanrC4D4qAdGcopV_0ZHHzQlBjudU2QvXt4ehNYTCBr6XCLQUShb1juUO1ZdiYoFaFQT5Tw8bGUl_x_jTj3ccPDVZFD9pIuhLhBOneufuBiB4cS98l2SR_RQyGWSeWjnczT0QU91p1DhOVRuOopznQ\"}" :: ByteString+-- >>> let Just jwk = decodeStrict jsonJwk :: Maybe Jwk+-- >>> Right (Jwt jwtEncoded) <- encode [jwk] (JwsEncoding RS256) (Claims "public claims")+-- >>> Right jwtDecoded <- Jose.Jwt.decode [jwk] (Just (JwsEncoding RS256)) jwtEncoded+-- >>> jwtDecoded+-- Jws (JwsHeader {jwsAlg = RS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Just (KeyId "mykey")},"public claims")++module Jose.Jwt+ ( module Jose.Types+ , encode+ , decode+ , decodeClaims+ )+where++import Control.Monad (msum, when, unless)+import Control.Monad.Trans (lift)+import Control.Monad.Trans.Except+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import Crypto.PubKey.RSA (PrivateKey(..))+import Crypto.Random (MonadRandom)+import Data.Aeson (decodeStrict',FromJSON)+import Data.ByteString (ByteString)+import Data.Maybe (isNothing)+import qualified Data.ByteString.Char8 as BC++import qualified Jose.Internal.Base64 as B64+import qualified Jose.Internal.Parser as P+import Jose.Types+import Jose.Jwk+import Jose.Jwa++import qualified Jose.Jws as Jws+import qualified Jose.Jwe as Jwe+++-- | Use the supplied JWKs to create a JWT.+-- The list of keys will be searched to locate one which is+-- consistent with the chosen encoding algorithms.+--+encode :: MonadRandom m+ => [Jwk] -- ^ The key or keys. At least one must be consistent with the chosen algorithm+ -> JwtEncoding -- ^ The encoding algorithm(s) used to encode the payload+ -> Payload -- ^ The payload (claims)+ -> m (Either JwtError Jwt) -- ^ The encoded JWT, if successful+encode jwks encoding msg = runExceptT $ case encoding of+ JwsEncoding None -> case msg of+ Claims p -> return $ Jwt $ BC.intercalate "." [unsecuredHdr, B64.encode p]+ Nested _ -> throwE BadClaims+ JwsEncoding a -> case filter (canEncodeJws a) jwks of+ [] -> throwE (KeyError "No matching key found for JWS algorithm")+ (k:_) -> ExceptT . return =<< lift (Jws.jwkEncode a k msg)+ JweEncoding a e -> case filter (canEncodeJwe a) jwks of+ [] -> throwE (KeyError "No matching key found for JWE algorithm")+ (k:_) -> ExceptT . return =<< lift (Jwe.jwkEncode a e k msg)+ where+ unsecuredHdr = B64.encode (BC.pack "{\"alg\":\"none\"}")+++-- | Uses the supplied keys to decode a JWT.+-- Locates a matching key by header @kid@ value where possible+-- or by suitable key type for the encoding algorithm.+--+-- The algorithm(s) used can optionally be supplied for validation+-- by setting the @JwtEncoding@ parameter, in which case an error will+-- be returned if they don't match. If you expect the tokens to use+-- a particular algorithm, then you should set this parameter.+--+-- For unsecured tokens (with algorithm "none"), the expected algorithm+-- must be set to @Just (JwsEncoding None)@ or an error will be returned.+decode :: MonadRandom m+ => [Jwk] -- ^ The keys to use for decoding+ -> Maybe JwtEncoding -- ^ The expected encoding information+ -> ByteString -- ^ The encoded JWT+ -> m (Either JwtError JwtContent) -- ^ The decoded JWT payload, if successful+decode keySet encoding jwt = runExceptT $ do+ decodableJwt <- ExceptT (return (P.parseJwt jwt))++ decoded <- case (decodableJwt, encoding) of+ (P.Unsecured p, Just (JwsEncoding None)) -> return (Just (Unsecured p))+ (P.Unsecured _, _) -> throwE (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'")+ (P.DecodableJws hdr _ _ _, e) -> do+ unless (isNothing e || e == Just (JwsEncoding (jwsAlg hdr))) $+ throwE (BadAlgorithm "Expected 'alg' doesn't match JWS header")+ ks <- checkKeys $ filter (canDecodeJws hdr) keySet+ tryJwsKeys ks+ (P.DecodableJwe hdr _ _ _ _ _, e) -> do+ unless (isNothing e || e == Just (JweEncoding (jweAlg hdr) (jweEnc hdr))) $+ throwE (BadAlgorithm "Expected encoding doesn't match JWE header")+ ks <- checkKeys $ filter (canDecodeJwe hdr) keySet+ msum <$> (mapM decodeWithJwe ks)+ case decoded of+ Nothing -> throwE $ KeyError "None of the keys was able to decode the JWT"+ Just jwtContent -> return jwtContent+ where+ tryJwsKeys [] = return Nothing+ tryJwsKeys (k:ks) = do+ tried <- decodeWithJws k+ case tried of+ Just content -> return (Just content)+ Nothing -> tryJwsKeys ks++ decodeWithJws :: MonadRandom m => Jwk -> ExceptT JwtError m (Maybe JwtContent)+ decodeWithJws k = either handleErr (return . Just . Jws) $ case k of+ Ed25519PublicJwk kPub _ -> Jws.ed25519Decode kPub jwt+ Ed25519PrivateJwk _ kPub _ -> Jws.ed25519Decode kPub jwt+ Ed448PublicJwk kPub _ -> Jws.ed448Decode kPub jwt+ Ed448PrivateJwk _ kPub _ -> Jws.ed448Decode kPub jwt+ RsaPublicJwk kPub _ _ _ -> Jws.rsaDecode kPub jwt+ RsaPrivateJwk kPr _ _ _ -> Jws.rsaDecode (private_pub kPr) jwt+ EcPublicJwk kPub _ _ _ _ -> Jws.ecDecode kPub jwt+ EcPrivateJwk kPr _ _ _ _ -> Jws.ecDecode (ECDSA.toPublicKey kPr) jwt+ SymmetricJwk kb _ _ _ -> Jws.hmacDecode kb jwt+ UnsupportedJwk _ -> Left (KeyError "Unsupported JWKs cannot be used")++ -- stop trying when a BotanError is hit+ handleErr err@(BotanError _) = throwE err+ handleErr _ = return Nothing++ decodeWithJwe :: MonadRandom m => Jwk -> ExceptT JwtError m (Maybe JwtContent)+ decodeWithJwe k = fmap (either (const Nothing) Just) (lift (Jwe.jwkDecode k jwt))++ checkKeys [] = throwE $ KeyError "No suitable key was found to decode the JWT"+ checkKeys ks = return ks+++-- | Convenience function to return the claims contained in a JWS.+-- This is needed in situations such as client assertion authentication,+-- <https://tools.ietf.org/html/rfc7523>, where the contents of the JWT,+-- such as the @sub@ claim, may be required in order to work out+-- which key should be used to verify the token.+--+-- Obviously this should not be used by itself to decode a token since+-- no integrity checking is done and the contents may be forged.+decodeClaims :: (FromJSON a)+ => ByteString+ -> Either JwtError (JwtHeader, a)+decodeClaims jwt = do+ let components = BC.split '.' jwt+ when (length components /= 3) $ Left $ BadDots 2+ hdr <- B64.decode (head components) >>= parseHeader+ claims <- B64.decode ((head . tail) components) >>= parseClaims+ return (hdr, claims)+ where+ parseClaims bs = maybe (Left BadClaims) Right $ decodeStrict' bs
+ Jose/Types.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric, FlexibleContexts, GeneralizedNewtypeDeriving, CPP #-}+{-# OPTIONS_HADDOCK prune #-}++module Jose.Types+ ( Jwt (..)+ , Jwe+ , Jws+ , JwtClaims (..)+ , JwtHeader (..)+ , JwsHeader (..)+ , JweHeader (..)+ , JwtContent (..)+ , JwtEncoding (..)+ , JwtError (..)+ , IntDate (..)+ , Payload (..)+ , KeyId (..)+ , parseHeader+ , encodeHeader+ , defJwsHdr+ , defJweHdr+ )+where++import Data.Aeson+#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.KeyMap as KM+#else+import qualified Data.HashMap.Strict as H+#endif+import Data.Char (toUpper, toLower)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.Int (Int64)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Vector (singleton)+import GHC.Generics++import Jose.Jwa (JweAlg(..), JwsAlg (..), Enc(..))++-- | An encoded JWT.+newtype Jwt = Jwt { unJwt :: ByteString } deriving (Show, Eq)++-- | The payload to be encoded in a JWT.+data Payload = Nested Jwt+ | Claims ByteString+ deriving (Show, Eq)++-- | The header and claims of a decoded JWS.+type Jws = (JwsHeader, ByteString)++-- | The header and claims of a decoded JWE.+type Jwe = (JweHeader, ByteString)++-- | A decoded JWT which can be either a JWE or a JWS, or an unsecured JWT.+data JwtContent = Unsecured !ByteString | Jws !Jws | Jwe !Jwe deriving (Show, Eq)++-- | Defines the encoding information for a JWT.+--+-- Used for both encoding new JWTs and validating existing ones.+data JwtEncoding+ = JwsEncoding JwsAlg+ | JweEncoding JweAlg Enc+ deriving (Eq, Show)++data JwtHeader = JweH JweHeader+ | JwsH JwsHeader+ | UnsecuredH+ deriving (Show)++data KeyId+ = KeyId Text+ | UTCKeyId UTCTime+ deriving (Eq, Show, Ord)++instance ToJSON KeyId+ where+ toJSON (KeyId t) = toJSON t+ toJSON (UTCKeyId t) = toJSON t++instance FromJSON KeyId+ where+ parseJSON = withText "KeyId" $ \t -> do+ let asTime = fromJSON (String t) :: Result UTCTime+ case asTime of+ Success d -> pure (UTCKeyId d)+ _ -> pure (KeyId t)++-- | Header content for a JWS.+data JwsHeader = JwsHeader {+ jwsAlg :: JwsAlg+ , jwsTyp :: Maybe Text+ , jwsCty :: Maybe Text+ , jwsKid :: Maybe KeyId+ } 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 KeyId+ } deriving (Eq, Show, Generic)++newtype IntDate = IntDate POSIXTime deriving (Show, Eq, Ord, Num)++instance FromJSON IntDate where+ parseJSON = withScientific "IntDate" $ \n ->+ pure . IntDate . fromIntegral $ (round n :: Int64)++instance ToJSON IntDate where+ toJSON (IntDate t) = Number $ fromIntegral (round t :: Int64)++-- | Registered claims defined in section 4 of the JWT spec.+data JwtClaims = JwtClaims+ { jwtIss :: !(Maybe Text)+ , jwtSub :: !(Maybe Text)+ , jwtAud :: !(Maybe [Text])+ , jwtExp :: !(Maybe IntDate)+ , jwtNbf :: !(Maybe IntDate)+ , jwtIat :: !(Maybe IntDate)+ , jwtJti :: !(Maybe Text)+ } deriving (Show, Generic)++-- Deal with the case where "aud" may be a single value rather than an array+instance FromJSON JwtClaims where+#if MIN_VERSION_aeson(2,0,0)+ parseJSON v@(Object o) = case KM.lookup "aud" o of+ Just (a@(String _)) -> genericParseJSON claimsOptions $ Object $ KM.insert "aud" (Array $ Data.Vector.singleton a) o+#else+ parseJSON v@(Object o) = case H.lookup "aud" o of+ Just (a@(String _)) -> genericParseJSON claimsOptions $ Object $ H.insert "aud" (Array $ singleton a) o+#endif+ _ -> genericParseJSON claimsOptions v+ parseJSON _ = fail "JwtClaims must be an object"++instance ToJSON JwtClaims where+ toJSON = genericToJSON claimsOptions++instance ToJSON Jwt where+ toJSON (Jwt bytes) = String (TE.decodeUtf8 bytes)++instance FromJSON Jwt where+ parseJSON (String token) = pure $ Jwt (TE.encodeUtf8 token)+ parseJSON _ = fail "Jwt must be a string"++claimsOptions :: Options+claimsOptions = prefixOptions "jwt"++defJwsHdr :: JwsHeader+defJwsHdr = JwsHeader RS256 Nothing Nothing Nothing++defJweHdr :: JweHeader+defJweHdr = JweHeader RSA_OAEP A128GCM Nothing Nothing Nothing Nothing++-- | Decoding errors.+data JwtError = KeyError Text -- ^ No suitable key or wrong key type+ | BadAlgorithm Text -- ^ The supplied algorithm is invalid+ | BadDots Int -- ^ Wrong number of "." characters in the JWT+ | BadHeader Text -- ^ Header couldn't be decoded or contains bad data+ | BadClaims -- ^ Claims part couldn't be decoded or contains bad data+ | BadSignature -- ^ Signature is invalid+ | BadCrypto -- ^ A cryptographic operation failed+ | Base64Error String -- ^ A base64 decoding error+ | BotanError Text -- ^ Botan failure+ 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+#if MIN_VERSION_aeson(2,0,0)+ parseJSON v@(Object o) = case KM.lookup "alg" o of+ Just (String "none") -> pure UnsecuredH+ _ -> case KM.lookup "enc" o of+#else+ parseJSON v@(Object o) = case H.lookup "alg" o of+ Just (String "none") -> pure UnsecuredH+ _ -> case H.lookup "enc" o of+#endif+ Nothing -> JwsH <$> parseJSON v+ _ -> 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 = either (Left . BadHeader . T.pack) return $ eitherDecodeStrict' 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,30 @@+Copyright (c) 2014, Luke Taylor+Copyright (c) 2014-2026 The PostgREST contributors++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.+
+ README.md view
@@ -0,0 +1,68 @@+# `jose-jwt`++A Haskell implementation of the JSON Object Signing and Encryption (JOSE) specifications and the related [JWT specification](http://tools.ietf.org/html/draft-ietf-oauth-json-web-token), as used, for example, in [OpenID Connect](http://openid.net/connect/).++This is a fork of https://github.com/tekul/jose-jwt that uses https://github.com/haskell-cryptography/botan for better performance.++It requires the `botan` C++ library, see more details on https://github.com/haskell-cryptography/botan#installation++## Background++The [JWT specification](https://tools.ietf.org/html/rfc7519) was split into [`JWS`](https://www.rfc-editor.org/rfc/rfc7515.html) and [`JWE`](https://www.rfc-editor.org/rfc/rfc7516.html) during its development so does not contain much. A JWT is either a JWS or a JWE depending on whether it is signed or encrypted. It is encoded as a sequence of base64 strings separated by '.' characters [1].++Technically, the content of a JWT should be JSON (unless it's a nested JWT), but this library doesn't care - it only requires a bytestring. The application should verify that the content is valid. Exactly what that means will depend on what you are using JWTs for.++## Examples++You can either use the high-level `encode` and `decode` functions in the [`Jwt`](https://hackage.haskell.org/package/jose-jwt/docs/Jose-Jwt.html) module or specific functions in the [`Jws`](https://hackage.haskell.org/package/jose-jwt/docs/Jose-Jws.html) and [`Jwe`](https://hackage.haskell.org/package/jose-jwt/docs/Jose-Jwe.html) modules.++The following examples can be entered directly into `ghci`. Use++ > :set -XOverloadedStrings++to begin with.++### JWS signing example with a symmetric HMAC algorithm++HMAC is a good choice when both signer and verifier have a copy of the key.++ > import Jose.Jws (hmacEncode, hmacDecode)+ > import Jose.Jwa (JwsAlg(HS256))+ >+ > hmacEncode HS256 "aRANDOMlygeneratedkey" "my JSON message"+ Right (Jwt {unJwt = "eyJhbGciOiJIUzI1NiJ9.bXkgSlNPTiBtZXNzYWdl.lTJx7ECLwYF3P7WbrrUpcp_2SdLiFXaDwK-PXcipt5Q"})+ > hmacDecode "aRANDOMlygeneratedkey" "eyJhbGciOiJIUzI1NiJ9.bXkgSlNPTiBtZXNzYWdl.lTJx7ECLwYF3P7WbrrUpcp_2SdLiFXaDwK-PXcipt5Q"+ Right (JwsHeader {jwsAlg = HS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Nothing},"my JSON message")++Trying to decode with a different key would return a `Left BadSignature` [2].++### JWS signing using Ed25519 private key++Some situations require the use of public key cryptography for signing. For example, only a trusted party is allowed to create a signed token, but it must be verified by others.++Elliptic-curve EdDSA signing and verification are supported as defined in [RFC 8037](https://tools.ietf.org/html/rfc8037), as well as the older RSA JWS algorithms.++ > import Jose.Jwt+ > import Jose.Jwk+ > import Jose.Jwa (JwsAlg(EdDSA))+ > import Data.ByteString (ByteString)+ > import Data.Aeson (decodeStrict)+ >+ > jsonJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed25519\", \"d\":\"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A\", \"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}" :: ByteString+ > Just jwk = decodeStrict jsonJwk :: Maybe Jwk+ > Jose.Jwt.encode [jwk] (JwsEncoding EdDSA) (Claims "public claims")+ Right (Jwt {unJwt = "eyJhbGciOiJFZERTQSJ9.cHVibGljIGNsYWltcw.xYekeeGSQVpnQbl16lOCqFcmYsUj3goSTrZ4UBQqogjHLrvFUaVJ_StBqly-Tb-0xvayjUMM4INYBTwFMt_xAQ"})++To verify the JWT you would use the `Jose.Jwt.decode` function with the corresponding public key.++More examples can be found in the [package documentation](https://hackage.haskell.org/package/jose-jwt).++### Build Status++++[1] This is now referred to as "compact serialization". The additional "JSON serialization" is not supported in this library.++[2] Note that a real key for HMAC256 should be a much longer, random string of bytes. See, for example,+[this stackexchange answer](https://crypto.stackexchange.com/a/34866).+
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ benchmarks/Keys.hs view
@@ -0,0 +1,23 @@+module Keys where++import qualified Crypto.PubKey.RSA as RSA+import qualified Data.ByteString as B++jwsHmacKey = B.pack [3, 35, 53, 75, 43, 15, 165, 188, 131, 126, 6, 101, 119, 123, 166, 143, 90, 179, 40, 230, 240, 84, 201, 40, 169, 15, 132, 178, 210, 80, 46, 191, 211, 251, 90, 146, 210, 6, 71, 239, 150, 138, 180, 195, 119, 98, 61, 34, 61, 46, 33, 114, 5, 46, 79, 8, 192, 205, 154, 245, 103, 208, 128, 163]++jwsRsaPrivateKey = RSA.PrivateKey+ { RSA.private_pub = jwsRsaPublicKey+ , RSA.private_d = 2358310989939619510179986262349936882924652023566213765118606431955566700506538911356936879137503597382515919515633242482643314423192704128296593672966061810149316320617894021822784026407461403384065351821972350784300967610143459484324068427674639688405917977442472804943075439192026107319532117557545079086537982987982522396626690057355718157403493216553255260857777965627529169195827622139772389760130571754834678679842181142252489617665030109445573978012707793010592737640499220015083392425914877847840457278246402760955883376999951199827706285383471150643561410605789710883438795588594095047409018233862167884701+ , RSA.private_q = 0+ , RSA.private_p = 0+ , RSA.private_dP = 0+ , RSA.private_dQ = 0+ , RSA.private_qinv = 0+ }++jwsRsaPublicKey = RSA.PublicKey+ { RSA.public_size = 256+ , RSA.public_n = 20446702916744654562596343388758805860065209639960173505037453331270270518732245089773723012043203236097095623402044690115755377345254696448759605707788965848889501746836211206270643833663949992536246985362693736387185145424787922241585721992924045675229348655595626434390043002821512765630397723028023792577935108185822753692574221566930937805031155820097146819964920270008811327036286786392793593121762425048860211859763441770446703722015857250621107855398693133264081150697423188751482418465308470313958250757758547155699749157985955379381294962058862159085915015369381046959790476428631998204940879604226680285601+ , RSA.public_e = 65537+ }+
+ benchmarks/bench.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Criterion.Main+import Crypto.Random+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import Data.Word (Word64)+import Jose.Jws+import qualified Jose.Jwe as Jwe+import Jose.Jwa+import Jose.Jwt+import Jose.Jwk+import Keys++benchRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64++fstWithRNG = fst . withDRG benchRNG++msg = "The best laid schemes o' mice and men"++main = do+ kwKek <- getRandomBytes 32 >>= \k -> return $ SymmetricJwk k Nothing Nothing Nothing :: IO Jwk+ ed25519PrivKey <- Ed25519.generateSecretKey+ ed448PrivKey <- Ed448.generateSecretKey+ let ed25519PubKey = Ed25519.toPublic ed25519PrivKey+ ed448PubKey = Ed448.toPublic ed448PrivKey+ Right rsaOAEPJwe <- Jwe.rsaEncode RSA_OAEP A256GCM jwsRsaPublicKey msg+ Right keywrapJwe <- Jwe.jwkEncode A256KW A256GCM kwKek (Claims msg)++ defaultMain+ [ benchJwsHmac+ , benchJwsRsa+ , benchJwsEd25519 ed25519PrivKey ed25519PubKey+ , benchJwsEd448 ed448PrivKey ed448PubKey+ , benchJweKeywrap (unJwt keywrapJwe) kwKek+ , benchJweRsa (unJwt rsaOAEPJwe)+ ]+++benchJweRsa jwe = bgroup "JWE-RSA"+ [ bench "decode RSA_OAEP" $ nf rsaDecrypt jwe+ ]+ where+ rsaDecrypt m = case fstWithRNG (Jwe.rsaDecode jwsRsaPrivateKey m) of+ Left _ -> error "RSA decode of JWE shouldn't fail"+ Right j -> snd j++benchJweKeywrap jwe jwk = bgroup "JWE-KW"+ [ bench "decode A256KW" $ nf keywrapDecode jwe+ ]+ where+ keywrapDecode m = case fstWithRNG (Jwe.jwkDecode jwk m) of+ Right (Jwe j) -> snd j+ _ -> error "RSA decode of JWE shouldn't fail"+++benchJwsEd25519 kPr kPub = bgroup "Ed25519"+ [ bench "encode Ed25519" $ nf (unJwt . ed25519Encode kPr kPub) msg+ ]++benchJwsEd448 kPr kPub = bgroup "Ed448"+ [ bench "encode Ed448" $ nf (unJwt . ed448Encode kPr kPub) msg+ ]++benchJwsRsa = bgroup "JWS-RSA"+ [ bench "encode RSA256" $ nf (rsaE RS256) msg+ , bench "encode RSA384" $ nf (rsaE RS384) msg+ , bench "encode RSA512" $ nf (rsaE RS512) msg+ ]+ where+ rsaE a m = case fstWithRNG (rsaEncode a jwsRsaPrivateKey m) of+ Left _ -> error "RSA encode shouldn't fail"+ Right (Jwt j) -> j++benchJwsHmac = bgroup "JWS-HMAC"+ [ bench "encode HS256" $ nf (hmacE HS256) msg+ , bench "encode HS384" $ nf (hmacE HS384) msg+ , bench "encode HS512" $ nf (hmacE HS512) msg+ ]+ where+ hmacE a m = case hmacEncode a jwsHmacKey m of+ Left _ -> error "HMAC shouldn't fail"+ Right (Jwt j) -> j
+ benchmarks/loadtest-jwt/Main.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedStrings #-}++-- Tests the performance of JWT verification, see https://github.com/PostgREST/postgrest/issues/5379+module Main where++import Control.DeepSeq (force)+import Control.Exception (evaluate)+import Control.Lens (view)+import Control.Monad (replicateM_)+import Data.Aeson ((.=))+import Data.ByteString (ByteString)+import Data.Functor.Identity (Identity (..))+import GHC.Clock (getMonotonicTimeNSec)+import Text.Printf (printf)+import Prelude++import Crypto.JOSE qualified as JOSE+import Data.Aeson qualified as JSON+import Data.ByteString.Lazy qualified as LBS+import Jose.Jwk qualified as JWT+import Jose.Jwt qualified as JWT+import Options.Applicative qualified as O++main :: IO ()+main = do+ algorithm <- readCLI++ -- init+ (jwsAlgorithm, publicKey, privateKey) <- generateKeyPair algorithm+ tokens' <- mapM (generateToken jwsAlgorithm privateKey) [1 .. uniqueTokens]+ tokens <- evaluate $ force tokens' -- force the evaluation before the verification phase, otherwise due to laziness it will be evaluated later++ -- bench+ startNSecs <- getMonotonicTimeNSec+ replicateM_ times $ mapM_ (verify $ JWT.JwkSet [publicKey]) tokens+ endNSecs <- getMonotonicTimeNSec++ -- report+ let+ totalVerifications = uniqueTokens * times+ benchSeconds = fromIntegral (endNSecs - startNSecs) / 1e9 :: Double+ tokensPerSecond = fromIntegral totalVerifications / benchSeconds+ in+ printf "- %s: %.0f verify/s (%d verifications, %.3fs)\n" (show algorithm) tokensPerSecond totalVerifications benchSeconds+ where+ -- These numbers were hand tuned, if we generate too many unique tokens the signing phase takes too long.+ uniqueTokens = 1000+ -- So we verify the uniqueTokens a number of times. Ed25519 is really fast, if we just run times = 2 then `postgrest-loadtest-jwt` fails because the `monitor_pid.py`+ -- doesn't have a chance to capture the process CPU/MEM. So we choose 10 for good balance.+ times = 10++-- | PostgREST supports more algorithms (see https://github.com/PostgREST/postgrest/issues/5379) but we only load test these variants+data CliAlgorithm = RS256 | ES256 | Ed25519 deriving (Show)++readCLI :: IO CliAlgorithm+readCLI = O.execParser $ O.info (O.helper <*> algo) (O.progDesc "JWT Verification Loadtest")+ where+ algo = O.option (O.eitherReader readAlgo) $ O.long "algorithm"+ readAlgo "RS256" = Right RS256+ readAlgo "ES256" = Right ES256+ readAlgo "Ed25519" = Right Ed25519+ readAlgo _ = Left "Unknown algorithm"++verify :: JWT.JwkSet -> ByteString -> IO ()+verify jwks token = do+ result <- JWT.decode (JWT.keys jwks) Nothing token+ case result of+ Left err ->+ ioError $ userError $ show err+ Right _ ->+ pure () -- just discard the value++generateKeyPair :: CliAlgorithm -> IO (JOSE.Alg, JWT.Jwk, JOSE.JWK)+generateKeyPair algorithm = do+ let (jwsAlgorithm, params) = case algorithm of+ RS256 ->+ -- The key size is taken from the example on hs-jose+ -- https://github.com/frasertweedale/hs-jose/blob/ffd6a66c2e2844ec5e506806963f4e46accf1ae9/src/Crypto/JOSE/JWK.hs#L34+ let keySize = 4096 `div` 8+ in (JOSE.RS256, JOSE.RSAGenParam keySize)+ ES256 -> (JOSE.ES256, JOSE.ECGenParam JOSE.P_256)+ Ed25519 -> (JOSE.EdDSA, JOSE.OKPGenParam JOSE.Ed25519)+ privateKey <- JOSE.genJWK params+ case JSON.fromJSON $ JSON.toJSON $ view JOSE.asPublicKey privateKey of+ JSON.Error err -> ioError $ userError err+ JSON.Success publicKey -> pure (jwsAlgorithm, publicKey, privateKey)++generateToken :: JOSE.Alg -> JOSE.JWK -> Int -> IO ByteString+generateToken alg privateKey tokenId = do+ result <- JOSE.runJOSE $ JOSE.signJWS claims $ Identity (header, privateKey)+ case result :: Either JOSE.Error (JOSE.CompactJWS JOSE.JWSHeader) of+ Left err -> ioError $ userError $ show err+ Right jwt -> pure $ LBS.toStrict $ JOSE.encodeCompact jwt+ where+ header = JOSE.newJWSHeaderProtected alg+ -- This is a representative JWT, similar to one generated on nix/tools/generate_targets.py+ claims = JSON.encode $ JSON.object ["role" .= ("postgrest_test_author" :: String), "sub" .= ("user_" <> show tokenId)]
+ doctests.hs view
@@ -0,0 +1,2 @@+import Test.DocTest+main = doctest ["-XOverloadedStrings", "Jose.Jwt", "Jose.Jws", "Jose.Jwe"]
+ jose-jwt-botan.cabal view
@@ -0,0 +1,127 @@+Name: jose-jwt-botan+Version: 0.12.0+Synopsis: JSON Object Signing and Encryption Library using Botan+Homepage: https://github.com/PostgREST/jose-jwt-botan+Bug-Reports: https://github.com/PostgREST/jose-jwt-botan/issues+Description:+ .+ An implementation of the JOSE suite of IETF standards+ and the closely related JWT (JSON web token) spec+ (<https://tools.ietf.org/html/rfc7519/>).+ .+ Both signed and encrypted JWTs are supported, as well as simple+ JWK keys.++Author: Luke Taylor <tekul.hs@gmail.com>+Maintainer: Steve Chavez <stevechavezast@gmail.com>+License: BSD3+License-File: LICENSE+Build-Type: Simple+Cabal-Version: 1.16+Category: JSON, Cryptography++Extra-Source-Files:+ README.md+ CHANGELOG.md+ tests/*.json++-- disable doctests with -f-doctest+Flag doctest+ default: False+ manual: True++Source-Repository head+ Type: git+ Location: https://github.com/PostgREST/jose-jwt-botan.git++Library+ Default-Language: Haskell2010+ Exposed-modules: Jose.Jwt+ , Jose.Jws+ , Jose.Jwe+ , Jose.Jwa+ , Jose.Jwk+ , Jose.Internal.Base64+ , Jose.Internal.Crypto+ , Jose.Internal.Parser+ Other-Modules: Jose.Types++ if impl(ghc < 8.0)+ Buildable: False+ else+ Build-depends: base >= 4.9 && < 5+ , aeson >= 2 && < 2.4+ , attoparsec >= 0.12.0.0 && < 0.15+ , botan-low >= 0.2 && < 0.3+ , bytestring >= 0.10.8 && < 0.13+ , cereal >= 0.4 && < 0.6+ , crypton >= 1.1.0 && < 2+ , ram >= 0.21 && < 0.23+ , mtl >= 2.2 && < 3+ , text >= 2 && < 3+ , time >= 1.9 && < 2+ , transformers >= 0.6 && < 0.7+ , vector >= 0.11 && < 0.14+ Ghc-Options: -Wall++Test-suite tests+ Default-Language: Haskell2010+ Type: exitcode-stdio-1.0+ Other-Modules: Tests.JwsSpec+ , Tests.JweSpec+ , Tests.JwkSpec+ Build-depends: jose-jwt-botan+ , base >= 4.9 && < 5+ , aeson+ , bytestring+ , crypton >= 1.1.0 && < 2+ , ram+ , vector+ , 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++Test-suite doctests+ Default-Language: Haskell2010+ Type: exitcode-stdio-1.0+ Main-is: doctests.hs+ Default-Extensions: OverloadedStrings++ if !flag(doctest)+ Buildable: False+ else+ Build-depends: base >= 4.9 && < 5+ , doctest >= 0.9.11+ , crypton >= 1.1.0 && < 2++Benchmark bench-jwt+ Default-Language: Haskell2010+ Hs-source-dirs: benchmarks+ Main-is: bench.hs+ Other-Modules: Keys+ Type: exitcode-stdio-1.0+ Build-depends: jose-jwt-botan+ , base >= 4.9 && < 5+ , bytestring+ , criterion+ , crypton >= 1.1.0 && < 2++ Ghc-Options: -Wall -fno-warn-missing-signatures++Benchmark loadtest-jwt+ Default-Language: Haskell2010+ Hs-source-dirs: benchmarks/loadtest-jwt+ Main-is: Main.hs+ Type: exitcode-stdio-1.0+ Build-depends: jose-jwt-botan+ , base >= 4.9 && < 5+ , aeson+ , bytestring+ , deepseq+ , jose >= 0.13 && < 0.14+ , lens+ , optparse-applicative+ Ghc-Options: -Wall -threaded -rtsopts
+ tests/Tests/JweSpec.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-incomplete-uni-patterns #-}++module Tests.JweSpec where++import Data.Aeson (decodeStrict')+import Data.Bits (xor)+import Data.Word (Word8, Word64)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import Test.Hspec+import Test.HUnit hiding (Test)+import Test.QuickCheck++import qualified Crypto.PubKey.RSA as RSA+import Crypto.Hash (SHA1(..), hashDigestSize)+import Crypto.PubKey.RSA.Prim (dp)+import Crypto.PubKey.MaskGenFunction+import Crypto.Cipher.Types (AuthTag(..))+import Crypto.Random (DRG(..), withDRG, drgNewTest)+import Jose.Jwt+import qualified Jose.Jwe as Jwe+import Jose.Jwa+import qualified Jose.Jwk as Jwk+import Jose.Internal.Crypto+import Jose.Internal.Parser(Tag(..), IV(..))+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" $+ withDRG (RNG . BA.convert $ BA.append a1cek a1iv)+ (generateCmkAndIV A256GCM) @?= ((a1cek, a1iv), RNG "")++ it "generates the expected RSA-encrypted content key" $+ withDRG (RNG a1oaepSeed)+ (rsaEncrypt a1PubKey RSA_OAEP a1cek) @?= (Right a1jweKey, RNG "")++ it "encrypts the payload to the expected ciphertext and authentication tag" $ do+ let aad = B64.encode ("{\"alg\":\"RSA-OAEP\",\"enc\":\"A256GCM\"}" :: B.ByteString)+ encryptPayload A256GCM a1cek a1iv aad a1Payload @?= Just (AuthTag a1Tag, a1Ciphertext)++ it "encodes the payload to the expected JWT, leaving the RNG empty" $+ withDRG (RNG $ BA.concat [a1cek, a1iv, BA.convert a1oaepSeed])+ (Jwe.rsaEncode RSA_OAEP A256GCM a1PubKey a1Payload) @?= (Right (Jwt a1), RNG "")++ it "decodes the JWT to the expected header and payload" $+ withBlinder (Jwe.rsaDecode a1PrivKey a1) @?= Right (a1Header, a1Payload)++ it "decodes the JWK to the correct RSA key values" $ do+ let Just (Jwk.RsaPrivateJwk (RSA.PrivateKey pubKey d 0 0 0 0 0) _ _ _) = decodeStrict' a1jwk+ RSA.public_n pubKey @?= a1RsaModulus+ RSA.public_e pubKey @?= rsaExponent+ d @?= a1RsaPrivateExponent++ it "decodes the JWT using the JWK" $ do+ let Just k1 = decodeStrict' a1jwk+ Just k2 = decodeStrict' a2jwk+ withBlinder (decode [k2, k1] (Just $ JweEncoding RSA_OAEP A256GCM) a1) @?= Right (Jwe (a1Header, a1Payload))++ it "a truncated CEK returns BadCrypto" $ do+ let [hdr, _, iv, payload, tag] = BC.split '.' a1+ newEk = encryptCek a1PubKey RSA_OAEP (BA.drop 1 a1cek)+ withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadCrypto++ it "a truncated payload returns BadCrypto" $ do+ let [hdr, ek, iv, payload, tag] = BC.split '.' a1+ Right ct = B64.decode payload+ withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto++ it "a truncated auth tag returns BadCrypto" $ do+ let [hdr, ek, iv, payload, tag] = BC.split '.' a1+ Right tagBytes = B64.decode tag+ badTag = B64.encode $ BC.take 2 tagBytes+ withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, ek, iv, payload, badTag])) @?= Left BadCrypto+++ it "a truncated IV returns BadCrypto" $ do+ let (fore, aft) = BC.breakSubstring (B64.encode a1iv) a1+ newIv = B64.encode (BA.drop 1 a1iv)+ withBlinder (Jwe.rsaDecode a1PrivKey (B.concat [fore, newIv, aft])) @?= Left BadCrypto+++ context "when using JWE Appendix 2 data" $ do+ let a2Header = defJweHdr {jweAlg = RSA1_5, jweEnc = A128CBC_HS256}+ let aad = B64.encode ("{\"alg\":\"RSA1_5\",\"enc\":\"A128CBC-HS256\"}" :: B.ByteString)++ it "generates the expected RSA-encrypted content key" $+ withDRG (RNG a2seed) (rsaEncrypt a2PubKey RSA1_5 a2cek) @?= (Right a2jweKey, RNG "")++ it "encrypts the payload to the expected ciphertext and authentication tag" $+ encryptPayload A128CBC_HS256 a2cek a2iv aad a2Payload @?= Just (AuthTag (BA.convert a2Tag), a2Ciphertext)++ it "encodes the payload to the expected JWT" $+ withDRG (RNG $ BA.concat [BA.convert a2cek, a2iv, a2seed])+ (Jwe.rsaEncode RSA1_5 A128CBC_HS256 a2PubKey a2Payload) @?= (Right (Jwt a2), RNG "")++ it "decrypts the ciphertext to the correct payload" $+ decryptPayload A128CBC_HS256 a2cek (IV16 a2iv) aad (Tag16 a2Tag) a2Ciphertext @?= Just a2Payload++ it "decodes the JWT to the expected header and payload" $+ withBlinder (Jwe.rsaDecode a2PrivKey a2) @?= Right (a2Header, a2Payload)++ it "a truncated CEK returns BadCrypto" $ do+ let [hdr, _, iv, payload, tag] = BC.split '.' a2+ newEk = encryptCek a2PubKey RSA1_5 (BA.drop 1 a2cek)+ withBlinder (Jwe.rsaDecode a2PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadCrypto++ it "a truncated payload returns BadCrypto" $ do+ let [hdr, ek, iv, payload, tag] = BC.split '.' a2+ Right ct = B64.decode payload+ withBlinder (Jwe.rsaDecode a2PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto++ it "a truncated IV returns BadCrypto" $ do+ let (fore, aft) = BC.breakSubstring (B64.encode a2iv) a2+ newIv = B64.encode (B.tail a2iv)+ withBlinder (Jwe.rsaDecode a2PrivKey (B.concat [fore, newIv, aft])) @?= Left BadCrypto++ context "when using JWE Appendix 3 data" $ do+ let Just jwk = decodeStrict' a3jwk+ a3Header = defJweHdr {jweAlg = A128KW, jweEnc = A128CBC_HS256}+ it "encodes the payload to the expected JWT" $+ withDRG (RNG $ B.concat [a3cek, a3iv])+ (Jwe.jwkEncode A128KW A128CBC_HS256 jwk (Claims a3Payload)) @?= (Right (Jwt a3), RNG "")++ it "decodes the JWT using the JWK" $+ withBlinder (decode [jwk] Nothing a3) @?= Right (Jwe (a3Header, a3Payload))++ context "when used with quickcheck" $ do+ it "padded msg is always a multiple of 16" $ property $+ \s -> B.length (pad (B.pack s)) `mod` 16 == 0+ it "unpad is the inverse of pad" $ property $+ \s -> let msg = B.pack s in (unpad . pad) msg == Just msg+ it "jwe decode/decode returns the original payload" $ property jweRoundTrip++ context "miscellaneous tests" $ do+ it "Padding byte larger than 16 is rejected" $+ up "111a" @?= Nothing+ it "Padding byte which doesn't match padding length is rejected" $+ up "111\t\t\t\t\t\t\t" @?= Nothing+ it "Padding byte which matches padding length is OK" $+ up "1111111\t\t\t\t\t\t\t\t\t" @?= Just "1111111"+ it "Rejects invalid Base64 JWT" $+ withBlinder (Jwe.rsaDecode a2PrivKey "=.") @?= Left BadCrypto++up :: BC.ByteString -> Maybe BC.ByteString+up = unpad++-- verboseQuickCheckWith quickCheckWith stdArgs {maxSuccess=10000} jweRoundTrip+jweRoundTrip :: RNG -> JWEAlgs -> [Word8] -> Bool+jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (Jwe (defJweHdr {jweAlg = a, jweEnc = e }, bs))+ where+ jwks = [a1jwk, a2jwk, a3jwk, aes192jwk, aes256jwk] >>= \j -> let Just jwk = decodeStrict' j in [jwk]+ bs = B.pack msg+ encodeDecode = fst (withDRG blinderRNG (decode jwks Nothing encoded))+ Right encoded = unJwt <$> fst (withDRG g (encode jwks (JweEncoding a e) (Claims bs)))++encryptCek kpub a cek =+ let+ (Right newEk, _) = withDRG blinderRNG $ rsaEncrypt kpub a (BA.drop 1 cek)+ in+ newEk :: BC.ByteString++withBlinder = fst . withDRG blinderRNG++-- A decidedly non-random, random number generator which allows specific+-- sequences of bytes to be supplied which match the JWE test data.+newtype RNG = RNG B.ByteString deriving (Eq, Show)++genBytes :: BA.ByteArray ba => Int -> RNG -> (ba, RNG)+genBytes 0 g = (BA.empty, g)+genBytes n (RNG bs) = (BA.convert bytes, RNG next)+ where+ (bytes, next) = if BA.null bs+ then error "RNG is empty"+ else BA.splitAt n bs++instance DRG RNG where+ randomBytesGenerate = genBytes++blinderRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64++--------------------------------------------------------------------------------+-- JWE Appendix 1 Test Data+--------------------------------------------------------------------------------++a1 :: B.ByteString+a1 = "eyJhbGciOiJSU0EtT0FFUCIsImVuYyI6IkEyNTZHQ00ifQ.OKOawDo13gRp2ojaHV7LFpZcgV7T6DVZKTyKOMTYUmKoTCVJRgckCL9kiMT03JGeipsEdY3mx_etLbbWSrFr05kLzcSr4qKAq7YN7e9jwQRb23nfa6c9d-StnImGyFDbSv04uVuxIp5Zms1gNxKKK2Da14B8S4rzVRltdYwam_lDp5XnZAYpQdb76FdIKLaVmqgfwX7XWRxv2322i-vDxRfqNzo_tETKzpVLzfiwQyeyPGLBIO56YJ7eObdv0je81860ppamavo35UgoRdbYaBcoh9QcfylQr66oc6vFWXRcZ_ZT2LawVCWTIy3brGPi6UklfCpIMfIjf7iGdXKHzg.48V1_ALb6US04U3b.5eym8TW_c8SuK0ltJ3rpYIzOeDQz7TALvtu6UG9oMo4vpzs9tX_EFShS8iB7j6jiSdiwkIr3ajwQzaBtQD_A.XFBoMYUZodetZdvTiFvSkQ"++a1Payload = "The true sign of intelligence is not knowledge but imagination."++a1cek :: BA.ScrubbedBytes+a1cek = BA.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 :: BA.ScrubbedBytes+a1iv = BA.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 = BA.pack [92, 80, 104, 49, 133, 25, 161, 215, 173, 101, 219, 211, 136, 91, 210, 145]++Right a1jweKey = B64.decode $ BC.pack "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 :: BA.ScrubbedBytes+a2cek = BA.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 $ BC.pack "UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A"++a2jwk = "{\"kty\":\"RSA\", \"n\":\"sXchDaQebHnPiGvyDOAT4saGEUetSyo9MKLOoWFsueri23bOdgWp4Dy1WlUzewbgBHod5pcM9H95GQRV3JDXboIRROSBigeC5yjU1hGzHHyXss8UDprecbAYxknTcQkhslANGRUZmdTOQ5qTRsLAt6BTYuyvVRdhS8exSZEy_c4gs_7svlJJQ4H9_NxsiIoLwAEk7-Q3UXERGYw_75IDrGA84-lA_-Ct4eTlXHBIY2EaV7t7LjJaynVJCpkv4LKjTTAumiGUIuQhrNhZLuF_RJLqHpM2kgWFLU7-VTdL1VbC2tejvcI2BlMkEpk1BzBZI0KQB0GaDWFLN-aEAw3vRw\", \"e\":\"AQAB\", \"d\":\"VFCWOqXr8nvZNyaaJLXdnNPXZKRaWCjkU5Q2egQQpTBMwhprMzWzpR8Sxq1OPThh_J6MUD8Z35wky9b8eEO0pwNS8xlh1lOFRRBoNqDIKVOku0aZb-rynq8cxjDTLZQ6Fz7jSjR1Klop-YKaUHc9GsEofQqYruPhzSA-QgajZGPbE_0ZaVDJHfyd7UUBUKunFMScbflYAAOYJqVIVwaYR5zWEEceUjNnTNo_CVSj-VvXLO5VZfCUAVLgW4dpf1SrtZjSt34YLsRarSb127reG_DUwg9Ch-KyvjT1SkHgUWRVGcyly7uvVGRSDwsXypdrNinPA4jlhoNdizK2zF2CWQ\" }"++a2RsaModulus = 22402924734748322419583087865046136971812964522608965289668050862528140628890468829261358173206844190609885548664216273129288787509446229835492005268681636400878070687042995563617837593077316848511917526886594334868053765054121327206058496913599608196082088434862911200952954663261204130886151917541465131565772711448256433529200865576041706962504490609565420543616528240562874975930318078653328569211055310553145904641192292907110395318778917935975962359665382660933281263049927785938817901532807037136641587608303638483543899849101763615990006657357057710971983052920787558713523025279998057051825799400286243909447++a2RsaPrivateExponent = 10643756465292254988457796463889735064030094089452909840615134957452106668931481879498770304395097541282329162591478128330968231330113176654221501869950411410564116254672288216799191435916328405513154035654178369543717138143188973636496077305930253145572851787483810154020967535132278148578697716656066036003388130625459567907864689911133288140117207430454310073863484450086676106606775792171446149215594844607410066899028283290532626577379520547350399030663657813726123700613989625283009134539244470878688076926304079342487789922656366430636978871435674556143884272163840709196449089335092169596187792960067104244313++a2 :: B.ByteString+a2 = "eyJhbGciOiJSU0ExXzUiLCJlbmMiOiJBMTI4Q0JDLUhTMjU2In0.UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A.AxY8DCtDaGlsbGljb3RoZQ.KDlTtXchhZTGufMYmOYGS4HffxPSUrfmqCHXaI9wOGY.9hH0vgRfYgPnAHOd8stkvw"++(a2PubKey, a2PrivKey) = createKeyPair a2RsaModulus a2RsaPrivateExponent++a2seed = extractPKCS15Seed a2PrivKey a2jweKey++a3Payload = a2Payload++a3jwk = "{\"kty\":\"oct\", \"k\":\"GawgguFyGrWKav7AX4VKUg\"}"++-- We need keys that are valid for AES192 and AES256 for quickcheck tests+aes192jwk = "{\"kty\":\"oct\", \"k\":\"FatNm7ez26tyPGsXdaqhYHtvThX0jSAA\"}"+aes256jwk = "{\"kty\":\"oct\", \"k\":\"1MeiHdxK8CQBsmjgOM8SCxg06MTjFzG7sFa7EnDCJzo\"}"+++a3cek = 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]++a3iv = B.pack [3, 22, 60, 12, 43, 67, 104, 105, 108, 108, 105, 99, 111, 116, 104, 101]++a3 :: B.ByteString+a3 = "eyJhbGciOiJBMTI4S1ciLCJlbmMiOiJBMTI4Q0JDLUhTMjU2In0.6KB707dM9YTIgHtLvtgWQ8mKwboJW3of9locizkDTHzBC2IlrT1oOQ.AxY8DCtDaGlsbGljb3RoZQ.KDlTtXchhZTGufMYmOYGS4HffxPSUrfmqCHXaI9wOGY.U0m_YmjN04DJvceFICbCVQ"++++--------------------------------------------------------------------------------+-- Quickcheck Stuff+--------------------------------------------------------------------------------++-- Valid JWE Alg/Enc combinations+data JWEAlgs = JWEAlgs JweAlg Enc deriving Show++instance Arbitrary Enc where+ arbitrary = elements [A128CBC_HS256, A192CBC_HS384, A256CBC_HS512, A128GCM, A192GCM, A256GCM]++instance Arbitrary JWEAlgs where+ arbitrary = do+ a <- elements [RSA1_5, RSA_OAEP, RSA_OAEP_256, A128KW, A192KW, A256KW]+ e <- arbitrary+ 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+ hashLen = hashDigestSize SHA1+ 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/JwkSpec.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE OverloadedStrings, CPP #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}++module Tests.JwkSpec where++import Test.Hspec+import Test.HUnit hiding (Test)++import Data.Aeson+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as KM+#else+import qualified Data.HashMap.Strict as H+#endif+import qualified Data.ByteString.Char8 as B+import Data.Word (Word64)+import qualified Data.Vector as V+import Crypto.PubKey.ECC.ECDSA+import Crypto.PubKey.ECC.Types+import Crypto.Random (drgNewTest, withDRG)++import Jose.Jwt (defJwsHdr, JwsHeader(..), KeyId(..))+import Jose.Jwk+import Jose.Jwa++spec :: Spec+spec = do+ jwkFile <- runIO (B.readFile "tests/jwks.json")+ let Just (Object keySet) = decodeStrict jwkFile+ Success s = fromJSON (Object keySet) :: Result JwkSet+ Just s' = decode (encode s)+ Just s'' = decode' (encode s')+ kss = keys s'+ k0 = head kss+ k1 = kss !! 1+ k3 = kss !! 3+ k4 = kss !! 4+ describe "JWK encoding and decoding" $ do+ it "decodes and encodes an entire key set successfully" $ do+ let RsaPublicJwk _ key0Id key0Use a0 = k0+ RsaPublicJwk _ key1Id key1Use _ = k1+ EcPublicJwk k key2Id key2Use _ _ = kss !! 2+ EcPublicJwk _ key3Id key3Use _ _ = k3+ SymmetricJwk _ key4Id Nothing _ = k4+ EcPublicJwk _ key5Id (Just Enc) _ _ = kss !! 5+ RsaPublicJwk _ key6Id Nothing a6 = kss !! 6+ EcPrivateJwk _ key7Id (Just Enc) _ _ = kss !! 7+ RsaPrivateJwk _ _ Nothing a8 = kss !! 8+ Ed25519PrivateJwk _ _ key9Id = kss !! 9+ Ed25519PublicJwk _ key10Id = kss !! 10+ Success utcKeyId = fromJSON (String "2015-05-16T18:00:14.259Z")+ length kss @?= 14+ a0 @?= Nothing+ key0Id @?= Just (KeyId "a0")+ key1Id @?= Just (KeyId "a1")+ key2Id @?= Just (KeyId "a2")+ public_curve k @?= getCurveByName SEC_p256r1+ key3Id @?= Just (KeyId "a3")+ key4Id @?= Just (KeyId "HMAC key used in JWS A.1 example")+ key5Id @?= Just (KeyId "1")+ key6Id @?= Just (UTCKeyId utcKeyId)+ key7Id @?= Just (KeyId "1")+ key9Id @?= Just (KeyId "rfc8037SecretKey")+ key10Id @?= Just (KeyId "rfc8037PublicKey")+ key0Use @?= Just Enc+ key1Use @?= Just Sig+ key2Use @?= Just Sig+ key3Use @?= Just Enc+ a6 @?= Just (Signed RS256)+ a8 @?= Just (Signed RS256)+ isPublic k3 @?= True+ isPublic k4 @?= False+ isPrivate k4 @?= False+ it "shameless Show and Eq coverage boosting" $ do+ s' @?= s''+ assertBool "Different sets aren't equal" (s' /= JwkSet { keys = take 8 kss ++ [k0]})+ assertBool "Show stuff" $ showCov s' && showCov k0 && showCov k3 && showCov Sig+ assertBool "Different keys should be unequal" (k0 /= k1)++ describe "Errors in JWK data" $ do+#if MIN_VERSION_aeson(2,0,0)+ let Just (Array ks) = KM.lookup "keys" keySet+#else+ let Just (Array ks) = H.lookup "keys" keySet+#endif+ Object k0obj = V.head ks+ it "invalid Base64 returns an error" $ do+#if MIN_VERSION_aeson(2,0,0)+ let result = fromJSON (Object $ KM.insert "n" (String "NotBase64**") k0obj) :: Result Jwk+#else+ let result = fromJSON (Object $ H.insert "n" (String "NotBase64**") k0obj) :: Result Jwk+#endif+ case result of+ Error _ -> assertBool "" True+ _ -> assertFailure "Expected an error for invalid base 64"++ describe "JWK Algorithm matching" $ do+ let jwks = keys s+ it "finds one key for RS256 encoding" $ do+ -- Only the RSA Private key+ let jwks' = filter (canEncodeJws RS256) jwks+ length jwks' @?= 1++ it "finds 3 keys for RS256 decoding with no kid" $ do+ -- All RSA keys are valid except for the "enc" one+ let jwks' = filter (canDecodeJws (defJwsHdr {jwsAlg = RS256})) jwks+ length jwks' @?= 3++ it "finds one key for RS256 decoding with kid specified" $ do+ let jwks' = filter (canDecodeJws (defJwsHdr {jwsAlg = RS256, jwsKid = Just (KeyId "a1")})) jwks+ length jwks' @?= 1++ it "finds an RS1_5 key for encoding" $ do+ -- Only key a0 matches. The other 3 RSA keys are signing keys+ let jwks' = filter (canEncodeJwe RSA1_5) jwks+ length jwks' @?= 1++ describe "RSA Key generation" $ do+ let rng = drgNewTest (w, w, w, w, w) where w = 1 :: Word64+ kid = KeyId "mykey"+ ((kPub, kPr), _) = withDRG rng (generateRsaKeyPair 512 kid Sig Nothing)+ it "keys generated with same RNG are equal" $ do+ let ((kPub', kPr'), _) = withDRG rng (generateRsaKeyPair 512 kid Sig Nothing)+ kPub' @?= kPub+ kPr' @?= kPr+ it "isPublic and isPrivate are correct for RSA keys" $ do+ isPublic kPub @?= True+ isPublic kPr @?= False+ isPrivate kPr @?= True+ it "keys have supplied ID" $ do+ jwkId kPr @?= Just kid+ jwkId kPub @?= Just kid+ it "keys have supplied use" $ do+ jwkUse kPr @?= Just Sig+ jwkUse kPub @?= Just Sig+ where+ showCov x = showList [x] `seq` showsPrec 1 x `seq` show x `seq` True
+ tests/Tests/JwsSpec.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-incomplete-uni-patterns #-}++module Tests.JwsSpec where++import Test.Hspec+import Test.HUnit hiding (Test)++import Data.Aeson (decodeStrict')+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 ()+import Data.Word (Word64)+import Crypto.Hash.Algorithms (SHA256(..))+import Crypto.MAC.HMAC (HMAC, hmac)+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Types as ECC+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.Ed448 as Ed448+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.PKCS15 as RSAPKCS15+import Crypto.Random (withDRG, drgNewTest)++import Jose.Jwt as Jwt+import Jose.Jwk (Jwk(..), JwkSet(..), EcCurve(..))+import Jose.Jwa+import qualified Jose.Internal.Base64 as B64+import qualified Jose.Jws as Jws+++testRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64++fstWithRNG = fst . withDRG testRNG++{-- Examples from the JWS appendix A --}++spec :: Spec+spec = do+ describe "JWS encoding and decoding" $ do+ context "when using JWS Appendix A.1 data" $ do+ let a11decoded = Right (defJwsHdr {jwsAlg = HS256, jwsTyp = Just "JWT"}, a11Payload)+ it "decodes the JWT to the expected header and payload" $+ Jws.hmacDecode hmacKey a11 @?= a11decoded++ it "encodes the payload to the expected JWT" $+ signWithHeader a11mac a11Header a11Payload @?= a11++ it "decodes the payload using the JWK" $ do+ let Just k11 = decodeStrict' a11jwk+ fstWithRNG (Jwt.decode [k11] Nothing a11) @?= fmap Jws a11decoded++ it "encodes/decodes using HS512" $+ hmacRoundTrip HS512 a11Payload++ it "encodes/decodes using HS384" $+ hmacRoundTrip HS384 a11Payload++ 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 "decodes the JWT to the expected header and payload with the JWK" $ do+ let Just k21 = decodeStrict' a21jwk+ fstWithRNG (Jwt.decode [k21] (Just (JwsEncoding RS256)) a21) @?= (Right $ Jws (defJwsHdr {jwsAlg = RS256}, a21Payload))++ it "decodes the successfully without verification" $ do+ let Right (_, claims) = decodeClaims a21 :: Either JwtError (JwtHeader, JwtClaims)+ jwtIss claims @?= Just "joe"++ it "encodes the payload to the expected JWT" $ do+ let sign = either (error "Sign failed") id . RSAPKCS15.sign Nothing (Just SHA256) rsaPrivateKey+ signWithHeader 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++ context "when using JWS Appendix A.3 data" $ do+ let a31decoded = Right (defJwsHdr {jwsAlg = ES256}, a31Payload)+ it "decodes the JWT to the expected header and payload" $ do+ let Just k31 = decodeStrict' a31jwk+ fstWithRNG (Jwt.decode [k31] Nothing a31) @?= fmap Jws a31decoded++ it "does not evaluate another key after successful verification" $ do+ let Just k31 = decodeStrict' a31jwk+ fstWithRNG (Jwt.decode [k31, error "second key"] Nothing a31)+ @?= fmap Jws a31decoded++ it "tries another key after a mismatch and stops after success" $ do+ Just (JwkSet fixtureKeys) <- decodeStrict' <$> B.readFile "tests/jwks.json"+ wrongKey@(EcPublicJwk _ _ _ _ P_256) <- pure (fixtureKeys !! 2) -- kid "a2"+ let Just k31 = decodeStrict' a31jwk+ fstWithRNG (Jwt.decode [wrongKey, k31, error "key after success"] Nothing a31)+ @?= fmap Jws a31decoded++ it "tries another key after trying an invalid key" $ do+ -- Botan fails loading when the public key is (0, 0) or negative, see:+ -- + pubkey_load_ec: https://github.com/randombit/botan/blob/3.12.0/src/lib/ffi/ffi_pkey_algs.cpp#L120-L140 (notice BOTAN_FFI_ERROR_BAD_PARAMETER)+ -- + from_bigint_xy: https://github.com/randombit/botan/blob/3.12.0/src/lib/pubkey/ec_group/ec_apoint.cpp#L93-L108+ -- As per the commit message https://github.com/randombit/botan/commit/79b312adba6ce167c4f6fdd4c5d57492f52ce6cf, these points are invalid "..not on the curve".+ let invalidPublic = ECDSA.PublicKey (ECC.getCurveByName ECC.SEC_p256r1) (ECC.Point 0 0)+ invalidKey = EcPublicJwk invalidPublic Nothing Nothing Nothing P_256+ Just k31 = decodeStrict' a31jwk+ fstWithRNG (Jwt.decode [invalidKey, k31, error "key after success"] Nothing a31)+ @?= fmap Jws a31decoded++ context "when using an unsecured JWT" $ do+ it "returns an error if chosen alg is unset" $+ fstWithRNG (Jwt.decode [] Nothing jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'")+ it "returns an error if chosen alg is not 'none'" $+ fstWithRNG (Jwt.decode [] (Just (JwsEncoding RS256)) jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'")+ it "decodes the JWT to the expected header and payload if chosen alg is 'none'" $+ fstWithRNG (Jwt.decode [] (Just (JwsEncoding None)) jwt61) @?= Right (Unsecured jwt61Payload)++ describe "Ed25519 signing and verification" $ do+ context "When using RFC8037 Appendix A data" $ do+ let ed25519JwtDecoded = Right (defJwsHdr { jwsAlg = EdDSA }, ed25519Payload)+ Just pubKey = decodeStrict' ed25519PubJwk+ Just (secKey@(Ed25519PrivateJwk kPr kPub _)) = decodeStrict' ed25519SecJwk+ sign = Ed25519.sign kPr kPub+ it "decodes the JWT to the expected header and payload" $ do+ fstWithRNG (Jwt.decode [pubKey] Nothing ed25519Jwt) @?= fmap Jws ed25519JwtDecoded+ fstWithRNG (Jwt.decode [secKey] Nothing ed25519Jwt) @?= fmap Jws ed25519JwtDecoded++ it "encodes the payload to the exected JWT" $ do+ -- Don't really need signWithHeader here, since our function gives the correct value+ signWithHeader sign ed25519Hdr ed25519Payload @?= ed25519Jwt+ Jws.ed25519Encode kPr kPub ed25519Payload @?= Jwt ed25519Jwt++ it "roundtrip encode/decode" $ do+ let Right (Jwt encoded) = fstWithRNG (Jwt.encode [pubKey, secKey] (JwsEncoding EdDSA) (Claims "hello there"))+ fstWithRNG (Jwt.decode [pubKey] (Just (JwsEncoding EdDSA)) encoded) @?= Right (Jws (defJwsHdr { jwsAlg = EdDSA }, "hello there"))++ it "encoding rejects invalid alg for Ed25519 key" $ do+ fstWithRNG (Jws.jwkEncode RS256 secKey (Claims "hello")) @?= Left (KeyError "Algorithm cannot be used with an Ed25519 key")+ fstWithRNG (Jwt.encode [pubKey, secKey] (JwsEncoding RS256) (Claims "hello")) @?= Left (KeyError "No matching key found for JWS algorithm")++ it "verification fails with invalid alg in header" $ do+ let badJwt = signWithHeader sign a21Header ed25519Payload+ fstWithRNG (Jwt.decode [pubKey] Nothing badJwt) @?= Left (KeyError "No suitable key was found to decode the JWT")++ describe "Ed448 signing and verification" $ do+ let Just pubKey = decodeStrict' ed448PubJwk+ Just (secKey@(Ed448PrivateJwk kPr kPub _)) = decodeStrict' ed448SecJwk+ sign = Ed448.sign kPr kPub++ context "" $ do+ it "JWT is encoded to the expected value" $+ signWithHeader sign ed448Hdr "{}" @?= ed448Jwt++ it "roundtrip encode/decode" $ do+ let Right (Jwt encoded) = fstWithRNG (Jwt.encode [pubKey, secKey] (JwsEncoding EdDSA) (Claims "hello"))+ fstWithRNG (Jwt.decode [pubKey] (Just (JwsEncoding EdDSA)) encoded) @?= Right (Jws (defJwsHdr { jwsAlg = EdDSA }, "hello"))+ Jws.ed448Decode kPub (unJwt (Jws.ed448Encode kPr kPub "hello")) @?= Right (defJwsHdr { jwsAlg = EdDSA }, "hello")+++signWithHeader sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload]+ where+ hdrPayload = B.intercalate "." $ map B64.encode [hdr, payload]++hmacRoundTrip a msg = let Right (Jwt encoded) = Jws.hmacEncode a "asecretkey" msg+ in Jws.hmacDecode "asecretkey" encoded @?= Right (defJwsHdr {jwsAlg = a}, msg)++rsaRoundTrip a msg = let Right (Jwt encoded) = fstWithRNG (Jws.rsaEncode a rsaPrivateKey msg)+ in Jws.rsaDecode rsaPublicKey encoded @?= Right (defJwsHdr {jwsAlg = a}, msg)++-- Ed25519 Data from https://tools.ietf.org/html/rfc8037#appendix-A++ed25519SecJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed25519\", \"d\":\"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A\", \"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}" :: B.ByteString+ed25519PubJwk = "{\"kty\":\"OKP\",\"crv\":\"Ed25519\", \"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}"+ed25519Hdr = "{\"alg\":\"EdDSA\"}" :: B.ByteString+ed25519Payload = "Example of Ed25519 signing"+ed25519Jwt = "eyJhbGciOiJFZERTQSJ9.RXhhbXBsZSBvZiBFZDI1NTE5IHNpZ25pbmc.hgyY0il_MGCjP0JzlnLWG1PPOt7-09PGcvMg3AIbQR6dWbhijcNR4ki4iylGjg5BhVsPt9g7sVvpAr_MuM0KAg"++-- Ed448 Data signed with ruby for comparison++ed448SecJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed448\", \"d\":\"-ox5cBHY-QLR0hRdE2gd97LkQ8oRZCT89ALXm-FqhINLdVEd_PtfHuetZoKeHALqwu-NfuADYDBL\", \"x\": \"BnJNZy1_JXpGRlrNLYsz_9I5NCM-Py39P1kEOyrLRXJj38rnOJe7cJaVsOnPj2NkL_jVtG_qkjOA\" }"+ed448PubJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed448\", \"x\": \"BnJNZy1_JXpGRlrNLYsz_9I5NCM-Py39P1kEOyrLRXJj38rnOJe7cJaVsOnPj2NkL_jVtG_qkjOA\" }"+ed448Hdr = "{\"alg\":\"Ed448\"}" :: B.ByteString+ed448Jwt = "eyJhbGciOiJFZDQ0OCJ9.e30.UlqTx962FvZP1G5pZOrScRXlAB0DJI5dtZkknNTm1E70AapkONi8vzpvKd355czflQdc7uyOzTeAz0-eLvffCKgWm_zebLly7L3DLBliynQk14qgJgz0si-60mBFYOIxRghk95kk5hCsFpxpVE45jRIA" :: B.ByteString+++-- Unsecured JWT from section 6.1+jwt61 = "eyJhbGciOiJub25lIn0.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ."+jwt61Payload = a11Payload++a11Header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" :: B.ByteString+a11Payload = "{\"iss\":\"joe\",\r\n \"exp\":1300819380,\r\n \"http://example.com/is_root\":true}"+a11 = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk"+a11jwk = "{\"kty\":\"oct\", \"k\":\"AyM1SysPpbyDfgZld3umj1qzKObwVMkoqQ-EstJQLr_T-1qS0gZH75aKtMN3Yj0iPS4hcgUuTwjAzZr1Z9CAow\" }"+++a21Header = "{\"alg\":\"RS256\"}" :: B.ByteString+a21Payload = a11Payload+a21 = "eyJhbGciOiJSUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.cC4hiUPoj9Eetdgtv3hF80EGrhuB__dzERat0XF9g2VtQgr9PJbu3XOiZj5RZmh7AAuHIm4Bh-0Qc_lF5YKt_O8W2Fp5jujGbds9uJdbF9CUAr7t1dnZcAcQjbKBYNX4BAynRFdiuB--f_nZLgrnbyTyWzO75vRK5h6xBArLIARNPvkSjtQBMHlb1L07Qe7K0GarZRmB_eSN9383LcOLn6_dO--xi12jzDwusC-eOkHWEsqtFZESc6BfI7noOPqvhJ1phCnvWh6IeYI2w9QOYEUipUTI8np6LbgGY9Fs98rqVt5AXLIhWkWywlVmtVrBp0igcN_IoypGlUPQGe77Rw"+a21jwk = "{\"kty\":\"RSA\", \"n\":\"ofgWCuLjybRlzo0tZWJjNiuSfb4p4fAkd_wWJcyQoTbji9k0l8W26mPddxHmfHQp-Vaw-4qPCJrcS2mJPMEzP1Pt0Bm4d4QlL-yRT-SFd2lZS-pCgNMsD1W_YpRPEwOWvG6b32690r2jZ47soMZo9wGzjb_7OMg0LOL-bSf63kpaSHSXndS5z5rexMdbBYUsLA9e-KXBdQOS-UTo7WTBEMa2R2CapHg665xsmtdVMTBQY4uDZlxvb3qCo5ZwKh9kG4LT6_I5IhlJH7aGhyxXFvUK-DWNmoudF8NAco9_h9iaGNj8q2ethFkMLs91kzk2PAcDTW9gb54h4FRWyuXpoQ\", \"e\":\"AQAB\", \"d\":\"Eq5xpGnNCivDflJsRQBXHx1hdR1k6Ulwe2JZD50LpXyWPEAeP88vLNO97IjlA7_GQ5sLKMgvfTeXZx9SE-7YwVol2NXOoAJe46sui395IW_GO-pWJ1O0BkTGoVEn2bKVRUCgu-GjBVaYLU6f3l9kJfFNS3E0QbVdxzubSu3Mkqzjkn439X0M_V51gfpRLI9JYanrC4D4qAdGcopV_0ZHHzQlBjudU2QvXt4ehNYTCBr6XCLQUShb1juUO1ZdiYoFaFQT5Tw8bGUl_x_jTj3ccPDVZFD9pIuhLhBOneufuBiB4cS98l2SR_RQyGWSeWjnczT0QU91p1DhOVRuOopznQ\"}"++a31Header = "{\"alg\":\"ES256\"}" :: B.ByteString+a31Payload = a11Payload+a31 = "eyJhbGciOiJFUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.DtEhU3ljbEg8L38VWAfUAqOyKAM6-Xx-F4GawxaepmXFCgfTjDxw5djxLa8ISlSApmWQxfKTUJqPP3-Kg6NU1Q"+a31jwk = "{\"kty\":\"EC\", \"crv\":\"P-256\", \"x\":\"f83OJ3D2xF1Bg8vub9tLe1gHMzV76e8Tus9uPHvRVEU\", \"y\":\"x_FEzRu9m36HLN_tue659LNpXW6pCyStikYjKIWI5a0\", \"d\":\"jpsQnnGQmL-YBIffH1136cspYG6-0iY7X1fCE9-E9LI\" }"+++hmacKey = B.pack [+ 3, 35, 53, 75, 43, 15, 165, 188, 131, 126, 6, 101, 119, 123, 166,+ 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 :: B.ByteString -> HMAC SHA256+a11mac = hmac hmacKey
+ tests/jwks.json view
@@ -0,0 +1,17 @@+{ "keys" :+ [ {"use": "enc", "n": "vnifEgZCnBxY5UDt3TJXp3_mNv92VWwHoc3B2oCuzgpgNyBwbBVIu3ScaflvQlntSgfo9VHiu16IqPuCOL4FjcY2RUZY7zizUZ2hFmmMThyx4HfTcDMNFOnetB1mKVUQ3gBOFjdnnj9auO4EK22xRcdB704XhES1TtYIiCxxfPOYBysCDHYcR-0KKjUPyXyhBGFoxiUrYP-c14Pf-aKWgNDqVlYlqayw9JHN4QVeJm8M5DHiPOtxO096Mc-5-X5NwXFMTzjywFWzkbFy7XmJj6BDmmh8-WUOBK1a9gy4zTysL9HfNhJIqi3BJUtLM_x2t-ISROm-Ud3y-4xgavXBTw", "e": "AQAB", "kty": "RSA", "kid": "a0"}+ , {"use": "sig", "n": "o9kJbxD1SgwrV_ottw7oHxxkjw83AuRrYbq8PzXDfhmvqvRHjhAOEGk1qDUbI8tkWzXsTuy-0UAvI9Xt3Qqmmk1MSkAx6K355_J1ofTafH5VrtPavC7HMVnz1zDebgwJH869jWHFghzL0Nr32zq4_V-gpt-zugKFpQi_LA9dtuAjcSTCMnDzTMw4WrMbzNOm90q0CkJCrWe6xM9z4Q_GCPgb2S4lsd5iNdtus9pG104wFAkgY7BXNP3hatYa1UVkAQdWMYyQATs6HMBZF4Ljf-upU9ic_vGwTGgunvQ7z29yrAFWaZQ-EqjYUnvQlmPFqMaNxg3TkPIgntqvZOdW_w", "e": "AQAB", "kty": "RSA", "kid": "a1"}+ , {"use": "sig", "crv": "P-256", "kty": "EC", "y": "kgFS_XvVOyuS41mBzmwJa-ik8Cy4rvM3uFncxmi_-Y8", "x": "bjX_T6O5OUW6WALJ173CH34TfzK9zEHycFT6KMWDnow", "kid": "a2"}+ , {"use": "enc", "crv": "P-256", "kty": "EC", "y": "zcOqE_LYsPTf7a9FOFpJiwK2ZQuUmoNLdsY7BRTICN0", "x": "6eXHDpNoiUaAR5Cle6rfmrVgksSagyi8fzvLF1kedKc", "kid": "a3"}+ , {"kty": "oct", "k":"AyM1SysPpbyDfgZld3umj1qzKObwVMkoqQ-EstJQLr_T-1qS0gZH75aKtMN3Yj0iPS4hcgUuTwjAzZr1Z9CAow", "kid":"HMAC key used in JWS A.1 example"}+ , {"kty":"EC", "crv":"P-256", "x":"MKBCTNIcKUSDii11ySs3526iDZ8AiTo7Tu6KPAqv7D4", "y":"4Etl6SRW2YiLUrN5vfvVHuhp7x8PxltmWWlbbM4IFyM", "use":"enc", "kid":"1"}+ , {"kty":"RSA", "n": "0vx7agoebGcQSuuPiLJXZptN9nndrQmbXEps2aiAFbWhM78LhWx4cbbfAAtVT86zwu1RK7aPFFxuhDR1L6tSoc_BJECPebWKRXjBZCiFV4n3oknjhMstn64tZ_2W-5JsGY4Hc5n9yBXArwl93lqt7_RN5w6Cf0h4QyQ5v-65YGjQR0_FDW2QvzqY368QQMicAtaSqzs8KJZgnYb9c7d0zgdAZHzu6qMQvRL5hajrn1n91CbOpbISD08qNLyrdkt-bFTWhAI4vMQFh6WeZu0fM4lFd2NcRwr3XPksINHaQ-G_xBniIqbw0Ls1jF44-csFCur-kEgU8awapJzKnqDKgw", "e":"AQAB", "alg":"RS256", "kid":"2015-05-16T18:00:14.259Z"}+ , {"kty":"EC", "crv":"P-256", "x":"MKBCTNIcKUSDii11ySs3526iDZ8AiTo7Tu6KPAqv7D4", "y":"4Etl6SRW2YiLUrN5vfvVHuhp7x8PxltmWWlbbM4IFyM", "d":"870MB6gfuTJ4HtUnUvYMyJpr5eUZNP4Bk43bVdj3eAE", "use":"enc", "kid":"1"}+ , {"kty":"RSA", "n":"0vx7agoebGcQSuuPiLJXZptN9nndrQmbXEps2aiAFbWhM78LhWx4cbbfAAtVT86zwu1RK7aPFFxuhDR1L6tSoc_BJECPebWKRXjBZCiFV4n3oknjhMstn64tZ_2W-5JsGY4Hc5n9yBXArwl93lqt7_RN5w6Cf0h4QyQ5v-65YGjQR0_FDW2QvzqY368QQMicAtaSqzs8KJZgnYb9c7d0zgdAZHzu6qMQvRL5hajrn1n91CbOpbISD08qNLyrdkt-bFTWhAI4vMQFh6WeZu0fM4lFd2NcRwr3XPksINHaQ-G_xBniIqbw0Ls1jF44-csFCur-kEgU8awapJzKnqDKgw", "e":"AQAB", "d":"X4cTteJY_gn4FYPsXB8rdXix5vwsg1FLN5E3EaG6RJoVH-HLLKD9M7dx5oo7GURknchnrRweUkC7hT5fJLM0WbFAKNLWY2vv7B6NqXSzUvxT0_YSfqijwp3RTzlBaCxWp4doFk5N2o8Gy_nHNKroADIkJ46pRUohsXywbReAdYaMwFs9tv8d_cPVY3i07a3t8MN6TNwm0dSawm9v47UiCl3Sk5ZiG7xojPLu4sbg1U2jx4IBTNBznbJSzFHK66jT8bgkuqsk0GjskDJk19Z4qwjwbsnn4j2WBii3RL-Us2lGVkY8fkFzme1z0HbIkfz0Y6mqnOYtqc0X4jfcKoAC8Q", "p":"83i-7IvMGXoMXCskv73TKr8637FiO7Z27zv8oj6pbWUQyLPQBQxtPVnwD20R-60eTDmD2ujnMt5PoqMrm8RfmNhVWDtjjMmCMjOpSXicFHj7XOuVIYQyqVWlWEh6dN36GVZYk93N8Bc9vY41xy8B9RzzOGVQzXvNEvn7O0nVbfs", "q":"3dfOR9cuYq-0S-mkFLzgItgMEfFzB2q3hWehMuG0oCuqnb3vobLyumqjVZQO1dIrdwgTnCdpYzBcOfW5r370AFXjiWft_NGEiovonizhKpo9VVS78TzFgxkIdrecRezsZ-1kYd_s1qDbxtkDEgfAITAG9LUnADun4vIcb6yelxk", "dp":"G4sPXkc6Ya9y8oJW9_ILj4xuppu0lzi_H7VTkS8xj5SdX3coE0oimYwxIi2emTAue0UOa5dpgFGyBJ4c8tQ2VF402XRugKDTP8akYhFo5tAA77Qe_NmtuYZc3C3m3I24G2GvR5sSDxUyAN2zq8Lfn9EUms6rY3Ob8YeiKkTiBj0", "dq":"s9lAH9fggBsoFR8Oac2R_E2gw282rT2kGOAhvIllETE1efrA6huUUvMfBcMpn8lqeW6vzznYY5SSQF7pMdC_agI3nG8Ibp1BUb0JUiraRNqUfLhcQb_d9GF4Dh7e74WbRsobRonujTYN1xCaP6TO61jvWrX-L18txXw494Q_cgk", "qi":"GyM_p6JrXySiz1toFgKbWV-JdI3jQ4ypu9rbMWx3rQJBfmt0FoYzgUIZEVFEcOqwemRN81zoDAaa-Bk0KWNGDjJHZDdDmFhW3AN7lI-puxk_mHZGJ11rxyR8O55XLSe3SPmRfKwZI6yU24ZxvQKFYItdldUKGzO6Ia6zTKhAVRU", "alg":"RS256", "kid":"2015-05-16T18:00:14.259Z"}+ , {"kty":"OKP","crv":"Ed25519", "d":"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A", "x":"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo", "kid": "rfc8037SecretKey"}+ , {"kty":"OKP","crv":"Ed25519", "x":"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo", "kid": "rfc8037PublicKey"}+ , {"kty": "oct", "alg": "A128KW", "k":"GawgguFyGrWKav7AX4VKUg"}+ , {"kty":"EC","use":"enc","crv":"P-256","kid":"jwe-encryption-key-from-pr-31","key_ops":["encrypt"],"x":"G8CZn6Zo7UqKLhpDFOh9njuDwBRn2xawrvf65c_t1UM","y":"L3tlkG4tQhNitkJp-5XxvqnbgBGjJFpFr-WEyIUbEvA","alg":"ECDH-ES" }+ , {"kty": "hypothetical-new-kty", "alg": "A256KW", "k":"GawgguFyGrWKav7AX4VKUg"}+ ]+}
+ tests/tests.hs view
@@ -0,0 +1,13 @@+module Main where++import Test.Hspec (hspec)++import Tests.JwsSpec+import Tests.JweSpec+import Tests.JwkSpec++main :: IO ()+main = hspec $ do+ Tests.JwsSpec.spec+ Tests.JweSpec.spec+ Tests.JwkSpec.spec