├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── CHANGELOG.md ├── HLint.hs ├── Jose ├── Internal │ ├── Base64.hs │ ├── Crypto.hs │ └── Parser.hs ├── Jwa.hs ├── Jwe.hs ├── Jwk.hs ├── Jws.hs ├── Jwt.hs └── Types.hs ├── LICENSE ├── README.md ├── Setup.hs ├── benchmarks ├── Keys.hs ├── bench.hs └── profile.hs ├── doctests.hs ├── flake.lock ├── flake.nix ├── jose-jwt.cabal ├── new_release.sh ├── stack.yaml └── tests ├── Tests ├── JweSpec.hs ├── JwkSpec.hs └── JwsSpec.hs ├── jwks.json └── tests.hs /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | on: 3 | push: 4 | branches: [main, master] 5 | pull_request: 6 | branches: [main, master] 7 | 8 | # INFO: The following configuration block ensures that only one build runs per branch, 9 | # which may be desirable for projects with a costly build process. 10 | # Remove this block from the CI workflow to let each CI job run to completion. 11 | concurrency: 12 | group: build-${{ github.ref }} 13 | cancel-in-progress: true 14 | 15 | jobs: 16 | build: 17 | name: GHC ${{ matrix.ghc-version }} on ${{ matrix.os }} 18 | runs-on: ${{ matrix.os }} 19 | strategy: 20 | fail-fast: false 21 | matrix: 22 | os: [ubuntu-latest] 23 | ghc-version: ['9.8.1', '9.6.3'] 24 | 25 | # include: 26 | # - os: windows-latest 27 | # ghc-version: '9.8' 28 | # - os: macos-latest 29 | # ghc-version: '9.8' 30 | 31 | steps: 32 | - uses: actions/checkout@v4 33 | 34 | - name: Set up GHC ${{ matrix.ghc-version }} 35 | uses: haskell-actions/setup@v2 36 | id: setup 37 | with: 38 | ghc-version: ${{ matrix.ghc-version }} 39 | # Defaults, added for clarity: 40 | cabal-version: 'latest' 41 | cabal-update: true 42 | 43 | - name: Configure the build 44 | run: | 45 | cabal configure --enable-tests --enable-benchmarks --disable-documentation 46 | cabal build all --dry-run 47 | # The last step generates dist-newstyle/cache/plan.json for the cache key. 48 | 49 | - name: Restore cached dependencies 50 | uses: actions/cache/restore@v3 51 | id: cache 52 | env: 53 | key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} 54 | with: 55 | path: ${{ steps.setup.outputs.cabal-store }} 56 | key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} 57 | restore-keys: ${{ env.key }}- 58 | 59 | - name: Install dependencies 60 | # If we had an exact cache hit, the dependencies will be up to date. 61 | if: steps.cache.outputs.cache-hit != 'true' 62 | run: cabal build all --only-dependencies 63 | 64 | # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. 65 | - name: Save cached dependencies 66 | uses: actions/cache/save@v3 67 | # If we had an exact cache hit, trying to save the cache would error because of key clash. 68 | if: steps.cache.outputs.cache-hit != 'true' 69 | with: 70 | path: ${{ steps.setup.outputs.cabal-store }} 71 | key: ${{ steps.cache.outputs.cache-primary-key }} 72 | 73 | - name: Build 74 | run: cabal build all 75 | 76 | - name: Run tests 77 | run: cabal test all 78 | 79 | - name: Check cabal file 80 | run: cabal check 81 | 82 | - name: Build documentation 83 | run: cabal haddock all 84 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cabal-sandbox 2 | .stack-work/ 3 | cabal.sandbox.config 4 | .ghc.environment* 5 | *.swp 6 | dist/ 7 | dist-newstyle/ 8 | result 9 | *.aes 10 | *.hi 11 | *.o 12 | *.prof 13 | *.ps 14 | *.aux 15 | *.hp 16 | tags 17 | 18 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | 0.10.0 2 | ------ 3 | 4 | * Change to using crypton (see #41). 5 | 6 | 0.9.6 7 | ----- 8 | 9 | * Updated aeson package bound to include 2.2 10 | 11 | 0.9.5 12 | ----- 13 | 14 | * Support for mtl 2.3 15 | 16 | 0.9.4 17 | ----- 18 | 19 | * Support for aeson 2 20 | 21 | 0.9.3 22 | ----- 23 | 24 | * Add upper bound < 1.6 for aeson dependency 25 | * Add Num Instance for IntDate 26 | 27 | 0.9.2 28 | ----- 29 | 30 | * 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). 31 | 32 | 0.9.1 33 | ----- 34 | 35 | * Fix for tests broken due to [different aeson key ordering](https://github.com/commercialhaskell/stackage/issues/5878). 36 | 37 | 0.9.0 38 | ----- 39 | 40 | * Support for EdDSA signing algorithms as defined in [RFC 8037](https://tools.ietf.org/html/rfc8037). 41 | 42 | 0.8.0 43 | ----- 44 | 45 | * The result of the `Jose.Jwt.decodeClaims` function is now polymorphic so it can be used with any `FromJSON` type. 46 | * Only ghc 8 upwards are now supported. 47 | * the RSA-OAEP-256 algorithm is now supported. 48 | 49 | 0.7.8 50 | ----- 51 | 52 | * Switch from EitherT to ExceptT to allow compiling with latest version of 'either' package. 53 | 54 | 0.7.7 55 | ----- 56 | 57 | * User ByteArray and ScrubbedBytes from memory package in preference to ByteString in internal crypto code. 58 | 59 | 0.7.6 60 | ----- 61 | 62 | * Fixed exception when JWT contained invalid Base64 (issue #15). 63 | * Add generateSymmetricKey utility function to Jwk module. 64 | 65 | 0.7.5 66 | ----- 67 | 68 | * A JWT parser is now used to separate parsing and decoding into separate stages (internal change). 69 | 70 | 0.7.4 71 | ----- 72 | 73 | * Stricter checking of AES key lengths when looking for a valid JWK to encode/decode an AES-KW JWT. 74 | 75 | 0.7.3 76 | ----- 77 | 78 | * Add JSON test data to extra-source-files. 79 | 80 | 0.7.2 81 | ----- 82 | 83 | * Remove test dependency on aeson-qq 84 | 85 | 0.7.1 86 | ----- 87 | 88 | * Update cryptonite version to 0.19 to avoid security issues 89 | * Fix broken benchmark code 90 | * Better error message for invalid key length when using AES keywrap 91 | 92 | 0.7 93 | --- 94 | 95 | * Add support for AES key wrap in JWEs. 96 | * Support A192GCM and A192CBC-HS384 algorithms. 97 | * Switch to cryptonite library. 98 | 99 | 0.6.2 100 | ----- 101 | 102 | * Remove dependency on `errors` package. 103 | 104 | 0.6.1 105 | ----- 106 | 107 | * Minor internal changes to fix build on GHC 7.10. 108 | 109 | 0.6 110 | --- 111 | 112 | * Change KeyId type to allow use of a UTCTime string for the identifier. 113 | * Internal crypto fixes to prevent exceptions from external libraries. 114 | 115 | 0.5 116 | --- 117 | 118 | * Add JwtEncoding type. Changes API of `Jwt.encode` and `Jwt.decode`. 119 | 120 | 0.4.2 121 | ----- 122 | 123 | * Fix in the code for finding suitable JWKs for encoding/decoding. 124 | 125 | 0.4.1.1 126 | ------- 127 | 128 | * Added `doctest` flag to cabal file to allow doctests to be disabled. 129 | 130 | 0.4.1 131 | ----- 132 | 133 | * Add cprng-aes dependency to doctests to stop test failure on travis and nixos hydra builds. 134 | 135 | 0.4 136 | --- 137 | 138 | * Changed use of `Jwt` type to represent an encoded JWT. 139 | * Introduced `Payload` type to allow setting the `cty` header value correctly for nested JWTs. 140 | * Added an explicit `Unsecured` type for a decoded JWT, to make it obvious when the content is not signed or encrypted. 141 | * Fixed some bugs in JSON encoding and decoding of EC JWKs. 142 | 143 | 0.3.1 144 | ----- 145 | 146 | Changed the signature of `Jwt.encode` to take a list of `Jwk` rather than a single key. The key will be selected from 147 | the list based on the specified algorithms. 148 | 149 | 0.3 150 | --- 151 | 152 | * New support for JWS validation using elliptic curve algorithms. 153 | * Added `Jwt.encode` function which takes a JWK argument, allowing key data (currently the key ID) to be encoded in the token header. 154 | -------------------------------------------------------------------------------- /HLint.hs: -------------------------------------------------------------------------------- 1 | import "hint" HLint.Default 2 | import "hint" HLint.Builtin.All 3 | 4 | ignore "Use camelCase" = "" 5 | -------------------------------------------------------------------------------- /Jose/Internal/Base64.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, FlexibleContexts, CPP #-} 2 | {-# OPTIONS_HADDOCK hide #-} 3 | 4 | -- | JWT-style base64 encoding and decoding 5 | 6 | module Jose.Internal.Base64 where 7 | 8 | #if MIN_VERSION_mtl(2,2,1) 9 | import Control.Monad.Except 10 | #else 11 | import Control.Monad.Error 12 | #endif 13 | 14 | import Data.ByteArray 15 | import Data.ByteArray.Encoding 16 | 17 | import Jose.Types 18 | 19 | -- | Base64 URL encode without padding. 20 | encode :: (ByteArrayAccess input, ByteArray output) => input -> output 21 | encode = convertToBase Base64URLUnpadded 22 | 23 | -- | Base64 decode. 24 | decode :: (ByteArrayAccess input, ByteArray output, MonadError JwtError m) => input -> m output 25 | decode bs = either (throwError . Base64Error) return $ convertFromBase Base64URLUnpadded bs 26 | -------------------------------------------------------------------------------- /Jose/Internal/Crypto.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# OPTIONS_HADDOCK prune #-} 4 | 5 | -- | Internal functions for encrypting and signing / decrypting 6 | -- and verifying JWT content. 7 | 8 | module Jose.Internal.Crypto 9 | ( hmacSign 10 | , hmacVerify 11 | , ed25519Verify 12 | , ed448Verify 13 | , rsaSign 14 | , rsaVerify 15 | , rsaEncrypt 16 | , rsaDecrypt 17 | , ecVerify 18 | , encryptPayload 19 | , decryptPayload 20 | , generateCmkAndIV 21 | , keyWrap 22 | , keyUnwrap 23 | , pad 24 | , unpad 25 | ) 26 | where 27 | 28 | 29 | import Control.Monad (when, unless) 30 | import Crypto.Error 31 | import Crypto.Cipher.AES 32 | import Crypto.Cipher.Types hiding (IV) 33 | import Crypto.Hash.Algorithms 34 | import Crypto.Number.Serialize (os2ip) 35 | import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 36 | import qualified Crypto.PubKey.Ed25519 as Ed25519 37 | import qualified Crypto.PubKey.Ed448 as Ed448 38 | import qualified Crypto.PubKey.RSA as RSA 39 | import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15 40 | import qualified Crypto.PubKey.RSA.OAEP as OAEP 41 | import Crypto.Random (MonadRandom, getRandomBytes) 42 | import Crypto.MAC.HMAC (HMAC (..), hmac) 43 | import Data.Bits (xor) 44 | import Data.Bifunctor (first) 45 | import Data.ByteArray (ByteArray, ScrubbedBytes) 46 | import qualified Data.ByteArray as BA 47 | import Data.ByteString (ByteString) 48 | import qualified Data.ByteString as B 49 | import qualified Data.Serialize as Serialize 50 | import qualified Data.Text as T 51 | import Data.Word (Word64, Word8) 52 | 53 | import Jose.Jwa 54 | import Jose.Types (JwtError(..)) 55 | import Jose.Internal.Parser (IV(..), Tag(..)) 56 | 57 | rightToMaybe :: Either a b -> Maybe b 58 | rightToMaybe (Right x) = Just x 59 | rightToMaybe Left{} = Nothing 60 | 61 | -- | Sign a message with an HMAC key. 62 | hmacSign :: JwsAlg -- ^ HMAC algorithm to use 63 | -> ByteString -- ^ Key 64 | -> ByteString -- ^ The message/content 65 | -> Either JwtError ByteString -- ^ HMAC output 66 | hmacSign a k m = case a of 67 | HS256 -> Right $ BA.convert (hmac k m :: HMAC SHA256) 68 | HS384 -> Right $ BA.convert (hmac k m :: HMAC SHA384) 69 | HS512 -> Right $ BA.convert (hmac k m :: HMAC SHA512) 70 | _ -> Left $ BadAlgorithm $ T.pack $ "Not an HMAC algorithm: " ++ show a 71 | 72 | -- | Verify the HMAC for a given message. 73 | -- Returns false if the MAC is incorrect or the 'Alg' is not an HMAC. 74 | hmacVerify :: JwsAlg -- ^ HMAC Algorithm to use 75 | -> ByteString -- ^ Key 76 | -> ByteString -- ^ The message/content 77 | -> ByteString -- ^ The signature to check 78 | -> Bool -- ^ Whether the signature is correct 79 | hmacVerify a key msg sig = either (const False) (`BA.constEq` sig) $ hmacSign a key msg 80 | 81 | 82 | -- | Verify an Ed25519 signed message 83 | ed25519Verify :: JwsAlg 84 | -> Ed25519.PublicKey 85 | -> ByteString 86 | -- ^ The message/content 87 | -> ByteString 88 | -- ^ The signature to check 89 | -> Bool 90 | -- ^ Whether the signature is correct 91 | ed25519Verify EdDSA pubKey msg sig = 92 | case Ed25519.signature sig of 93 | CryptoPassed sig_ -> 94 | Ed25519.verify pubKey msg sig_ 95 | _ -> False 96 | ed25519Verify _ _ _ _ = False 97 | 98 | 99 | -- | Verify an Ed448 signed message 100 | ed448Verify :: JwsAlg 101 | -> Ed448.PublicKey 102 | -> ByteString 103 | -- ^ The message/content 104 | -> ByteString 105 | -- ^ The signature to check 106 | -> Bool 107 | -- ^ Whether the signature is correct 108 | ed448Verify EdDSA pubKey msg sig = 109 | case Ed448.signature sig of 110 | CryptoPassed sig_ -> 111 | Ed448.verify pubKey msg sig_ 112 | _ -> False 113 | ed448Verify _ _ _ _ = False 114 | 115 | 116 | -- | Sign a message using an RSA private key. 117 | -- 118 | -- The failure condition should only occur if the algorithm is not an RSA 119 | -- algorithm, or the RSA key is too small, causing the padding of the 120 | -- signature to fail. With real-world RSA keys this shouldn't happen in practice. 121 | rsaSign :: Maybe RSA.Blinder -- ^ RSA blinder 122 | -> JwsAlg -- ^ Algorithm to use. Must be one of @RSA256@, @RSA384@ or @RSA512@ 123 | -> RSA.PrivateKey -- ^ Private key to sign with 124 | -> ByteString -- ^ Message to sign 125 | -> Either JwtError ByteString -- ^ The signature 126 | rsaSign blinder a key msg = case a of 127 | RS256 -> go SHA256 128 | RS384 -> go SHA384 129 | RS512 -> go SHA512 130 | _ -> Left . BadAlgorithm . T.pack $ "Not an RSA algorithm: " ++ show a 131 | where 132 | go h = either (const $ Left BadCrypto) Right $ PKCS15.sign blinder (Just h) key msg 133 | 134 | -- | Verify the signature for a message using an RSA public key. 135 | -- 136 | -- Returns false if the check fails or if the 'Alg' value is not 137 | -- an RSA signature algorithm. 138 | rsaVerify :: JwsAlg -- ^ The signature algorithm. Used to obtain the hash function. 139 | -> RSA.PublicKey -- ^ The key to check the signature with 140 | -> ByteString -- ^ The message/content 141 | -> ByteString -- ^ The signature to check 142 | -> Bool -- ^ Whether the signature is correct 143 | rsaVerify a key msg sig = case a of 144 | RS256 -> go SHA256 145 | RS384 -> go SHA384 146 | RS512 -> go SHA512 147 | _ -> False 148 | where 149 | go h = PKCS15.verify (Just h) key msg sig 150 | 151 | -- | Verify the signature for a message using an EC public key. 152 | -- 153 | -- Returns false if the check fails or if the 'Alg' value is not 154 | -- an EC signature algorithm. 155 | ecVerify :: JwsAlg -- ^ The signature algorithm. Used to obtain the hash function. 156 | -> ECDSA.PublicKey -- ^ The key to check the signature with 157 | -> ByteString -- ^ The message/content 158 | -> ByteString -- ^ The signature to check 159 | -> Bool -- ^ Whether the signature is correct 160 | ecVerify a key msg sig = case a of 161 | ES256 -> go SHA256 162 | ES384 -> go SHA384 163 | ES512 -> go SHA512 164 | _ -> False 165 | where 166 | (r, s) = B.splitAt (B.length sig `div` 2) sig 167 | ecSig = ECDSA.Signature (os2ip r) (os2ip s) 168 | go h = ECDSA.verify h key ecSig msg 169 | 170 | -- | Generates the symmetric key (content management key) and IV 171 | -- 172 | -- Used to encrypt a message. 173 | generateCmkAndIV :: MonadRandom m 174 | => Enc 175 | -- ^ The encryption algorithm to be used 176 | -> m (ScrubbedBytes, ScrubbedBytes) 177 | -- ^ The key, IV 178 | generateCmkAndIV e = do 179 | cmk <- getRandomBytes (keySize e) 180 | iv <- getRandomBytes (ivSize e) -- iv for aes gcm or cbc 181 | return (cmk, iv) 182 | where 183 | keySize A128GCM = 16 184 | keySize A192GCM = 24 185 | keySize A256GCM = 32 186 | keySize A128CBC_HS256 = 32 187 | keySize A192CBC_HS384 = 48 188 | keySize A256CBC_HS512 = 64 189 | 190 | ivSize A128GCM = 12 191 | ivSize A192GCM = 12 192 | ivSize A256GCM = 12 193 | ivSize _ = 16 194 | 195 | -- | Encrypts a message (typically a symmetric key) using RSA. 196 | rsaEncrypt :: (MonadRandom m, ByteArray msg, ByteArray out) 197 | => RSA.PublicKey 198 | -- ^ The encryption key 199 | -> JweAlg 200 | -- ^ The algorithm (@RSA1_5@, @RSA_OAEP@, or @RSA_OAEP_256@) 201 | -> msg 202 | -- ^ The message to encrypt 203 | -> m (Either JwtError out) 204 | -- ^ The encrypted message 205 | rsaEncrypt k a msg = fmap BA.convert <$> case a of 206 | RSA1_5 -> mapErr (PKCS15.encrypt k bs) 207 | RSA_OAEP -> mapErr (OAEP.encrypt (OAEP.defaultOAEPParams SHA1) k bs) 208 | RSA_OAEP_256 -> mapErr (OAEP.encrypt (OAEP.defaultOAEPParams SHA256) k bs) 209 | _ -> return (Left (BadAlgorithm "Not an RSA algorithm")) 210 | where 211 | bs = BA.convert msg 212 | mapErr = fmap (first (const BadCrypto)) 213 | 214 | -- | Decrypts an RSA encrypted message. 215 | rsaDecrypt :: ByteArray ct 216 | => Maybe RSA.Blinder 217 | -> RSA.PrivateKey 218 | -- ^ The decryption key 219 | -> JweAlg 220 | -- ^ The RSA algorithm to use 221 | -> ct 222 | -- ^ The encrypted content 223 | -> Either JwtError ScrubbedBytes 224 | -- ^ The decrypted key 225 | rsaDecrypt blinder rsaKey a ct = BA.convert <$> case a of 226 | RSA1_5 -> mapErr (PKCS15.decrypt blinder rsaKey bs) 227 | RSA_OAEP -> mapErr (OAEP.decrypt blinder (OAEP.defaultOAEPParams SHA1) rsaKey bs) 228 | RSA_OAEP_256 -> mapErr (OAEP.decrypt blinder (OAEP.defaultOAEPParams SHA256) rsaKey bs) 229 | _ -> Left (BadAlgorithm "Not an RSA algorithm") 230 | where 231 | bs = BA.convert ct 232 | mapErr = first (const BadCrypto) 233 | 234 | -- Dummy type to constrain Cipher type 235 | data C c = C 236 | 237 | initCipher :: BlockCipher c => C c -> ScrubbedBytes -> Either JwtError c 238 | initCipher _ k = mapFail (cipherInit k) 239 | 240 | -- Map CryptoFailable to JwtError 241 | mapFail :: CryptoFailable a -> Either JwtError a 242 | mapFail (CryptoPassed a) = return a 243 | mapFail (CryptoFailed e) = Left $ case e of 244 | CryptoError_KeySizeInvalid -> KeyError "cipher key length is invalid" 245 | _ -> BadCrypto 246 | 247 | 248 | -- | Decrypt an AES encrypted message. 249 | decryptPayload :: forall ba. (ByteArray ba) 250 | => Enc 251 | -- ^ Encryption algorithm 252 | -> ScrubbedBytes 253 | -- ^ Content encryption key 254 | -> IV 255 | -- ^ IV 256 | -> ba 257 | -- ^ Additional authentication data 258 | -> Tag 259 | -- ^ The integrity protection value to be checked 260 | -> ba 261 | -- ^ The encrypted JWT payload 262 | -> Maybe ba 263 | decryptPayload enc cek iv_ aad tag_ ct = case (enc, iv_, tag_) of 264 | (A128GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES128) b t 265 | (A192GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES192) b t 266 | (A256GCM, IV12 b, Tag16 t) -> doGCM (C :: C AES256) b t 267 | (A128CBC_HS256, IV16 b, Tag16 t) -> doCBC (C :: C AES128) b t SHA256 16 268 | (A192CBC_HS384, IV16 b, Tag24 t) -> doCBC (C :: C AES192) b t SHA384 24 269 | (A256CBC_HS512, IV16 b, Tag32 t) -> doCBC (C :: C AES256) b t SHA512 32 270 | _ -> Nothing -- This shouldn't be possible if the JWT was parsed first 271 | where 272 | (cbcMacKey, cbcEncKey) = BA.splitAt (BA.length cek `div` 2) cek :: (ScrubbedBytes, ScrubbedBytes) 273 | al = fromIntegral (BA.length aad) * 8 :: Word64 274 | 275 | doGCM :: BlockCipher c => C c -> ByteString -> ByteString -> Maybe ba 276 | doGCM c iv tag = do 277 | cipher <- rightToMaybe (initCipher c cek) 278 | aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv) 279 | aeadSimpleDecrypt aead aad ct (AuthTag $ BA.convert tag) 280 | 281 | doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> ByteString -> ByteString -> a -> Int -> Maybe ba 282 | doCBC c iv tag a tagLen = do 283 | checkMac a tag iv tagLen 284 | cipher <- rightToMaybe (initCipher c cbcEncKey) 285 | iv' <- makeIV iv 286 | unless (BA.length ct `mod` blockSize cipher == 0) Nothing 287 | unpad $ cbcDecrypt cipher iv' ct 288 | 289 | checkMac :: HashAlgorithm a => a -> ByteString -> ByteString -> Int -> Maybe () 290 | checkMac a tag iv l = do 291 | let mac = BA.take l $ BA.convert $ doMac a iv :: BA.Bytes 292 | unless (tag `BA.constEq` mac) Nothing 293 | 294 | doMac :: HashAlgorithm a => a -> ByteString -> HMAC a 295 | doMac _ iv = hmac cbcMacKey (BA.concat [BA.convert aad, iv, BA.convert ct, Serialize.encode al] :: ByteString) 296 | 297 | -- | Encrypt a message using AES. 298 | encryptPayload :: forall ba iv. (ByteArray ba, ByteArray iv) 299 | => Enc 300 | -- ^ Encryption algorithm 301 | -> ScrubbedBytes 302 | -- ^ Content management key 303 | -> iv 304 | -- ^ IV 305 | -> ba 306 | -- ^ Additional authenticated data 307 | -> ba 308 | -- ^ The message/JWT claims 309 | -> Maybe (AuthTag, ba) 310 | -- ^ Ciphertext claims and signature tag 311 | encryptPayload e cek iv aad msg = case e of 312 | A128GCM -> doGCM (C :: C AES128) 313 | A192GCM -> doGCM (C :: C AES192) 314 | A256GCM -> doGCM (C :: C AES256) 315 | A128CBC_HS256 -> doCBC (C :: C AES128) SHA256 16 316 | A192CBC_HS384 -> doCBC (C :: C AES192) SHA384 24 317 | A256CBC_HS512 -> doCBC (C :: C AES256) SHA512 32 318 | where 319 | (cbcMacKey, cbcEncKey) = BA.splitAt (BA.length cek `div` 2) cek :: (ScrubbedBytes, ScrubbedBytes) 320 | al = fromIntegral (BA.length aad) * 8 :: Word64 321 | 322 | doGCM c = do 323 | cipher <- rightToMaybe (initCipher c cek) 324 | aead <- maybeCryptoError (aeadInit AEAD_GCM cipher iv) 325 | return $ aeadSimpleEncrypt aead aad msg 16 326 | 327 | doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> a -> Int -> Maybe (AuthTag, ba) 328 | doCBC c a tagLen = do 329 | cipher <- rightToMaybe (initCipher c cbcEncKey) 330 | iv' <- makeIV iv 331 | let ct = cbcEncrypt cipher iv' (pad msg) 332 | mac = doMac a ct 333 | tag = BA.take tagLen (BA.convert mac) 334 | return (AuthTag tag, ct) 335 | 336 | doMac :: HashAlgorithm a => a -> ba -> HMAC a 337 | doMac _ ct = hmac cbcMacKey (BA.concat [BA.convert aad, BA.convert iv, BA.convert ct, Serialize.encode al] :: ByteString) 338 | 339 | unpad :: (ByteArray ba) => ba -> Maybe ba 340 | unpad bs 341 | | padLen > 16 || padLen /= BA.length padding = Nothing 342 | | BA.any (/= padByte) padding = Nothing 343 | | otherwise = return pt 344 | where 345 | len = BA.length bs 346 | padByte = BA.index bs (len-1) 347 | padLen = fromIntegral padByte 348 | (pt, padding) = BA.splitAt (len - padLen) bs 349 | 350 | pad :: (ByteArray ba) => ba -> ba 351 | pad bs = BA.append bs padding 352 | where 353 | lastBlockSize = BA.length bs `mod` 16 354 | padByte = fromIntegral $ 16 - lastBlockSize :: Word8 355 | padding = BA.replicate (fromIntegral padByte) padByte 356 | 357 | 358 | -- Key wrapping and unwrapping functions 359 | 360 | -- | 361 | keyWrap :: ByteArray ba => JweAlg -> ScrubbedBytes -> ScrubbedBytes -> Either JwtError ba 362 | keyWrap alg kek cek = case alg of 363 | A128KW -> doKeyWrap (C :: C AES128) 364 | A192KW -> doKeyWrap (C :: C AES192) 365 | A256KW -> doKeyWrap (C :: C AES256) 366 | _ -> Left (BadAlgorithm "Not a keywrap algorithm") 367 | where 368 | l = BA.length cek 369 | n = l `div` 8 370 | iv = BA.replicate 8 166 :: ByteString 371 | 372 | doKeyWrap c = do 373 | when (l < 16 || l `mod` 8 /= 0) (Left (KeyError "Invalid content key")) 374 | cipher <- initCipher c kek 375 | let p = toBlocks cek 376 | (r0, r) = foldl (doRound (ecbEncrypt cipher) 1) (BA.convert iv, p) [0..5] 377 | Right $ BA.concat (r0 : r) 378 | 379 | doRound _ _ (a, []) _ = (a, []) 380 | doRound enc i (a, r:rs) j = 381 | let b = enc $ BA.concat [a, r] 382 | t = fromIntegral ((n*j) + i) :: Word8 383 | a' = txor t (BA.take 8 b) 384 | r' = BA.drop 8 b 385 | next = doRound enc (i+1) (a', rs) j 386 | in (fst next, r' : snd next) 387 | 388 | txor :: ByteArray ba => Word8 -> ba -> ba 389 | txor t b = 390 | let n = BA.length b 391 | lastByte = BA.index b (n-1) 392 | initBytes = BA.take (n-1) b 393 | in BA.snoc initBytes (lastByte `xor` t) 394 | 395 | toBlocks :: ByteArray ba => ba -> [ba] 396 | toBlocks bytes 397 | | BA.null bytes = [] 398 | | otherwise = let (b, bs') = BA.splitAt 8 bytes 399 | in b : toBlocks bs' 400 | 401 | keyUnwrap :: ByteArray ba => ScrubbedBytes -> JweAlg -> ba -> Either JwtError ScrubbedBytes 402 | keyUnwrap kek alg encK = case alg of 403 | A128KW -> doUnWrap (C :: C AES128) 404 | A192KW -> doUnWrap (C :: C AES192) 405 | A256KW -> doUnWrap (C :: C AES256) 406 | _ -> Left (BadAlgorithm "Not a keywrap algorithm") 407 | where 408 | l = BA.length encK 409 | n = (l `div` 8) - 1 410 | iv = BA.replicate 8 166 411 | 412 | doUnWrap c = do 413 | when (l < 24 || l `mod` 8 /= 0) (Left BadCrypto) 414 | cipher <- initCipher c kek 415 | let r = toBlocks encK 416 | (p0, p) = foldl (doRound (ecbDecrypt cipher) n) (head r, reverse (tail r)) (reverse [0..5]) 417 | unless (p0 == iv) (Left BadCrypto) 418 | Right $ BA.concat (reverse p) 419 | 420 | doRound _ _ (a, []) _ = (a, []) 421 | doRound dec i (a, r:rs) j = 422 | let b = dec $ BA.concat [txor t a, r] 423 | t = fromIntegral ((n*j) + i) :: Word8 424 | a' = BA.take 8 b 425 | r' = BA.drop 8 b 426 | next = doRound dec (i-1) (a', rs) j 427 | in (fst next, r' : snd next) 428 | -------------------------------------------------------------------------------- /Jose/Internal/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# OPTIONS_HADDOCK prune #-} 3 | 4 | -- | Parses encoded JWTs into data structures which can be handled 5 | 6 | module Jose.Internal.Parser 7 | ( parseJwt 8 | , DecodableJwt (..) 9 | , EncryptedCEK (..) 10 | , Payload (..) 11 | , IV (..) 12 | , Tag (..) 13 | , AAD (..) 14 | , Sig (..) 15 | , SigTarget (..) 16 | ) 17 | where 18 | 19 | import Data.Bifunctor (first) 20 | import Data.Aeson (eitherDecodeStrict') 21 | import Data.Attoparsec.ByteString (Parser) 22 | import qualified Data.Attoparsec.ByteString as P 23 | import qualified Data.Attoparsec.ByteString.Char8 as PC 24 | import Data.ByteArray.Encoding (convertFromBase, Base(..)) 25 | import Data.ByteString (ByteString) 26 | import qualified Data.ByteString as B 27 | 28 | import Jose.Jwa 29 | import Jose.Types (JwtError(..), JwtHeader(..), JwsHeader(..), JweHeader(..)) 30 | 31 | 32 | data DecodableJwt 33 | = Unsecured ByteString 34 | | DecodableJws JwsHeader Payload Sig SigTarget 35 | | DecodableJwe JweHeader EncryptedCEK IV Payload Tag AAD 36 | 37 | 38 | data Tag 39 | = Tag16 ByteString 40 | | Tag24 ByteString 41 | | Tag32 ByteString 42 | 43 | 44 | data IV 45 | = IV12 ByteString 46 | | IV16 ByteString 47 | 48 | 49 | newtype Sig = Sig ByteString 50 | newtype SigTarget = SigTarget ByteString 51 | newtype AAD = AAD ByteString 52 | newtype Payload = Payload ByteString 53 | newtype EncryptedCEK = EncryptedCEK ByteString 54 | 55 | 56 | parseJwt :: ByteString -> Either JwtError DecodableJwt 57 | parseJwt bs = first (const BadCrypto) $ P.parseOnly jwt bs 58 | 59 | 60 | jwt :: Parser DecodableJwt 61 | jwt = do 62 | (hdr, raw) <- jwtHeader 63 | case hdr of 64 | UnsecuredH -> Unsecured <$> base64Chunk 65 | JwsH h -> do 66 | payloadB64 <- PC.takeWhile ('.' /=) <* PC.char '.' 67 | payload <- b64Decode payloadB64 68 | s <- sig (jwsAlg h) 69 | pure $ DecodableJws h (Payload payload) s (SigTarget (B.concat [raw, ".", payloadB64])) 70 | JweH h -> 71 | DecodableJwe 72 | <$> pure h 73 | <*> encryptedCEK 74 | <*> iv (jweEnc h) 75 | <*> encryptedPayload 76 | <*> authTag (jweEnc h) 77 | <*> pure (AAD raw) 78 | 79 | 80 | sig :: JwsAlg -> Parser Sig 81 | sig _ = do 82 | t <- P.takeByteString >>= b64Decode 83 | pure (Sig t) 84 | 85 | 86 | authTag :: Enc -> Parser Tag 87 | authTag e = do 88 | t <- P.takeByteString >>= b64Decode 89 | case e of 90 | A128GCM -> tag16 t 91 | A192GCM -> tag16 t 92 | A256GCM -> tag16 t 93 | A128CBC_HS256 -> tag16 t 94 | A192CBC_HS384 -> tag24 t 95 | A256CBC_HS512 -> tag32 t 96 | where 97 | badTag = "invalid auth tag" 98 | tag16 t = if B.length t /= 16 then fail badTag else pure (Tag16 t) 99 | tag24 t = if B.length t /= 24 then fail badTag else pure (Tag24 t) 100 | tag32 t = if B.length t /= 32 then fail badTag else pure (Tag32 t) 101 | 102 | 103 | iv :: Enc -> Parser IV 104 | iv e = do 105 | bs <- base64Chunk 106 | case e of 107 | A128GCM -> iv12 bs 108 | A192GCM -> iv12 bs 109 | A256GCM -> iv12 bs 110 | _ -> iv16 bs 111 | where 112 | iv12 bs = if B.length bs /= 12 then fail "invalid iv" else pure (IV12 bs) 113 | iv16 bs = if B.length bs /= 16 then fail "invalid iv" else pure (IV16 bs) 114 | 115 | 116 | encryptedCEK :: Parser EncryptedCEK 117 | encryptedCEK = EncryptedCEK <$> base64Chunk 118 | 119 | 120 | encryptedPayload :: Parser Payload 121 | encryptedPayload = Payload <$> base64Chunk 122 | 123 | 124 | jwtHeader :: P.Parser (JwtHeader, ByteString) 125 | jwtHeader = do 126 | hdrB64 <- PC.takeWhile ('.' /=) <* PC.char '.' 127 | hdrBytes <- b64Decode hdrB64 :: P.Parser ByteString 128 | hdr <- parseHdr hdrBytes 129 | return (hdr, hdrB64) 130 | where 131 | parseHdr bs = either fail return (eitherDecodeStrict' bs) 132 | 133 | 134 | base64Chunk :: P.Parser ByteString 135 | base64Chunk = do 136 | bs <- PC.takeWhile ('.' /=) <* PC.char '.' 137 | b64Decode bs 138 | 139 | 140 | b64Decode :: ByteString -> P.Parser ByteString 141 | b64Decode bs = either (const (fail "Invalid Base64")) return $ convertFromBase Base64URLUnpadded bs 142 | -------------------------------------------------------------------------------- /Jose/Jwa.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# OPTIONS_HADDOCK prune #-} 3 | {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} 4 | 5 | module Jose.Jwa 6 | ( Alg (..) 7 | , JwsAlg (..) 8 | , JweAlg (..) 9 | , Enc (..) 10 | ) 11 | where 12 | 13 | import Data.Aeson 14 | import Data.Text (Text) 15 | import Data.Tuple (swap) 16 | 17 | -- | General representation of the @alg@ JWT header value. 18 | data Alg = Signed JwsAlg | Encrypted JweAlg deriving (Eq, Show) 19 | 20 | -- | A subset of the signature algorithms from the 21 | -- . 22 | data JwsAlg = None | HS256 | HS384 | HS512 | RS256 | RS384 | RS512 | ES256 | ES384 | ES512 | EdDSA deriving (Eq, Show, Read) 23 | 24 | -- | A subset of the key management algorithms from the 25 | -- . 26 | data JweAlg = RSA1_5 | RSA_OAEP | RSA_OAEP_256 | A128KW | A192KW | A256KW deriving (Eq, Show, Read) 27 | 28 | -- | Content encryption algorithms from the 29 | -- . 30 | data Enc = A128CBC_HS256 | A192CBC_HS384 | A256CBC_HS512 | A128GCM | A192GCM | A256GCM deriving (Eq, Show) 31 | 32 | algs :: [(Text, Alg)] 33 | 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)] 34 | 35 | algName :: Alg -> Text 36 | algName a = let Just n = lookup a algNames in n 37 | 38 | algNames :: [(Alg, Text)] 39 | algNames = map swap algs 40 | 41 | encs :: [(Text, Enc)] 42 | encs = [("A128CBC-HS256", A128CBC_HS256), ("A256CBC-HS512", A256CBC_HS512), ("A192CBC-HS384", A192CBC_HS384), ("A128GCM", A128GCM), ("A192GCM", A192GCM), ("A256GCM", A256GCM)] 43 | 44 | encName :: Enc -> Text 45 | encName e = let Just n = lookup e encNames in n 46 | 47 | encNames :: [(Enc, Text)] 48 | encNames = map swap encs 49 | 50 | instance FromJSON Alg where 51 | parseJSON = withText "Alg" $ \t -> 52 | maybe (fail "Unsupported alg") pure $ lookup t algs 53 | 54 | instance ToJSON Alg where 55 | toJSON = String . algName 56 | 57 | instance FromJSON JwsAlg where 58 | parseJSON = withText "JwsAlg" $ \t -> case lookup t algs of 59 | Just (Signed a) -> pure a 60 | _ -> fail "Unsupported JWS algorithm" 61 | 62 | instance ToJSON JwsAlg where 63 | toJSON a = String . algName $ Signed a 64 | 65 | instance FromJSON JweAlg where 66 | parseJSON = withText "JweAlg" $ \t -> case lookup t algs of 67 | Just (Encrypted a) -> pure a 68 | _ -> fail "Unsupported JWE algorithm" 69 | 70 | instance ToJSON JweAlg where 71 | toJSON a = String . algName $ Encrypted a 72 | 73 | instance FromJSON Enc where 74 | parseJSON = withText "Enc" $ \t -> 75 | maybe (fail "Unsupported enc") pure $ lookup t encs 76 | 77 | instance ToJSON Enc where 78 | toJSON = String . encName 79 | -------------------------------------------------------------------------------- /Jose/Jwe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- | JWE encrypted token support. 4 | -- 5 | -- To create a JWE, you need to select two algorithms. One is an AES algorithm 6 | -- used to encrypt the content of your token (for example, @A128GCM@), for which 7 | -- a single-use key is generated internally. The second is used to encrypt 8 | -- this content-encryption key and can be either an RSA or AES-keywrap algorithm. 9 | -- You need to generate a suitable key to use with this, or load one from storage. 10 | -- 11 | -- AES is much faster and creates shorter tokens, but both the encoder and decoder 12 | -- of the token need to have a copy of the key, which they must keep secret. With 13 | -- RSA anyone can send you a JWE if they have a copy of your public key. 14 | -- 15 | -- In the example below, we show encoding and decoding using a 2048 bit RSA key pair 16 | -- (256 bytes). If using RSA, use one of the @RSA_OAEP@ algorithms. @RSA1_5@ is 17 | -- deprecated due to . 18 | -- 19 | -- >>> import Jose.Jwe 20 | -- >>> import Jose.Jwa 21 | -- >>> import Jose.Jwk (generateRsaKeyPair, generateSymmetricKey, KeyUse(Enc), KeyId) 22 | -- >>> (kPub, kPr) <- generateRsaKeyPair 256 (KeyId "My RSA Key") Enc Nothing 23 | -- >>> Right (Jwt jwt) <- jwkEncode RSA_OAEP A128GCM kPub (Claims "secret claims") 24 | -- >>> Right (Jwe (hdr, claims)) <- jwkDecode kPr jwt 25 | -- >>> claims 26 | -- "secret claims" 27 | -- 28 | -- Using 128-bit AES keywrap is very similar, the main difference is that 29 | -- we generate a 128-bit symmetric key (16 bytes): 30 | -- 31 | -- >>> aesKey <- generateSymmetricKey 16 (KeyId "My Keywrap Key") Enc Nothing 32 | -- >>> Right (Jwt jwt) <- jwkEncode A128KW A128GCM aesKey (Claims "more secret claims") 33 | -- >>> Right (Jwe (hdr, claims)) <- jwkDecode aesKey jwt 34 | -- >>> claims 35 | -- "more secret claims" 36 | 37 | module Jose.Jwe 38 | ( jwkEncode 39 | , jwkDecode 40 | , rsaEncode 41 | , rsaDecode 42 | ) 43 | where 44 | 45 | import Control.Monad.Trans (lift) 46 | import Control.Monad.Trans.Except 47 | import Crypto.Cipher.Types (AuthTag(..)) 48 | import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder, private_pub) 49 | import Crypto.Random (MonadRandom) 50 | import qualified Data.Aeson as A 51 | import Data.ByteArray (ByteArray, ScrubbedBytes) 52 | import qualified Data.ByteArray as BA 53 | import Data.ByteString (ByteString) 54 | import qualified Data.ByteString as B 55 | import qualified Data.ByteString.Lazy as BL 56 | import Data.Maybe (isNothing) 57 | import Jose.Types 58 | import qualified Jose.Internal.Base64 as B64 59 | import Jose.Internal.Crypto 60 | import Jose.Jwa 61 | import Jose.Jwk 62 | import qualified Jose.Internal.Parser as P 63 | 64 | -- | Create a JWE using a JWK. 65 | -- The key and algorithms must be consistent or an error 66 | -- will be returned. 67 | jwkEncode :: MonadRandom m 68 | => JweAlg -- ^ Algorithm to use for key encryption 69 | -> Enc -- ^ Content encryption algorithm 70 | -> Jwk -- ^ The key to use to encrypt the content key 71 | -> Payload -- ^ The token content (claims or nested JWT) 72 | -> m (Either JwtError Jwt) -- ^ The encoded JWE if successful 73 | jwkEncode a e jwk payload = runExceptT $ case jwk of 74 | RsaPublicJwk kPub kid _ _ -> doEncode (hdr kid) e (doRsa kPub) bytes 75 | RsaPrivateJwk kPr kid _ _ -> doEncode (hdr kid) e (doRsa (private_pub kPr)) bytes 76 | SymmetricJwk kek kid _ _ -> doEncode (hdr kid) e (ExceptT . return . keyWrap a (BA.convert kek)) bytes 77 | _ -> throwE $ KeyError "JWK cannot encode a JWE" 78 | where 79 | doRsa kPub = ExceptT . rsaEncrypt kPub a 80 | hdr :: Maybe KeyId -> B.ByteString 81 | hdr kid = BL.toStrict $ 82 | BL.concat 83 | [ "{\"alg\":" 84 | , A.encode a 85 | , ",\"enc\":" 86 | , A.encode e 87 | , maybe "" (\c -> BL.concat [",\"cty\":\"", c, "\"" ]) contentType 88 | , if isNothing kid then "" else BL.concat [",\"kid\":", A.encode kid ] 89 | , "}" 90 | ] 91 | 92 | (contentType, bytes) = case payload of 93 | Claims c -> (Nothing, c) 94 | Nested (Jwt b) -> (Just "JWT", b) 95 | 96 | 97 | -- | Try to decode a JWE using a JWK. 98 | -- If the key type does not match the content encoding algorithm, 99 | -- an error will be returned. 100 | jwkDecode :: MonadRandom m 101 | => Jwk 102 | -> ByteString 103 | -> m (Either JwtError JwtContent) 104 | jwkDecode jwk jwt = runExceptT $ case jwk of 105 | RsaPrivateJwk kPr _ _ _ -> do 106 | blinder <- lift $ generateBlinder (public_n $ private_pub kPr) 107 | e <- doDecode (rsaDecrypt (Just blinder) kPr) jwt 108 | return (Jwe e) 109 | SymmetricJwk kb _ _ _ -> fmap Jwe (doDecode (keyUnwrap (BA.convert kb)) jwt) 110 | UnsupportedJwk _ -> throwE (KeyError "Unsupported JWK cannot be used to decode JWE") 111 | _ -> throwE $ KeyError "This JWK cannot decode a JWE" 112 | 113 | 114 | doDecode :: MonadRandom m 115 | => (JweAlg -> ByteString -> Either JwtError ScrubbedBytes) 116 | -> ByteString 117 | -> ExceptT JwtError m Jwe 118 | doDecode decodeCek jwt = do 119 | encodedJwt <- ExceptT (return (P.parseJwt jwt)) 120 | case encodedJwt of 121 | P.DecodableJwe hdr (P.EncryptedCEK ek) iv (P.Payload payload) tag (P.AAD aad) -> do 122 | let alg = jweAlg hdr 123 | enc = jweEnc hdr 124 | (dummyCek, _) <- lift $ generateCmkAndIV enc 125 | let decryptedCek = either (const dummyCek) id $ decodeCek alg ek 126 | cek = if BA.length decryptedCek == BA.length dummyCek 127 | then decryptedCek 128 | else dummyCek 129 | claims <- maybe (throwE BadCrypto) return $ decryptPayload enc cek iv aad tag payload 130 | return (hdr, claims) 131 | 132 | _ -> throwE (BadHeader "Content is not a JWE") 133 | 134 | 135 | doEncode :: (MonadRandom m, ByteArray ba) 136 | => ByteString 137 | -> Enc 138 | -> (ScrubbedBytes -> ExceptT JwtError m ByteString) 139 | -> ba 140 | -> ExceptT JwtError m Jwt 141 | doEncode hdr e encryptKey claims = do 142 | (cmk, iv) <- lift (generateCmkAndIV e) 143 | let aad = B64.encode hdr 144 | (signature, ciphertext) = case encryptPayload e cmk iv aad claims of 145 | Just (AuthTag sig, ct) -> (sig, ct) 146 | Nothing -> error "encryptPayload failed! Shouldn't happen with valid key and iv" 147 | jweKey <- encryptKey cmk 148 | let jwe = B.intercalate "." $ map B64.encode [hdr, jweKey, BA.convert iv, BA.convert ciphertext, BA.convert signature] 149 | return (Jwt jwe) 150 | 151 | -- | Creates a JWE with the content key encoded using RSA. 152 | rsaEncode :: MonadRandom m 153 | => JweAlg -- ^ RSA algorithm to use (@RSA_OAEP@ or @RSA1_5@) 154 | -> Enc -- ^ Content encryption algorithm 155 | -> PublicKey -- ^ RSA key to encrypt with 156 | -> ByteString -- ^ The JWT claims (content) 157 | -> m (Either JwtError Jwt) -- ^ The encoded JWE 158 | rsaEncode a e kPub claims = runExceptT $ doEncode hdr e (ExceptT . rsaEncrypt kPub a) claims 159 | where 160 | hdr = BL.toStrict $ BL.concat ["{\"alg\":", A.encode a, ",", "\"enc\":", A.encode e, "}"] 161 | 162 | 163 | -- | Decrypts a JWE. 164 | rsaDecode :: MonadRandom m 165 | => PrivateKey -- ^ Decryption key 166 | -> ByteString -- ^ The encoded JWE 167 | -> m (Either JwtError Jwe) -- ^ The decoded JWT, unless an error occurs 168 | rsaDecode pk jwt = runExceptT $ do 169 | blinder <- lift $ generateBlinder (public_n $ private_pub pk) 170 | doDecode (rsaDecrypt (Just blinder) pk) jwt 171 | -------------------------------------------------------------------------------- /Jose/Jwk.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, DeriveGeneric, RecordWildCards, CPP #-} 2 | {-# OPTIONS_HADDOCK prune #-} 3 | 4 | module Jose.Jwk 5 | ( EcCurve (..) 6 | , KeyUse (..) 7 | , KeyId 8 | , Jwk (..) 9 | , JwkSet (..) 10 | , isPublic 11 | , isPrivate 12 | , jwkId 13 | , jwkUse 14 | , canDecodeJws 15 | , canDecodeJwe 16 | , canEncodeJws 17 | , canEncodeJwe 18 | , generateRsaKeyPair 19 | , generateSymmetricKey 20 | ) 21 | where 22 | 23 | import Control.Monad (unless) 24 | import Crypto.Error (CryptoFailable(..)) 25 | import Crypto.Random (MonadRandom, getRandomBytes) 26 | import qualified Crypto.PubKey.RSA as RSA 27 | import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 28 | import qualified Crypto.PubKey.Ed25519 as Ed25519 29 | import qualified Crypto.PubKey.Ed448 as Ed448 30 | import qualified Crypto.PubKey.ECC.Types as ECC 31 | import Crypto.Number.Serialize 32 | import Data.Aeson (fromJSON, genericToJSON, Object, Result(..), Value(..), FromJSON(..), ToJSON(..), withText) 33 | #if MIN_VERSION_aeson(2,0,0) 34 | import qualified Data.Aeson.KeyMap as KM 35 | #else 36 | import qualified Data.HashMap.Strict as H 37 | #endif 38 | import Data.Aeson.Types (Parser, Options (..), defaultOptions) 39 | import qualified Data.ByteArray as BA 40 | import Data.ByteString (ByteString) 41 | import qualified Data.ByteString as B 42 | import Data.Maybe (isNothing, fromMaybe) 43 | import Data.Text (Text) 44 | import qualified Data.Text.Encoding as TE 45 | import GHC.Generics (Generic) 46 | 47 | import qualified Jose.Internal.Base64 as B64 48 | import Jose.Jwa 49 | import Jose.Types (KeyId, JwsHeader(..), JweHeader(..)) 50 | 51 | data KeyType = Rsa 52 | | Ec 53 | | Okp 54 | | Oct 55 | deriving (Eq) 56 | 57 | data EcCurve = P_256 58 | | P_384 59 | | P_521 60 | deriving (Eq,Show) 61 | 62 | data KeyUse = Sig 63 | | Enc 64 | deriving (Eq,Show) 65 | 66 | data Jwk = RsaPublicJwk !RSA.PublicKey !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) 67 | | RsaPrivateJwk !RSA.PrivateKey !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) 68 | | EcPublicJwk !ECDSA.PublicKey !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) !EcCurve 69 | | EcPrivateJwk !ECDSA.KeyPair !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) !EcCurve 70 | | Ed25519PrivateJwk !Ed25519.SecretKey !Ed25519.PublicKey !(Maybe KeyId) 71 | | Ed25519PublicJwk !Ed25519.PublicKey !(Maybe KeyId) 72 | | Ed448PrivateJwk !Ed448.SecretKey !Ed448.PublicKey !(Maybe KeyId) 73 | | Ed448PublicJwk !Ed448.PublicKey !(Maybe KeyId) 74 | | SymmetricJwk !ByteString !(Maybe KeyId) !(Maybe KeyUse) !(Maybe Alg) 75 | | UnsupportedJwk Object 76 | deriving (Show, Eq) 77 | 78 | newtype JwkSet = JwkSet 79 | { keys :: [Jwk] 80 | } deriving (Show, Eq, Generic) 81 | 82 | generateRsaKeyPair :: (MonadRandom m) 83 | => Int 84 | -> KeyId 85 | -> KeyUse 86 | -> Maybe Alg 87 | -> m (Jwk, Jwk) 88 | generateRsaKeyPair nBytes id' kuse kalg = do 89 | (kPub, kPr) <- RSA.generate nBytes 65537 90 | return (RsaPublicJwk kPub (Just id') (Just kuse) kalg, RsaPrivateJwk kPr (Just id') (Just kuse) kalg) 91 | 92 | generateSymmetricKey :: (MonadRandom m) 93 | => Int 94 | -> KeyId 95 | -> KeyUse 96 | -> Maybe Alg 97 | -> m Jwk 98 | generateSymmetricKey size id' kuse kalg = do 99 | k <- getRandomBytes size 100 | return $ SymmetricJwk k (Just id') (Just kuse) kalg 101 | 102 | isPublic :: Jwk -> Bool 103 | isPublic RsaPublicJwk {} = True 104 | isPublic EcPublicJwk {} = True 105 | isPublic _ = False 106 | 107 | isPrivate :: Jwk -> Bool 108 | isPrivate RsaPrivateJwk {} = True 109 | isPrivate EcPrivateJwk {} = True 110 | isPrivate _ = False 111 | 112 | canDecodeJws :: JwsHeader -> Jwk -> Bool 113 | canDecodeJws hdr jwk = jwkUse jwk /= Just Enc && 114 | keyIdCompatible (jwsKid hdr) jwk && 115 | algCompatible (Signed (jwsAlg hdr)) jwk && 116 | case (jwsAlg hdr, jwk) of 117 | (EdDSA, Ed25519PublicJwk {}) -> True 118 | (EdDSA, Ed25519PrivateJwk {}) -> True 119 | (EdDSA, Ed448PublicJwk {}) -> True 120 | (EdDSA, Ed448PrivateJwk {}) -> True 121 | (RS256, RsaPublicJwk {}) -> True 122 | (RS384, RsaPublicJwk {}) -> True 123 | (RS512, RsaPublicJwk {}) -> True 124 | (RS256, RsaPrivateJwk {}) -> True 125 | (RS384, RsaPrivateJwk {}) -> True 126 | (RS512, RsaPrivateJwk {}) -> True 127 | (HS256, SymmetricJwk {}) -> True 128 | (HS384, SymmetricJwk {}) -> True 129 | (HS512, SymmetricJwk {}) -> True 130 | (ES256, EcPublicJwk {}) -> True 131 | (ES384, EcPublicJwk {}) -> True 132 | (ES512, EcPublicJwk {}) -> True 133 | (ES256, EcPrivateJwk {}) -> True 134 | (ES384, EcPrivateJwk {}) -> True 135 | (ES512, EcPrivateJwk {}) -> True 136 | _ -> False 137 | 138 | canEncodeJws :: JwsAlg -> Jwk -> Bool 139 | canEncodeJws a jwk = jwkUse jwk /= Just Enc && 140 | algCompatible (Signed a) jwk && 141 | case (a, jwk) of 142 | (EdDSA, Ed25519PrivateJwk {}) -> True 143 | (EdDSA, Ed448PrivateJwk {}) -> True 144 | (RS256, RsaPrivateJwk {}) -> True 145 | (RS384, RsaPrivateJwk {}) -> True 146 | (RS512, RsaPrivateJwk {}) -> True 147 | (HS256, SymmetricJwk {}) -> True 148 | (HS384, SymmetricJwk {}) -> True 149 | (HS512, SymmetricJwk {}) -> True 150 | (ES256, EcPrivateJwk {}) -> True 151 | (ES384, EcPrivateJwk {}) -> True 152 | (ES512, EcPrivateJwk {}) -> True 153 | _ -> False 154 | 155 | canDecodeJwe :: JweHeader -> Jwk -> Bool 156 | canDecodeJwe hdr jwk = jwkUse jwk /= Just Sig && 157 | keyIdCompatible (jweKid hdr) jwk && 158 | algCompatible (Encrypted (jweAlg hdr)) jwk && 159 | case (jweAlg hdr, jwk) of 160 | (RSA1_5, RsaPrivateJwk {}) -> True 161 | (RSA_OAEP, RsaPrivateJwk {}) -> True 162 | (RSA_OAEP_256, RsaPrivateJwk {}) -> True 163 | (A128KW, SymmetricJwk k _ _ _) -> B.length k == 16 164 | (A192KW, SymmetricJwk k _ _ _) -> B.length k == 24 165 | (A256KW, SymmetricJwk k _ _ _) -> B.length k == 32 166 | _ -> False 167 | 168 | canEncodeJwe :: JweAlg -> Jwk -> Bool 169 | canEncodeJwe a jwk = jwkUse jwk /= Just Sig && 170 | algCompatible (Encrypted a) jwk && 171 | case (a, jwk) of 172 | (RSA1_5, RsaPublicJwk {}) -> True 173 | (RSA_OAEP, RsaPublicJwk {}) -> True 174 | (RSA_OAEP_256, RsaPublicJwk {}) -> True 175 | (RSA1_5, RsaPrivateJwk {}) -> True 176 | (RSA_OAEP, RsaPrivateJwk {}) -> True 177 | (RSA_OAEP_256, RsaPrivateJwk {}) -> True 178 | (A128KW, SymmetricJwk k _ _ _) -> B.length k == 16 179 | (A192KW, SymmetricJwk k _ _ _) -> B.length k == 24 180 | (A256KW, SymmetricJwk k _ _ _) -> B.length k == 32 181 | _ -> False 182 | 183 | keyIdCompatible :: Maybe KeyId -> Jwk -> Bool 184 | keyIdCompatible Nothing _ = True 185 | keyIdCompatible id' jwk = id' == jwkId jwk 186 | 187 | algCompatible :: Alg -> Jwk -> Bool 188 | algCompatible a k' = case jwkAlg k' of 189 | Nothing -> True 190 | Just ka -> a == ka 191 | 192 | ecCurve :: Text -> Maybe (EcCurve, ECC.Curve) 193 | ecCurve c = case c of 194 | "P-256" -> Just (P_256, ECC.getCurveByName ECC.SEC_p256r1) 195 | "P-384" -> Just (P_384, ECC.getCurveByName ECC.SEC_p384r1) 196 | "P-521" -> Just (P_521, ECC.getCurveByName ECC.SEC_p521r1) 197 | _ -> Nothing 198 | 199 | ecCurveName :: EcCurve -> Text 200 | ecCurveName c = case c of 201 | P_256 -> "P-256" 202 | P_384 -> "P-384" 203 | P_521 -> "P-521" 204 | 205 | jwkId :: Jwk -> Maybe KeyId 206 | jwkId key = case key of 207 | Ed25519PrivateJwk _ _ keyId -> keyId 208 | Ed25519PublicJwk _ keyId -> keyId 209 | Ed448PrivateJwk _ _ keyId -> keyId 210 | Ed448PublicJwk _ keyId -> keyId 211 | RsaPublicJwk _ keyId _ _ -> keyId 212 | RsaPrivateJwk _ keyId _ _ -> keyId 213 | EcPublicJwk _ keyId _ _ _ -> keyId 214 | EcPrivateJwk _ keyId _ _ _ -> keyId 215 | SymmetricJwk _ keyId _ _ -> keyId 216 | UnsupportedJwk _ -> Nothing 217 | 218 | jwkUse :: Jwk -> Maybe KeyUse 219 | jwkUse key = case key of 220 | Ed25519PrivateJwk {} -> Just Sig 221 | Ed25519PublicJwk _ _ -> Just Sig 222 | Ed448PrivateJwk {} -> Just Sig 223 | Ed448PublicJwk _ _ -> Just Sig 224 | RsaPublicJwk _ _ u _ -> u 225 | RsaPrivateJwk _ _ u _ -> u 226 | EcPublicJwk _ _ u _ _ -> u 227 | EcPrivateJwk _ _ u _ _ -> u 228 | SymmetricJwk _ _ u _ -> u 229 | UnsupportedJwk _ -> Nothing 230 | 231 | jwkAlg :: Jwk -> Maybe Alg 232 | jwkAlg key = case key of 233 | Ed25519PrivateJwk {} -> Just (Signed EdDSA) 234 | Ed25519PublicJwk _ _ -> Just (Signed EdDSA) 235 | Ed448PrivateJwk {} -> Just (Signed EdDSA) 236 | Ed448PublicJwk _ _ -> Just (Signed EdDSA) 237 | RsaPublicJwk _ _ _ a -> a 238 | RsaPrivateJwk _ _ _ a -> a 239 | EcPublicJwk _ _ _ a _ -> a 240 | EcPrivateJwk _ _ _ a _ -> a 241 | SymmetricJwk _ _ _ a -> a 242 | UnsupportedJwk _ -> Nothing 243 | 244 | 245 | newtype JwkBytes = JwkBytes {bytes :: ByteString} deriving (Show) 246 | 247 | instance FromJSON KeyType where 248 | parseJSON = withText "KeyType" $ \t -> 249 | case t of 250 | "RSA" -> pure Rsa 251 | "OKP" -> pure Okp 252 | "EC" -> pure Ec 253 | "oct" -> pure Oct 254 | _ -> fail "unsupported key type" 255 | 256 | instance ToJSON KeyType where 257 | toJSON kt = case kt of 258 | Rsa -> String "RSA" 259 | Okp -> String "OKP" 260 | Ec -> String "EC" 261 | Oct -> String "oct" 262 | 263 | instance FromJSON KeyUse where 264 | parseJSON = withText "KeyUse" $ \t -> 265 | case t of 266 | "sig" -> pure Sig 267 | "enc" -> pure Enc 268 | _ -> fail "'use' value must be either 'sig' or 'enc'" 269 | 270 | instance ToJSON KeyUse where 271 | toJSON ku = case ku of 272 | Sig -> String "sig" 273 | Enc -> String "enc" 274 | 275 | instance FromJSON EcCurve where 276 | parseJSON = withText "EcCurve" $ \t -> 277 | case t of 278 | "P-256" -> pure P_256 279 | "P-384" -> pure P_384 280 | "P-521" -> pure P_521 281 | _ -> fail "unsupported 'crv' value" 282 | 283 | instance ToJSON EcCurve where 284 | toJSON c = case c of 285 | P_256 -> String "P-256" 286 | P_384 -> String "P-384" 287 | P_521 -> String "P-521" 288 | 289 | instance FromJSON JwkBytes where 290 | parseJSON = withText "JwkBytes" $ \t -> 291 | case B64.decode (TE.encodeUtf8 t) of 292 | Left _ -> fail "could not base64 decode bytes" 293 | Right b -> pure $ JwkBytes b 294 | 295 | instance ToJSON JwkBytes where 296 | toJSON (JwkBytes b) = String . TE.decodeUtf8 $ B64.encode b 297 | 298 | instance FromJSON Jwk where 299 | parseJSON (Object k) = parseJwk k 300 | parseJSON _ = fail "Jwk must be a JSON object" 301 | 302 | parseJwk :: Object -> Parser Jwk 303 | parseJwk k = 304 | case (checkAlg, checkKty) of 305 | (Success _, Success _) -> do 306 | jwkData <- parseJSON (Object k) :: Parser JwkData 307 | case createJwk jwkData of 308 | Left err -> fail err 309 | Right jwk -> return jwk 310 | _ -> pure (UnsupportedJwk k) 311 | where 312 | #if MIN_VERSION_aeson(2,0,0) 313 | algValue = fromMaybe Null (KM.lookup "alg" k) 314 | -- kty is required so if it's missing here we do nothing and allow decoding to fail 315 | -- later 316 | ktyValue = fromMaybe Null (KM.lookup "kty" k) 317 | #else 318 | algValue = fromMaybe Null (H.lookup "alg" k) 319 | ktyValue = fromMaybe Null (H.lookup "kty" k) 320 | #endif 321 | checkAlg = fromJSON algValue :: Result (Maybe Alg) 322 | checkKty = fromJSON ktyValue :: Result (Maybe KeyType) 323 | 324 | instance ToJSON Jwk where 325 | toJSON jwk = case jwk of 326 | RsaPublicJwk pubKey mId mUse mAlg -> 327 | toJSON $ createPubData pubKey mId mUse mAlg 328 | RsaPrivateJwk privKey mId mUse mAlg -> 329 | let pubData = createPubData (RSA.private_pub privKey) mId mUse mAlg 330 | in toJSON $ pubData 331 | { d = Just . JwkBytes . i2osp $ RSA.private_d privKey 332 | , p = i2b $ RSA.private_p privKey 333 | , q = i2b $ RSA.private_q privKey 334 | , dp = i2b $ RSA.private_dP privKey 335 | , dq = i2b $ RSA.private_dQ privKey 336 | , qi = i2b $ RSA.private_qinv privKey 337 | } 338 | 339 | Ed25519PrivateJwk kPr kPub kid_ -> toJSON $ defJwk 340 | { kty = Okp 341 | , crv = Just "Ed25519" 342 | , d = Just (JwkBytes (BA.convert kPr)) 343 | , x = Just (JwkBytes (BA.convert kPub)) 344 | , kid = kid_ 345 | } 346 | 347 | Ed25519PublicJwk kPub kid_ -> toJSON $ defJwk 348 | { kty = Okp 349 | , crv = Just "Ed25519" 350 | , x = Just (JwkBytes (BA.convert kPub)) 351 | , kid = kid_ 352 | } 353 | 354 | Ed448PrivateJwk kPr kPub kid_ -> toJSON $ defJwk 355 | { kty = Okp 356 | , crv = Just "Ed448" 357 | , d = Just (JwkBytes (BA.convert kPr)) 358 | , x = Just (JwkBytes (BA.convert kPub)) 359 | , kid = kid_ 360 | } 361 | 362 | Ed448PublicJwk kPub kid_ -> toJSON $ defJwk 363 | { kty = Okp 364 | , crv = Just "Ed448" 365 | , x = Just (JwkBytes (BA.convert kPub)) 366 | , kid = kid_ 367 | } 368 | 369 | 370 | SymmetricJwk bs mId mUse mAlg -> toJSON $ defJwk 371 | { kty = Oct 372 | , k = Just $ JwkBytes bs 373 | , kid = mId 374 | , use = mUse 375 | , alg = mAlg 376 | } 377 | 378 | EcPublicJwk pubKey mId mUse mAlg c -> toJSON $ defJwk 379 | { kty = Ec 380 | , x = fst (ecPoint pubKey) 381 | , y = snd (ecPoint pubKey) 382 | , kid = mId 383 | , use = mUse 384 | , alg = mAlg 385 | , crv = Just (ecCurveName c) 386 | } 387 | 388 | EcPrivateJwk kp mId mUse mAlg c -> toJSON $ defJwk 389 | { kty = Ec 390 | , x = fst (ecPoint (ECDSA.toPublicKey kp)) 391 | , y = snd (ecPoint (ECDSA.toPublicKey kp)) 392 | , d = i2b (ECDSA.private_d (ECDSA.toPrivateKey kp)) 393 | , kid = mId 394 | , use = mUse 395 | , alg = mAlg 396 | , crv = Just (ecCurveName c) 397 | } 398 | 399 | UnsupportedJwk k -> Object k 400 | where 401 | i2b 0 = Nothing 402 | i2b i = Just . JwkBytes . i2osp $ i 403 | ecPoint pk = case ECDSA.public_q pk of 404 | ECC.Point xi yi -> (i2b xi, i2b yi) 405 | _ -> (Nothing, Nothing) 406 | 407 | createPubData pubKey mId mUse mAlg = defJwk 408 | { n = i2b (RSA.public_n pubKey) 409 | , e = i2b (RSA.public_e pubKey) 410 | , kid = mId 411 | , use = mUse 412 | , alg = mAlg 413 | } 414 | instance ToJSON JwkSet 415 | instance FromJSON JwkSet 416 | 417 | aesonOptions :: Options 418 | aesonOptions = defaultOptions { omitNothingFields = True } 419 | 420 | data JwkData = J 421 | { kty :: KeyType 422 | -- There's probably a better way to parse this 423 | -- than encoding all the possible key params 424 | -- but this will do for now. 425 | , n :: Maybe JwkBytes 426 | , e :: Maybe JwkBytes 427 | , d :: Maybe JwkBytes 428 | , p :: Maybe JwkBytes 429 | , q :: Maybe JwkBytes 430 | , dp :: Maybe JwkBytes 431 | , dq :: Maybe JwkBytes 432 | , qi :: Maybe JwkBytes 433 | , k :: Maybe JwkBytes 434 | , crv :: Maybe Text 435 | , x :: Maybe JwkBytes 436 | , y :: Maybe JwkBytes 437 | , use :: Maybe KeyUse 438 | , alg :: Maybe Alg 439 | , kid :: Maybe KeyId 440 | , x5u :: Maybe Text 441 | , x5c :: Maybe [Text] 442 | , x5t :: Maybe Text 443 | } deriving (Generic) 444 | 445 | instance FromJSON JwkData 446 | instance ToJSON JwkData where 447 | toJSON = genericToJSON aesonOptions 448 | 449 | defJwk :: JwkData 450 | defJwk = J 451 | { kty = Rsa 452 | , n = Nothing 453 | , e = Nothing 454 | , d = Nothing 455 | , p = Nothing 456 | , q = Nothing 457 | , dp = Nothing 458 | , dq = Nothing 459 | , qi = Nothing 460 | , k = Nothing 461 | , crv = Nothing 462 | , x = Nothing 463 | , y = Nothing 464 | , use = Just Sig 465 | , alg = Nothing 466 | , kid = Nothing 467 | , x5u = Nothing 468 | , x5c = Nothing 469 | , x5t = Nothing 470 | } 471 | 472 | createJwk :: JwkData -> Either String Jwk 473 | createJwk J {..} = case kty of 474 | Rsa -> do 475 | nb <- note "n is required for an RSA key" n 476 | eb <- note "e is required for an RSA key" e 477 | checkNoEc 478 | let kPub = rsaPub nb eb 479 | case d of 480 | Nothing -> do 481 | unless (isNothing (sequence [p, q, dp, dq, qi])) (Left "RSA private parameters can't be set for a public key") 482 | return (RsaPublicJwk kPub kid use alg) 483 | Just db -> return $ RsaPrivateJwk (RSA.PrivateKey kPub (os2ip (bytes db)) (os2mip p) (os2mip q) (os2mip dp) (os2mip dq) (os2mip qi)) kid use alg 484 | Oct -> do 485 | kb <- note "k is required for a symmetric key" k 486 | unless (isNothing (sequence [n, e, d, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for a symmetric key") 487 | checkNoEc 488 | return $ SymmetricJwk (bytes kb) kid use alg 489 | Okp -> do 490 | crv' <- note "crv is required for an OKP key" crv 491 | x' <- note "x is required for an OKP key" x 492 | unless (isNothing (sequence [n, e, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for an OKP key") 493 | case crv' of 494 | "Ed25519" -> case d of 495 | Just db -> do 496 | secKey <- createOkpKey Ed25519.secretKey (bytes db) 497 | pubKey <- createOkpKey Ed25519.publicKey (bytes x') 498 | unless (pubKey == Ed25519.toPublic secKey) (Left "Public key x doesn't match private key d") 499 | return (Ed25519PrivateJwk secKey pubKey kid) 500 | Nothing -> do 501 | pubKey <- createOkpKey Ed25519.publicKey (bytes x') 502 | return (Ed25519PublicJwk pubKey kid) 503 | "Ed448" -> case d of 504 | Just db -> do 505 | secKey <- createOkpKey Ed448.secretKey (bytes db) 506 | pubKey <- createOkpKey Ed448.publicKey (bytes x') 507 | unless (pubKey == Ed448.toPublic secKey) (Left "Public key x doesn't match private key d") 508 | return (Ed448PrivateJwk secKey pubKey kid) 509 | Nothing -> do 510 | pubKey <- createOkpKey Ed448.publicKey (bytes x') 511 | return (Ed448PublicJwk pubKey kid) 512 | 513 | _ -> Left "Unknown or unsupported OKP type" 514 | Ec -> do 515 | crv' <- note "crv is required for an elliptic curve key" crv 516 | (crv'', c) <- note "crv must be a valid EC curve name" (ecCurve crv') 517 | ecPt <- ecPoint 518 | unless (isNothing (sequence [n, e, p, q, dp, dq, qi])) (Left "RSA parameters can't be set for an elliptic curve key") 519 | case d of 520 | Nothing -> return $ EcPublicJwk (ECDSA.PublicKey c ecPt) kid use alg crv'' 521 | Just db -> return $ EcPrivateJwk (ECDSA.KeyPair c ecPt (os2ip (bytes db))) kid use alg crv'' 522 | where 523 | checkNoEc = unless (isNothing crv) (Left "Elliptic curve type can't be set for an RSA key") >> 524 | unless (isNothing (sequence [x, y])) (Left "Elliptic curve coordinates can't be set for an RSA key") 525 | createOkpKey f ba = case f ba of 526 | CryptoPassed k_ -> Right k_ 527 | _ -> Left "Invalid OKP key data" 528 | 529 | note err = maybe (Left err) Right 530 | os2mip = maybe 0 (os2ip . bytes) 531 | rsaPub nb eb = let m = os2ip $ bytes nb 532 | ex = os2ip $ bytes eb 533 | in RSA.PublicKey (rsaSize m 1) m ex 534 | rsaSize m i = if 2 ^ (i * 8) > m then i else rsaSize m (i+1) 535 | ecPoint = do 536 | xb <- note "x is required for an EC key" x 537 | yb <- note "y is required for an EC key" y 538 | return $ ECC.Point (os2ip (bytes xb)) (os2ip (bytes yb)) 539 | -------------------------------------------------------------------------------- /Jose/Jws.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- | JWS HMAC and RSA signed token support. 4 | -- 5 | -- Example usage with HMAC: 6 | -- 7 | -- >>> import Jose.Jws 8 | -- >>> import Jose.Jwa 9 | -- >>> let Right (Jwt jwt) = hmacEncode HS256 "secretmackey" "public claims" 10 | -- >>> jwt 11 | -- "eyJhbGciOiJIUzI1NiJ9.cHVibGljIGNsYWltcw.GDV7RdBrCYfCtFCZZGPy_sWry4GwfX3ckMywXUyxBsc" 12 | -- >>> hmacDecode "wrongkey" jwt 13 | -- Left BadSignature 14 | -- >>> hmacDecode "secretmackey" jwt 15 | -- Right (JwsHeader {jwsAlg = HS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Nothing},"public claims") 16 | 17 | module Jose.Jws 18 | ( jwkEncode 19 | , hmacEncode 20 | , hmacDecode 21 | , rsaEncode 22 | , rsaDecode 23 | , ecDecode 24 | , ed25519Encode 25 | , ed25519Decode 26 | , ed448Encode 27 | , ed448Decode 28 | ) 29 | where 30 | 31 | import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 32 | import qualified Crypto.PubKey.Ed25519 as Ed25519 33 | import qualified Crypto.PubKey.Ed448 as Ed448 34 | import Crypto.PubKey.RSA (PrivateKey(..), PublicKey(..), generateBlinder) 35 | import Crypto.Random (MonadRandom) 36 | import Data.ByteString (ByteString) 37 | import qualified Data.ByteString as B 38 | 39 | import Jose.Types 40 | import qualified Jose.Internal.Base64 as B64 41 | import Jose.Internal.Crypto 42 | import qualified Jose.Internal.Parser as P 43 | import Jose.Jwa 44 | import Jose.Jwk (Jwk (..)) 45 | 46 | -- | Create a JWS signed with a JWK. 47 | -- The key and algorithm must be consistent or an error 48 | -- will be returned. 49 | jwkEncode :: MonadRandom m 50 | => JwsAlg -- ^ The algorithm to use 51 | -> Jwk -- ^ The key to sign with 52 | -> Payload -- ^ The public JWT claims 53 | -> m (Either JwtError Jwt) -- ^ The encoded token, if successful 54 | jwkEncode a key payload = case key of 55 | RsaPrivateJwk kPr kid _ _ -> rsaEncodeInternal a kPr (sigTarget a kid payload) 56 | SymmetricJwk k kid _ _ -> return $ hmacEncodeInternal a k (sigTarget a kid payload) 57 | Ed25519PrivateJwk kPr kPub kid -> return $ 58 | case a of 59 | EdDSA -> Right $ ed25519EncodeInternal kPr kPub (sigTarget EdDSA kid payload) 60 | _ -> Left (KeyError "Algorithm cannot be used with an Ed25519 key") 61 | Ed448PrivateJwk kPr kPub kid -> return $ 62 | case a of 63 | EdDSA -> Right $ ed448EncodeInternal kPr kPub (sigTarget EdDSA kid payload) 64 | _ -> Left (KeyError "Algorithm cannot be used with an Ed448 key") 65 | _ -> return $ Left $ BadAlgorithm "EC signing is not supported" 66 | 67 | -- | Create a JWS with an HMAC for validation. 68 | hmacEncode :: JwsAlg -- ^ The MAC algorithm to use 69 | -> ByteString -- ^ The MAC key 70 | -> ByteString -- ^ The public JWT claims (token content) 71 | -> Either JwtError Jwt -- ^ The encoded JWS token 72 | hmacEncode a key payload = hmacEncodeInternal a key (sigTarget a Nothing (Claims payload)) 73 | 74 | hmacEncodeInternal :: JwsAlg 75 | -> ByteString 76 | -> ByteString 77 | -> Either JwtError Jwt 78 | hmacEncodeInternal a key st = Jwt . (\mac -> B.concat [st, ".", B64.encode mac]) <$> hmacSign a key st 79 | 80 | -- | Decodes and validates an HMAC signed JWS. 81 | hmacDecode :: ByteString -- ^ The HMAC key 82 | -> ByteString -- ^ The JWS token to decode 83 | -> Either JwtError Jws -- ^ The decoded token if successful 84 | hmacDecode key = decode (`hmacVerify` key) 85 | 86 | -- | Creates a JWS with an RSA signature. 87 | rsaEncode :: MonadRandom m 88 | => JwsAlg -- ^ The RSA algorithm to use 89 | -> PrivateKey -- ^ The key to sign with 90 | -> ByteString -- ^ The public JWT claims (token content) 91 | -> m (Either JwtError Jwt) -- ^ The encoded JWS token 92 | rsaEncode a pk payload = rsaEncodeInternal a pk (sigTarget a Nothing (Claims payload)) 93 | 94 | rsaEncodeInternal :: MonadRandom m 95 | => JwsAlg 96 | -> PrivateKey 97 | -> ByteString 98 | -> m (Either JwtError Jwt) 99 | rsaEncodeInternal a pk st = do 100 | blinder <- generateBlinder (public_n $ private_pub pk) 101 | return $ sign blinder 102 | where 103 | sign b = case rsaSign (Just b) a pk st of 104 | Right sig -> Right . Jwt $ B.concat [st, ".", B64.encode sig] 105 | Left e -> Left e 106 | 107 | 108 | ed25519Decode :: Ed25519.PublicKey 109 | -> ByteString 110 | -> Either JwtError Jws 111 | ed25519Decode key = decode (`ed25519Verify` key) 112 | 113 | 114 | ed25519Encode :: Ed25519.SecretKey 115 | -> Ed25519.PublicKey 116 | -> ByteString 117 | -> Jwt 118 | ed25519Encode kPr kPub payload = 119 | ed25519EncodeInternal kPr kPub (sigTarget EdDSA Nothing (Claims payload)) 120 | 121 | 122 | ed25519EncodeInternal :: Ed25519.SecretKey 123 | -> Ed25519.PublicKey 124 | -> ByteString 125 | -> Jwt 126 | ed25519EncodeInternal kPr kPub signMe = 127 | let 128 | sig = Ed25519.sign kPr kPub signMe 129 | in 130 | Jwt (B.concat [signMe, ".", B64.encode sig]) 131 | 132 | 133 | ed448Decode :: Ed448.PublicKey 134 | -> ByteString 135 | -> Either JwtError Jws 136 | ed448Decode key = decode (`ed448Verify` key) 137 | 138 | 139 | ed448Encode :: Ed448.SecretKey 140 | -> Ed448.PublicKey 141 | -> ByteString 142 | -> Jwt 143 | ed448Encode kPr kPub payload = 144 | ed448EncodeInternal kPr kPub (sigTarget EdDSA Nothing (Claims payload)) 145 | 146 | 147 | ed448EncodeInternal :: Ed448.SecretKey 148 | -> Ed448.PublicKey 149 | -> ByteString 150 | -> Jwt 151 | ed448EncodeInternal kPr kPub signMe = 152 | let 153 | sig = Ed448.sign kPr kPub signMe 154 | in 155 | Jwt (B.concat [signMe, ".", B64.encode sig]) 156 | 157 | 158 | -- | Decode and validate an RSA signed JWS. 159 | rsaDecode :: PublicKey -- ^ The key to check the signature with 160 | -> ByteString -- ^ The encoded JWS 161 | -> Either JwtError Jws -- ^ The decoded token if successful 162 | rsaDecode key = decode (`rsaVerify` key) 163 | 164 | 165 | -- | Decode and validate an EC signed JWS 166 | ecDecode :: ECDSA.PublicKey -- ^ The key to check the signature with 167 | -> ByteString -- ^ The encoded JWS 168 | -> Either JwtError Jws -- ^ The decoded token if successful 169 | ecDecode key = decode (`ecVerify` key) 170 | 171 | sigTarget :: JwsAlg -> Maybe KeyId -> Payload -> ByteString 172 | sigTarget a kid payload = B.intercalate "." $ map B64.encode [encodeHeader hdr, bytes] 173 | where 174 | hdr = defJwsHdr {jwsAlg = a, jwsKid = kid, jwsCty = contentType} 175 | (contentType, bytes) = case payload of 176 | Claims c -> (Nothing, c) 177 | Nested (Jwt b) -> (Just "JWT", b) 178 | 179 | type JwsVerifier = JwsAlg -> ByteString -> ByteString -> Bool 180 | 181 | 182 | decode :: JwsVerifier -> ByteString -> Either JwtError Jws 183 | decode verify jwt = do 184 | decodableJwt <- P.parseJwt jwt 185 | case decodableJwt of 186 | P.DecodableJws hdr (P.Payload p) (P.Sig sig) (P.SigTarget signed) -> 187 | if verify (jwsAlg hdr) signed sig 188 | then Right (hdr, p) 189 | else Left BadSignature 190 | _ -> Left (BadHeader "JWT is not a JWS") 191 | -------------------------------------------------------------------------------- /Jose/Jwt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, FlexibleContexts #-} 2 | {-# OPTIONS_HADDOCK prune #-} 3 | 4 | -- | High-level JWT encoding and decoding. 5 | -- 6 | -- See the Jose.Jws and Jose.Jwe modules for specific JWS and JWE examples. 7 | -- 8 | -- Example usage with a key stored as a JWK: 9 | -- 10 | -- >>> import Jose.Jwe 11 | -- >>> import Jose.Jwa 12 | -- >>> import Jose.Jwk 13 | -- >>> import Data.ByteString 14 | -- >>> import Data.Aeson (decodeStrict) 15 | -- >>> 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 16 | -- >>> let Just jwk = decodeStrict jsonJwk :: Maybe Jwk 17 | -- >>> Right (Jwt jwtEncoded) <- encode [jwk] (JwsEncoding RS256) (Claims "public claims") 18 | -- >>> Right jwtDecoded <- Jose.Jwt.decode [jwk] (Just (JwsEncoding RS256)) jwtEncoded 19 | -- >>> jwtDecoded 20 | -- Jws (JwsHeader {jwsAlg = RS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Just (KeyId "mykey")},"public claims") 21 | 22 | module Jose.Jwt 23 | ( module Jose.Types 24 | , encode 25 | , decode 26 | , decodeClaims 27 | ) 28 | where 29 | 30 | import Control.Monad (msum, when, unless) 31 | import Control.Monad.Trans (lift) 32 | import Control.Monad.Trans.Except 33 | import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 34 | import Crypto.PubKey.RSA (PrivateKey(..)) 35 | import Crypto.Random (MonadRandom) 36 | import Data.Aeson (decodeStrict',FromJSON) 37 | import Data.ByteString (ByteString) 38 | import Data.Maybe (isNothing) 39 | import qualified Data.ByteString.Char8 as BC 40 | 41 | import qualified Jose.Internal.Base64 as B64 42 | import qualified Jose.Internal.Parser as P 43 | import Jose.Types 44 | import Jose.Jwk 45 | import Jose.Jwa 46 | 47 | import qualified Jose.Jws as Jws 48 | import qualified Jose.Jwe as Jwe 49 | 50 | 51 | -- | Use the supplied JWKs to create a JWT. 52 | -- The list of keys will be searched to locate one which is 53 | -- consistent with the chosen encoding algorithms. 54 | -- 55 | encode :: MonadRandom m 56 | => [Jwk] -- ^ The key or keys. At least one must be consistent with the chosen algorithm 57 | -> JwtEncoding -- ^ The encoding algorithm(s) used to encode the payload 58 | -> Payload -- ^ The payload (claims) 59 | -> m (Either JwtError Jwt) -- ^ The encoded JWT, if successful 60 | encode jwks encoding msg = runExceptT $ case encoding of 61 | JwsEncoding None -> case msg of 62 | Claims p -> return $ Jwt $ BC.intercalate "." [unsecuredHdr, B64.encode p] 63 | Nested _ -> throwE BadClaims 64 | JwsEncoding a -> case filter (canEncodeJws a) jwks of 65 | [] -> throwE (KeyError "No matching key found for JWS algorithm") 66 | (k:_) -> ExceptT . return =<< lift (Jws.jwkEncode a k msg) 67 | JweEncoding a e -> case filter (canEncodeJwe a) jwks of 68 | [] -> throwE (KeyError "No matching key found for JWE algorithm") 69 | (k:_) -> ExceptT . return =<< lift (Jwe.jwkEncode a e k msg) 70 | where 71 | unsecuredHdr = B64.encode (BC.pack "{\"alg\":\"none\"}") 72 | 73 | 74 | -- | Uses the supplied keys to decode a JWT. 75 | -- Locates a matching key by header @kid@ value where possible 76 | -- or by suitable key type for the encoding algorithm. 77 | -- 78 | -- The algorithm(s) used can optionally be supplied for validation 79 | -- by setting the @JwtEncoding@ parameter, in which case an error will 80 | -- be returned if they don't match. If you expect the tokens to use 81 | -- a particular algorithm, then you should set this parameter. 82 | -- 83 | -- For unsecured tokens (with algorithm "none"), the expected algorithm 84 | -- must be set to @Just (JwsEncoding None)@ or an error will be returned. 85 | decode :: MonadRandom m 86 | => [Jwk] -- ^ The keys to use for decoding 87 | -> Maybe JwtEncoding -- ^ The expected encoding information 88 | -> ByteString -- ^ The encoded JWT 89 | -> m (Either JwtError JwtContent) -- ^ The decoded JWT payload, if successful 90 | decode keySet encoding jwt = runExceptT $ do 91 | decodableJwt <- ExceptT (return (P.parseJwt jwt)) 92 | 93 | decodings <- case (decodableJwt, encoding) of 94 | (P.Unsecured p, Just (JwsEncoding None)) -> return [Just (Unsecured p)] 95 | (P.Unsecured _, _) -> throwE (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") 96 | (P.DecodableJws hdr _ _ _, e) -> do 97 | unless (isNothing e || e == Just (JwsEncoding (jwsAlg hdr))) $ 98 | throwE (BadAlgorithm "Expected 'alg' doesn't match JWS header") 99 | ks <- checkKeys $ filter (canDecodeJws hdr) keySet 100 | mapM decodeWithJws ks 101 | (P.DecodableJwe hdr _ _ _ _ _, e) -> do 102 | unless (isNothing e || e == Just (JweEncoding (jweAlg hdr) (jweEnc hdr))) $ 103 | throwE (BadAlgorithm "Expected encoding doesn't match JWE header") 104 | ks <- checkKeys $ filter (canDecodeJwe hdr) keySet 105 | mapM decodeWithJwe ks 106 | case msum decodings of 107 | Nothing -> throwE $ KeyError "None of the keys was able to decode the JWT" 108 | Just jwtContent -> return jwtContent 109 | where 110 | decodeWithJws :: MonadRandom m => Jwk -> ExceptT JwtError m (Maybe JwtContent) 111 | decodeWithJws k = either (const $ return Nothing) (return . Just . Jws) $ case k of 112 | Ed25519PublicJwk kPub _ -> Jws.ed25519Decode kPub jwt 113 | Ed25519PrivateJwk _ kPub _ -> Jws.ed25519Decode kPub jwt 114 | Ed448PublicJwk kPub _ -> Jws.ed448Decode kPub jwt 115 | Ed448PrivateJwk _ kPub _ -> Jws.ed448Decode kPub jwt 116 | RsaPublicJwk kPub _ _ _ -> Jws.rsaDecode kPub jwt 117 | RsaPrivateJwk kPr _ _ _ -> Jws.rsaDecode (private_pub kPr) jwt 118 | EcPublicJwk kPub _ _ _ _ -> Jws.ecDecode kPub jwt 119 | EcPrivateJwk kPr _ _ _ _ -> Jws.ecDecode (ECDSA.toPublicKey kPr) jwt 120 | SymmetricJwk kb _ _ _ -> Jws.hmacDecode kb jwt 121 | UnsupportedJwk _ -> Left (KeyError "Unsupported JWKs cannot be used") 122 | 123 | decodeWithJwe :: MonadRandom m => Jwk -> ExceptT JwtError m (Maybe JwtContent) 124 | decodeWithJwe k = fmap (either (const Nothing) Just) (lift (Jwe.jwkDecode k jwt)) 125 | 126 | checkKeys [] = throwE $ KeyError "No suitable key was found to decode the JWT" 127 | checkKeys ks = return ks 128 | 129 | 130 | -- | Convenience function to return the claims contained in a JWS. 131 | -- This is needed in situations such as client assertion authentication, 132 | -- , where the contents of the JWT, 133 | -- such as the @sub@ claim, may be required in order to work out 134 | -- which key should be used to verify the token. 135 | -- 136 | -- Obviously this should not be used by itself to decode a token since 137 | -- no integrity checking is done and the contents may be forged. 138 | decodeClaims :: (FromJSON a) 139 | => ByteString 140 | -> Either JwtError (JwtHeader, a) 141 | decodeClaims jwt = do 142 | let components = BC.split '.' jwt 143 | when (length components /= 3) $ Left $ BadDots 2 144 | hdr <- B64.decode (head components) >>= parseHeader 145 | claims <- B64.decode ((head . tail) components) >>= parseClaims 146 | return (hdr, claims) 147 | where 148 | parseClaims bs = maybe (Left BadClaims) Right $ decodeStrict' bs 149 | -------------------------------------------------------------------------------- /Jose/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, DeriveGeneric, FlexibleContexts, GeneralizedNewtypeDeriving, CPP #-} 2 | {-# OPTIONS_HADDOCK prune #-} 3 | 4 | module Jose.Types 5 | ( Jwt (..) 6 | , Jwe 7 | , Jws 8 | , JwtClaims (..) 9 | , JwtHeader (..) 10 | , JwsHeader (..) 11 | , JweHeader (..) 12 | , JwtContent (..) 13 | , JwtEncoding (..) 14 | , JwtError (..) 15 | , IntDate (..) 16 | , Payload (..) 17 | , KeyId (..) 18 | , parseHeader 19 | , encodeHeader 20 | , defJwsHdr 21 | , defJweHdr 22 | ) 23 | where 24 | 25 | import Data.Aeson 26 | #if MIN_VERSION_aeson(2,0,0) 27 | import Data.Aeson.KeyMap as KM 28 | #else 29 | import qualified Data.HashMap.Strict as H 30 | #endif 31 | import Data.Char (toUpper, toLower) 32 | import Data.ByteString (ByteString) 33 | import qualified Data.ByteString.Lazy as BL 34 | import Data.Int (Int64) 35 | import Data.Time.Clock (UTCTime) 36 | import Data.Time.Clock.POSIX 37 | import Data.Text (Text) 38 | import qualified Data.Text as T 39 | import qualified Data.Text.Encoding as TE 40 | import Data.Vector (singleton) 41 | import GHC.Generics 42 | 43 | import Jose.Jwa (JweAlg(..), JwsAlg (..), Enc(..)) 44 | 45 | -- | An encoded JWT. 46 | newtype Jwt = Jwt { unJwt :: ByteString } deriving (Show, Eq) 47 | 48 | -- | The payload to be encoded in a JWT. 49 | data Payload = Nested Jwt 50 | | Claims ByteString 51 | deriving (Show, Eq) 52 | 53 | -- | The header and claims of a decoded JWS. 54 | type Jws = (JwsHeader, ByteString) 55 | 56 | -- | The header and claims of a decoded JWE. 57 | type Jwe = (JweHeader, ByteString) 58 | 59 | -- | A decoded JWT which can be either a JWE or a JWS, or an unsecured JWT. 60 | data JwtContent = Unsecured !ByteString | Jws !Jws | Jwe !Jwe deriving (Show, Eq) 61 | 62 | -- | Defines the encoding information for a JWT. 63 | -- 64 | -- Used for both encoding new JWTs and validating existing ones. 65 | data JwtEncoding 66 | = JwsEncoding JwsAlg 67 | | JweEncoding JweAlg Enc 68 | deriving (Eq, Show) 69 | 70 | data JwtHeader = JweH JweHeader 71 | | JwsH JwsHeader 72 | | UnsecuredH 73 | deriving (Show) 74 | 75 | data KeyId 76 | = KeyId Text 77 | | UTCKeyId UTCTime 78 | deriving (Eq, Show, Ord) 79 | 80 | instance ToJSON KeyId 81 | where 82 | toJSON (KeyId t) = toJSON t 83 | toJSON (UTCKeyId t) = toJSON t 84 | 85 | instance FromJSON KeyId 86 | where 87 | parseJSON = withText "KeyId" $ \t -> do 88 | let asTime = fromJSON (String t) :: Result UTCTime 89 | case asTime of 90 | Success d -> pure (UTCKeyId d) 91 | _ -> pure (KeyId t) 92 | 93 | -- | Header content for a JWS. 94 | data JwsHeader = JwsHeader { 95 | jwsAlg :: JwsAlg 96 | , jwsTyp :: Maybe Text 97 | , jwsCty :: Maybe Text 98 | , jwsKid :: Maybe KeyId 99 | } deriving (Eq, Show, Generic) 100 | 101 | -- | Header content for a JWE. 102 | data JweHeader = JweHeader { 103 | jweAlg :: JweAlg 104 | , jweEnc :: Enc 105 | , jweTyp :: Maybe Text 106 | , jweCty :: Maybe Text 107 | , jweZip :: Maybe Text 108 | , jweKid :: Maybe KeyId 109 | } deriving (Eq, Show, Generic) 110 | 111 | newtype IntDate = IntDate POSIXTime deriving (Show, Eq, Ord, Num) 112 | 113 | instance FromJSON IntDate where 114 | parseJSON = withScientific "IntDate" $ \n -> 115 | pure . IntDate . fromIntegral $ (round n :: Int64) 116 | 117 | instance ToJSON IntDate where 118 | toJSON (IntDate t) = Number $ fromIntegral (round t :: Int64) 119 | 120 | -- | Registered claims defined in section 4 of the JWT spec. 121 | data JwtClaims = JwtClaims 122 | { jwtIss :: !(Maybe Text) 123 | , jwtSub :: !(Maybe Text) 124 | , jwtAud :: !(Maybe [Text]) 125 | , jwtExp :: !(Maybe IntDate) 126 | , jwtNbf :: !(Maybe IntDate) 127 | , jwtIat :: !(Maybe IntDate) 128 | , jwtJti :: !(Maybe Text) 129 | } deriving (Show, Generic) 130 | 131 | -- Deal with the case where "aud" may be a single value rather than an array 132 | instance FromJSON JwtClaims where 133 | #if MIN_VERSION_aeson(2,0,0) 134 | parseJSON v@(Object o) = case KM.lookup "aud" o of 135 | Just (a@(String _)) -> genericParseJSON claimsOptions $ Object $ KM.insert "aud" (Array $ Data.Vector.singleton a) o 136 | #else 137 | parseJSON v@(Object o) = case H.lookup "aud" o of 138 | Just (a@(String _)) -> genericParseJSON claimsOptions $ Object $ H.insert "aud" (Array $ singleton a) o 139 | #endif 140 | _ -> genericParseJSON claimsOptions v 141 | parseJSON _ = fail "JwtClaims must be an object" 142 | 143 | instance ToJSON JwtClaims where 144 | toJSON = genericToJSON claimsOptions 145 | 146 | instance ToJSON Jwt where 147 | toJSON (Jwt bytes) = String (TE.decodeUtf8 bytes) 148 | 149 | instance FromJSON Jwt where 150 | parseJSON (String token) = pure $ Jwt (TE.encodeUtf8 token) 151 | parseJSON _ = fail "Jwt must be a string" 152 | 153 | claimsOptions :: Options 154 | claimsOptions = prefixOptions "jwt" 155 | 156 | defJwsHdr :: JwsHeader 157 | defJwsHdr = JwsHeader RS256 Nothing Nothing Nothing 158 | 159 | defJweHdr :: JweHeader 160 | defJweHdr = JweHeader RSA_OAEP A128GCM Nothing Nothing Nothing Nothing 161 | 162 | -- | Decoding errors. 163 | data JwtError = KeyError Text -- ^ No suitable key or wrong key type 164 | | BadAlgorithm Text -- ^ The supplied algorithm is invalid 165 | | BadDots Int -- ^ Wrong number of "." characters in the JWT 166 | | BadHeader Text -- ^ Header couldn't be decoded or contains bad data 167 | | BadClaims -- ^ Claims part couldn't be decoded or contains bad data 168 | | BadSignature -- ^ Signature is invalid 169 | | BadCrypto -- ^ A cryptographic operation failed 170 | | Base64Error String -- ^ A base64 decoding error 171 | deriving (Eq, Show) 172 | 173 | instance ToJSON JwsHeader where 174 | toJSON = genericToJSON jwsOptions 175 | 176 | instance FromJSON JwsHeader where 177 | parseJSON = genericParseJSON jwsOptions 178 | 179 | instance ToJSON JweHeader where 180 | toJSON = genericToJSON jweOptions 181 | 182 | instance FromJSON JweHeader where 183 | parseJSON = genericParseJSON jweOptions 184 | 185 | instance FromJSON JwtHeader where 186 | #if MIN_VERSION_aeson(2,0,0) 187 | parseJSON v@(Object o) = case KM.lookup "alg" o of 188 | Just (String "none") -> pure UnsecuredH 189 | _ -> case KM.lookup "enc" o of 190 | #else 191 | parseJSON v@(Object o) = case H.lookup "alg" o of 192 | Just (String "none") -> pure UnsecuredH 193 | _ -> case H.lookup "enc" o of 194 | #endif 195 | Nothing -> JwsH <$> parseJSON v 196 | _ -> JweH <$> parseJSON v 197 | parseJSON _ = fail "JwtHeader must be an object" 198 | 199 | encodeHeader :: ToJSON a => a -> ByteString 200 | encodeHeader h = BL.toStrict $ encode h 201 | 202 | parseHeader :: ByteString -> Either JwtError JwtHeader 203 | parseHeader hdr = either (Left . BadHeader . T.pack) return $ eitherDecodeStrict' hdr 204 | 205 | jwsOptions :: Options 206 | jwsOptions = prefixOptions "jws" 207 | 208 | jweOptions :: Options 209 | jweOptions = prefixOptions "jwe" 210 | 211 | prefixOptions :: String -> Options 212 | prefixOptions prefix = omitNothingOptions 213 | { fieldLabelModifier = dropPrefix $ length prefix 214 | , constructorTagModifier = addPrefix prefix 215 | } 216 | where 217 | omitNothingOptions = defaultOptions { omitNothingFields = True } 218 | dropPrefix l s = let remainder = drop l s 219 | in (toLower . head) remainder : tail remainder 220 | 221 | addPrefix p s = p ++ toUpper (head s) : tail s 222 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Luke Taylor 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 3. Neither the name of the author nor the names of his contributors 15 | may be used to endorse or promote products derived from this software 16 | without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 20 | TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 21 | PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR 22 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 23 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 24 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 25 | OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 27 | OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 28 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `jose-jwt` 2 | 3 | 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/). 4 | 5 | ## Background 6 | 7 | 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]. 8 | 9 | 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. 10 | 11 | ## Examples 12 | 13 | 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. 14 | 15 | The following examples can be entered directly into `ghci`. Use 16 | 17 | > :set -XOverloadedStrings 18 | 19 | to begin with. 20 | 21 | ### JWS signing example with a symmetric HMAC algorithm 22 | 23 | HMAC is a good choice when both signer and verifier have a copy of the key. 24 | 25 | > import Jose.Jws (hmacEncode, hmacDecode) 26 | > import Jose.Jwa (JwsAlg(HS256)) 27 | > 28 | > hmacEncode HS256 "aRANDOMlygeneratedkey" "my JSON message" 29 | Right (Jwt {unJwt = "eyJhbGciOiJIUzI1NiJ9.bXkgSlNPTiBtZXNzYWdl.lTJx7ECLwYF3P7WbrrUpcp_2SdLiFXaDwK-PXcipt5Q"}) 30 | > hmacDecode "aRANDOMlygeneratedkey" "eyJhbGciOiJIUzI1NiJ9.bXkgSlNPTiBtZXNzYWdl.lTJx7ECLwYF3P7WbrrUpcp_2SdLiFXaDwK-PXcipt5Q" 31 | Right (JwsHeader {jwsAlg = HS256, jwsTyp = Nothing, jwsCty = Nothing, jwsKid = Nothing},"my JSON message") 32 | 33 | Trying to decode with a different key would return a `Left BadSignature` [2]. 34 | 35 | ### JWS signing using Ed25519 private key 36 | 37 | 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. 38 | 39 | 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. 40 | 41 | > import Jose.Jwt 42 | > import Jose.Jwk 43 | > import Jose.Jwa (JwsAlg(EdDSA)) 44 | > import Data.ByteString (ByteString) 45 | > import Data.Aeson (decodeStrict) 46 | > 47 | > jsonJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed25519\", \"d\":\"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A\", \"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}" :: ByteString 48 | > Just jwk = decodeStrict jsonJwk :: Maybe Jwk 49 | > Jose.Jwt.encode [jwk] (JwsEncoding EdDSA) (Claims "public claims") 50 | Right (Jwt {unJwt = "eyJhbGciOiJFZERTQSJ9.cHVibGljIGNsYWltcw.xYekeeGSQVpnQbl16lOCqFcmYsUj3goSTrZ4UBQqogjHLrvFUaVJ_StBqly-Tb-0xvayjUMM4INYBTwFMt_xAQ"}) 51 | 52 | To verify the JWT you would use the `Jose.Jwt.decode` function with the corresponding public key. 53 | 54 | More examples can be found in the [package documentation](https://hackage.haskell.org/package/jose-jwt). 55 | 56 | ### Build Status 57 | ![Build Status](https://github.com/tekul/jose-jwt/workflows/Haskell%20CI/badge.svg) 58 | 59 | 60 | [1] This is now referred to as "compact serialization". The additional "JSON serialization" is not supported in this library. 61 | 62 | [2] Note that a real key for HMAC256 should be a much longer, random string of bytes. See, for example, 63 | [this stackexchange answer](https://crypto.stackexchange.com/a/34866). 64 | 65 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /benchmarks/Keys.hs: -------------------------------------------------------------------------------- 1 | module Keys where 2 | 3 | import qualified Crypto.PubKey.RSA as RSA 4 | import qualified Data.ByteString as B 5 | 6 | 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] 7 | 8 | jwsRsaPrivateKey = RSA.PrivateKey 9 | { RSA.private_pub = jwsRsaPublicKey 10 | , RSA.private_d = 2358310989939619510179986262349936882924652023566213765118606431955566700506538911356936879137503597382515919515633242482643314423192704128296593672966061810149316320617894021822784026407461403384065351821972350784300967610143459484324068427674639688405917977442472804943075439192026107319532117557545079086537982987982522396626690057355718157403493216553255260857777965627529169195827622139772389760130571754834678679842181142252489617665030109445573978012707793010592737640499220015083392425914877847840457278246402760955883376999951199827706285383471150643561410605789710883438795588594095047409018233862167884701 11 | , RSA.private_q = 0 12 | , RSA.private_p = 0 13 | , RSA.private_dP = 0 14 | , RSA.private_dQ = 0 15 | , RSA.private_qinv = 0 16 | } 17 | 18 | jwsRsaPublicKey = RSA.PublicKey 19 | { RSA.public_size = 256 20 | , RSA.public_n = 20446702916744654562596343388758805860065209639960173505037453331270270518732245089773723012043203236097095623402044690115755377345254696448759605707788965848889501746836211206270643833663949992536246985362693736387185145424787922241585721992924045675229348655595626434390043002821512765630397723028023792577935108185822753692574221566930937805031155820097146819964920270008811327036286786392793593121762425048860211859763441770446703722015857250621107855398693133264081150697423188751482418465308470313958250757758547155699749157985955379381294962058862159085915015369381046959790476428631998204940879604226680285601 21 | , RSA.public_e = 65537 22 | } 23 | 24 | -------------------------------------------------------------------------------- /benchmarks/bench.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main where 3 | 4 | import Criterion.Main 5 | import Crypto.Random 6 | import qualified Crypto.PubKey.Ed25519 as Ed25519 7 | import qualified Crypto.PubKey.Ed448 as Ed448 8 | import Data.Word (Word64) 9 | import Jose.Jws 10 | import qualified Jose.Jwe as Jwe 11 | import Jose.Jwa 12 | import Jose.Jwt 13 | import Jose.Jwk 14 | import Keys 15 | 16 | benchRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64 17 | 18 | fstWithRNG = fst . withDRG benchRNG 19 | 20 | msg = "The best laid schemes o' mice and men" 21 | 22 | main = do 23 | kwKek <- getRandomBytes 32 >>= \k -> return $ SymmetricJwk k Nothing Nothing Nothing :: IO Jwk 24 | ed25519PrivKey <- Ed25519.generateSecretKey 25 | ed448PrivKey <- Ed448.generateSecretKey 26 | let ed25519PubKey = Ed25519.toPublic ed25519PrivKey 27 | ed448PubKey = Ed448.toPublic ed448PrivKey 28 | Right rsaOAEPJwe <- Jwe.rsaEncode RSA_OAEP A256GCM jwsRsaPublicKey msg 29 | Right keywrapJwe <- Jwe.jwkEncode A256KW A256GCM kwKek (Claims msg) 30 | 31 | defaultMain 32 | [ benchJwsHmac 33 | , benchJwsRsa 34 | , benchJwsEd25519 ed25519PrivKey ed25519PubKey 35 | , benchJwsEd448 ed448PrivKey ed448PubKey 36 | , benchJweKeywrap (unJwt keywrapJwe) kwKek 37 | , benchJweRsa (unJwt rsaOAEPJwe) 38 | ] 39 | 40 | 41 | benchJweRsa jwe = bgroup "JWE-RSA" 42 | [ bench "decode RSA_OAEP" $ nf rsaDecrypt jwe 43 | ] 44 | where 45 | rsaDecrypt m = case fstWithRNG (Jwe.rsaDecode jwsRsaPrivateKey m) of 46 | Left _ -> error "RSA decode of JWE shouldn't fail" 47 | Right j -> snd j 48 | 49 | benchJweKeywrap jwe jwk = bgroup "JWE-KW" 50 | [ bench "decode A256KW" $ nf keywrapDecode jwe 51 | ] 52 | where 53 | keywrapDecode m = case fstWithRNG (Jwe.jwkDecode jwk m) of 54 | Right (Jwe j) -> snd j 55 | _ -> error "RSA decode of JWE shouldn't fail" 56 | 57 | 58 | benchJwsEd25519 kPr kPub = bgroup "Ed25519" 59 | [ bench "encode Ed25519" $ nf (unJwt . ed25519Encode kPr kPub) msg 60 | ] 61 | 62 | benchJwsEd448 kPr kPub = bgroup "Ed448" 63 | [ bench "encode Ed448" $ nf (unJwt . ed448Encode kPr kPub) msg 64 | ] 65 | 66 | benchJwsRsa = bgroup "JWS-RSA" 67 | [ bench "encode RSA256" $ nf (rsaE RS256) msg 68 | , bench "encode RSA384" $ nf (rsaE RS384) msg 69 | , bench "encode RSA512" $ nf (rsaE RS512) msg 70 | ] 71 | where 72 | rsaE a m = case fstWithRNG (rsaEncode a jwsRsaPrivateKey m) of 73 | Left _ -> error "RSA encode shouldn't fail" 74 | Right (Jwt j) -> j 75 | 76 | benchJwsHmac = bgroup "JWS-HMAC" 77 | [ bench "encode HS256" $ nf (hmacE HS256) msg 78 | , bench "encode HS384" $ nf (hmacE HS384) msg 79 | , bench "encode HS512" $ nf (hmacE HS512) msg 80 | ] 81 | where 82 | hmacE a m = case hmacEncode a jwsHmacKey m of 83 | Left _ -> error "HMAC shouldn't fail" 84 | Right (Jwt j) -> j 85 | -------------------------------------------------------------------------------- /benchmarks/profile.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, OverloadedStrings #-} 2 | module Main where 3 | 4 | import Crypto.Random 5 | import Jose.Jws 6 | import Jose.Jwa 7 | import qualified Data.ByteString.Char8 as B 8 | import Keys 9 | 10 | msgPrefix = "The best laid schemes o' mice and men..." 11 | 12 | main = do 13 | --rng <- cprgCreate `fmap` createEntropyPool :: IO SystemRNG 14 | let !msgs = map ((B.append msgPrefix) . B.pack . show) [1..10000] 15 | 16 | mapM_ B.putStrLn $ map (hmacEncode HS512 jwsHmacKey) msgs 17 | -------------------------------------------------------------------------------- /doctests.hs: -------------------------------------------------------------------------------- 1 | import Test.DocTest 2 | main = doctest ["-XOverloadedStrings", "Jose.Jwt", "Jose.Jws", "Jose.Jwe"] 3 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-parts": { 4 | "inputs": { 5 | "nixpkgs-lib": "nixpkgs-lib" 6 | }, 7 | "locked": { 8 | "lastModified": 1726153070, 9 | "narHash": "sha256-HO4zgY0ekfwO5bX0QH/3kJ/h4KvUDFZg8YpkNwIbg1U=", 10 | "owner": "hercules-ci", 11 | "repo": "flake-parts", 12 | "rev": "bcef6817a8b2aa20a5a6dbb19b43e63c5bf8619a", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "hercules-ci", 17 | "repo": "flake-parts", 18 | "type": "github" 19 | } 20 | }, 21 | "haskell-flake": { 22 | "locked": { 23 | "lastModified": 1726772832, 24 | "narHash": "sha256-/kSaQVrsZsw5jmvCtRRouXvYDQSdTJ4wzsthIpuXoLQ=", 25 | "owner": "srid", 26 | "repo": "haskell-flake", 27 | "rev": "31d7f050935f5a543212b7624d245f918ab14275", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "srid", 32 | "repo": "haskell-flake", 33 | "type": "github" 34 | } 35 | }, 36 | "nixpkgs": { 37 | "locked": { 38 | "lastModified": 1726652927, 39 | "narHash": "sha256-WO6Lmbn37PlamY2fDg3B187THkSKU/W01z8SxoIqJd0=", 40 | "owner": "nixos", 41 | "repo": "nixpkgs", 42 | "rev": "294eb5975def0caa718fca92dc5a9d656ae392a9", 43 | "type": "github" 44 | }, 45 | "original": { 46 | "owner": "nixos", 47 | "ref": "nixpkgs-unstable", 48 | "repo": "nixpkgs", 49 | "type": "github" 50 | } 51 | }, 52 | "nixpkgs-lib": { 53 | "locked": { 54 | "lastModified": 1725233747, 55 | "narHash": "sha256-Ss8QWLXdr2JCBPcYChJhz4xJm+h/xjl4G0c0XlP6a74=", 56 | "type": "tarball", 57 | "url": "https://github.com/NixOS/nixpkgs/archive/356624c12086a18f2ea2825fed34523d60ccc4e3.tar.gz" 58 | }, 59 | "original": { 60 | "type": "tarball", 61 | "url": "https://github.com/NixOS/nixpkgs/archive/356624c12086a18f2ea2825fed34523d60ccc4e3.tar.gz" 62 | } 63 | }, 64 | "root": { 65 | "inputs": { 66 | "flake-parts": "flake-parts", 67 | "haskell-flake": "haskell-flake", 68 | "nixpkgs": "nixpkgs" 69 | } 70 | } 71 | }, 72 | "root": "root", 73 | "version": 7 74 | } 75 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs = { 3 | nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable"; 4 | flake-parts.url = "github:hercules-ci/flake-parts"; 5 | haskell-flake.url = "github:srid/haskell-flake"; 6 | }; 7 | outputs = inputs@{ self, nixpkgs, flake-parts, ... }: 8 | flake-parts.lib.mkFlake { inherit inputs; } { 9 | systems = nixpkgs.lib.systems.flakeExposed; 10 | imports = [ inputs.haskell-flake.flakeModule ]; 11 | 12 | perSystem = { self', pkgs, ... }: { 13 | 14 | # Typically, you just want a single project named "default". But 15 | # multiple projects are also possible, each using different GHC version. 16 | haskellProjects.default = { 17 | # The base package set representing a specific GHC version. 18 | # By default, this is pkgs.haskellPackages. 19 | # You may also create your own. See https://community.flake.parts/haskell-flake/package-set 20 | # basePackages = pkgs.haskellPackages; 21 | 22 | # Extra package information. See https://community.flake.parts/haskell-flake/dependency 23 | # 24 | # Note that local packages are automatically included in `packages` 25 | # (defined by `defaults.packages` option). 26 | # 27 | packages = { 28 | # aeson.source = "1.5.0.0"; # Override aeson to a custom version from Hackage 29 | # shower.source = inputs.shower; # Override shower to a custom source path 30 | }; 31 | settings = { 32 | # aeson = { 33 | # check = false; 34 | # }; 35 | # relude = { 36 | # haddock = false; 37 | # broken = false; 38 | # }; 39 | }; 40 | 41 | devShell = { 42 | # Enabled by default 43 | # enable = true; 44 | 45 | # Programs you want to make available in the shell. 46 | # Default programs can be disabled by setting to 'null' 47 | # tools = hp: { fourmolu = hp.fourmolu; ghcid = null; }; 48 | 49 | # Check that haskell-language-server works 50 | # hlsCheck.enable = true; # Requires sandbox to be disabled 51 | }; 52 | }; 53 | 54 | # haskell-flake doesn't set the default package, but you can do it here. 55 | packages.default = self'.packages.jose-jwt; 56 | }; 57 | }; 58 | } 59 | -------------------------------------------------------------------------------- /jose-jwt.cabal: -------------------------------------------------------------------------------- 1 | Name: jose-jwt 2 | Version: 0.10.0 3 | Synopsis: JSON Object Signing and Encryption Library 4 | Homepage: http://github.com/tekul/jose-jwt 5 | Bug-Reports: http://github.com/tekul/jose-jwt/issues 6 | Description: 7 | . 8 | An implementation of the JOSE suite of IETF standards 9 | and the closely related JWT (JSON web token) spec 10 | (). 11 | . 12 | Both signed and encrypted JWTs are supported, as well as simple 13 | JWK keys. 14 | 15 | Author: Luke Taylor 16 | Maintainer: Luke Taylor 17 | License: BSD3 18 | License-File: LICENSE 19 | Build-Type: Simple 20 | Cabal-Version: 1.16 21 | Category: JSON, Cryptography 22 | 23 | Extra-Source-Files: 24 | README.md 25 | CHANGELOG.md 26 | tests/*.json 27 | 28 | -- disable doctests with -f-doctest 29 | Flag doctest 30 | default: False 31 | manual: True 32 | 33 | Source-Repository head 34 | Type: git 35 | Location: https://github.com/tekul/jose-jwt.git 36 | 37 | Library 38 | Default-Language: Haskell2010 39 | Exposed-modules: Jose.Jwt 40 | , Jose.Jws 41 | , Jose.Jwe 42 | , Jose.Jwa 43 | , Jose.Jwk 44 | , Jose.Internal.Base64 45 | , Jose.Internal.Crypto 46 | , Jose.Internal.Parser 47 | Other-Modules: Jose.Types 48 | 49 | if impl(ghc < 8.0) 50 | Buildable: False 51 | else 52 | Build-depends: base >= 4.9 && < 5 53 | , aeson >= 1.5 && < 2.3 54 | , attoparsec >= 0.12.0.0 55 | , bytestring >= 0.9 56 | , cereal >= 0.4 57 | , containers >= 0.4 58 | , crypton >= 0.32 59 | , memory >= 0.10 60 | , mtl >= 2.1.3.1 61 | , text >= 0.11 62 | , time >= 1.4 63 | , transformers >= 0.3 64 | , transformers-compat >= 0.4 65 | , unordered-containers >= 0.2 66 | , vector >= 0.10 67 | Ghc-Options: -Wall 68 | 69 | Test-suite tests 70 | Default-Language: Haskell2010 71 | Type: exitcode-stdio-1.0 72 | Other-Modules: Tests.JwsSpec 73 | , Tests.JweSpec 74 | , Tests.JwkSpec 75 | Build-depends: jose-jwt 76 | , base >= 4.9 && < 5 77 | , aeson 78 | , bytestring 79 | , crypton 80 | , memory 81 | , mtl 82 | , text 83 | , unordered-containers 84 | , vector 85 | , hspec >= 1.6 86 | , HUnit >= 1.2 87 | , QuickCheck >= 2.4 88 | Ghc-options: -Wall -rtsopts -fno-warn-missing-signatures 89 | Hs-source-dirs: tests 90 | Main-is: tests.hs 91 | 92 | Test-suite doctests 93 | Default-Language: Haskell2010 94 | Type: exitcode-stdio-1.0 95 | Main-is: doctests.hs 96 | Default-Extensions: OverloadedStrings 97 | 98 | if !flag(doctest) 99 | Buildable: False 100 | else 101 | Build-depends: base >= 4.9 && < 5 102 | , doctest >= 0.9.11 103 | , crypton 104 | 105 | Benchmark bench-jwt 106 | Default-Language: Haskell2010 107 | Hs-source-dirs: benchmarks 108 | Main-is: bench.hs 109 | Other-Modules: Keys 110 | Type: exitcode-stdio-1.0 111 | Build-depends: jose-jwt 112 | , base >= 4.9 && < 5 113 | , bytestring 114 | , criterion 115 | , crypton 116 | 117 | Ghc-Options: -Wall -fno-warn-missing-signatures 118 | -------------------------------------------------------------------------------- /new_release.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Script to create a new release. 4 | # 5 | # Creates a commit containing only the CHANGELOG and cabal file changes. 6 | # 7 | # Checks the state of the repository to make sure things are up to date 8 | # beforehand, and also checks the current build status on travis. 9 | # 10 | # Nothing project-specific. Should work for any project on github which 11 | # is set up to use travis. 12 | 13 | #set -x 14 | set -e 15 | cd `dirname $0` 16 | 17 | NEW_VERSION="$1" 18 | BRANCH="$2" 19 | [ -z "$BRANCH" ] && BRANCH="master" 20 | SLUG=`git config -l | grep remote.origin.url | sed s/.*:// | sed s/\.git//` 21 | PROJECT=`echo $SLUG | sed 's/.*\///'` 22 | 23 | function opt_exit { 24 | read -t 30 -p "Do you want to continue (y/n) ? " yn 25 | case ${yn:0:1} in 26 | y|Y ) 27 | echo "Continuing..." 28 | ;; 29 | * ) 30 | exit 1 31 | ;; 32 | esac 33 | } 34 | 35 | git status -b -s | grep -q "## $BRANCH" \ 36 | || ( echo "Not on $BRANCH branch."; exit 1 ) 37 | 38 | [ -f "$PROJECT.cabal" ] \ 39 | || ( echo "Cabal file not found for $PROJECT."; exit 1 ) 40 | 41 | [ -z "$NEW_VERSION" ] \ 42 | && ( echo "Please provide new version for the release."; exit 1 ) 43 | 44 | echo "Project is $PROJECT. Release is $NEW_VERSION" 45 | 46 | # The only uncommitted change at this stage should be the CHANGELOG 47 | git status -s --untracked-files=no | grep -v 'CHANGELOG' \ 48 | && ( echo "There are uncommitted changes. Make sure changes are committed or stashed and pushed, and the CI build is OK."; exit 1 ) 49 | 50 | git status -s | grep '??' \ 51 | && ( echo "There are untracked files in the repository."; opt_exit ) 52 | 53 | # Make sure we have latest changes and check we are up to date with origin 54 | git fetch origin 55 | 56 | [ `git rev-list HEAD...origin/$BRANCH --count` = "0" ] \ 57 | || ( echo "$BRANCH is different from origin/$BRANCH"; opt_exit ) 58 | 59 | git tag | grep -q "$NEW_VERSION" \ 60 | && ( echo "A git tag matching $NEW_VERSION already exists."; exit 1 ) 61 | 62 | grep -q "$NEW_VERSION" CHANGELOG.md \ 63 | || ( echo "Please add a changelog entry for this release."; exit 1 ) 64 | 65 | echo "Checking CI build state..." 66 | CI_RUN=$(curl -H "Accept: application/vnd.github.v3+json" "https://api.github.com/repos/$SLUG/actions/runs" \ 67 | | jq '.workflow_runs | map(select(.head_branch == "master" and .name == "Haskell CI"))[0]') 68 | 69 | CI_STATUS=$(jq -n "${CI_RUN}|.status") 70 | 71 | [[ $CI_STATUS = "\"completed\"" ]] \ 72 | || ( echo "Last CI Run status is $CI_STATUS (not \"completed\"). Please check it or wait for it to finish."; exit 1) 73 | 74 | CI_CONCLUSION=$(jq -n "${CI_RUN}|.conclusion") 75 | 76 | [[ $CI_CONCLUSION = "\"success\"" ]] \ 77 | || ( echo "Last CI Run conclusion is $CI_CONCLUSION (expected \"success\")"; exit 1) 78 | 79 | perl -i -p -e 's/^([vV]ersion:\s+)\d.*/${1}'"${NEW_VERSION}"'/' "$PROJECT.cabal" 80 | 81 | git add "$PROJECT.cabal" 82 | git add CHANGELOG.md 83 | 84 | git commit -m "Release $NEW_VERSION" 85 | git tag -m "Release $NEW_VERSION" -s "$NEW_VERSION" \ 86 | || ( echo "Failed to tag release."; exit 1 ) 87 | 88 | echo "No remote changes yet. Next step will push the changes." 89 | opt_exit 90 | 91 | git push 92 | git push --tags 93 | 94 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-14.11 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: 15 | jose-jwt: 16 | doctest: true 17 | 18 | # Extra package databases containing global packages 19 | extra-package-dbs: [] 20 | 21 | # Control whether we use the GHC we find on the path 22 | # system-ghc: true 23 | 24 | # Require a specific version of stack, using version ranges 25 | # require-stack-version: -any # Default 26 | # require-stack-version: >= 1.0.0 27 | 28 | # Override the architecture used by stack, especially useful on Windows 29 | # arch: i386 30 | # arch: x86_64 31 | 32 | # Extra directories used by stack for building 33 | # extra-include-dirs: [/path/to/dir] 34 | # extra-lib-dirs: [/path/to/dir] 35 | -------------------------------------------------------------------------------- /tests/Tests/JweSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-incomplete-uni-patterns #-} 4 | 5 | module Tests.JweSpec where 6 | 7 | import Data.Aeson (decodeStrict') 8 | import Data.Bits (xor) 9 | import Data.Word (Word8, Word64) 10 | import qualified Data.ByteArray as BA 11 | import qualified Data.ByteString as B 12 | import qualified Data.ByteString.Char8 as BC 13 | import Test.Hspec 14 | import Test.HUnit hiding (Test) 15 | import Test.QuickCheck 16 | 17 | import qualified Crypto.PubKey.RSA as RSA 18 | import Crypto.Hash (SHA1(..), hashDigestSize) 19 | import Crypto.PubKey.RSA.Prim (dp) 20 | import Crypto.PubKey.MaskGenFunction 21 | import Crypto.Cipher.Types (AuthTag(..)) 22 | import Crypto.Random (DRG(..), withDRG, drgNewTest) 23 | import Jose.Jwt 24 | import qualified Jose.Jwe as Jwe 25 | import Jose.Jwa 26 | import qualified Jose.Jwk as Jwk 27 | import Jose.Internal.Crypto 28 | import Jose.Internal.Parser(Tag(..), IV(..)) 29 | import qualified Jose.Internal.Base64 as B64 30 | 31 | -------------------------------------------------------------------------------- 32 | -- JWE Appendix Data Tests (plus quickcheck) 33 | -------------------------------------------------------------------------------- 34 | 35 | spec :: Spec 36 | spec = 37 | describe "JWE encoding and decoding" $ do 38 | context "when using JWE Appendix 1 data" $ do 39 | let a1Header = defJweHdr {jweAlg = RSA_OAEP, jweEnc = A256GCM} 40 | 41 | it "generates the expected IV and CMK from the RNG" $ 42 | withDRG (RNG . BA.convert $ BA.append a1cek a1iv) 43 | (generateCmkAndIV A256GCM) @?= ((a1cek, a1iv), RNG "") 44 | 45 | it "generates the expected RSA-encrypted content key" $ 46 | withDRG (RNG a1oaepSeed) 47 | (rsaEncrypt a1PubKey RSA_OAEP a1cek) @?= (Right a1jweKey, RNG "") 48 | 49 | it "encrypts the payload to the expected ciphertext and authentication tag" $ do 50 | let aad = B64.encode ("{\"alg\":\"RSA-OAEP\",\"enc\":\"A256GCM\"}" :: B.ByteString) 51 | encryptPayload A256GCM a1cek a1iv aad a1Payload @?= Just (AuthTag a1Tag, a1Ciphertext) 52 | 53 | it "encodes the payload to the expected JWT, leaving the RNG empty" $ 54 | withDRG (RNG $ BA.concat [a1cek, a1iv, BA.convert a1oaepSeed]) 55 | (Jwe.rsaEncode RSA_OAEP A256GCM a1PubKey a1Payload) @?= (Right (Jwt a1), RNG "") 56 | 57 | it "decodes the JWT to the expected header and payload" $ 58 | withBlinder (Jwe.rsaDecode a1PrivKey a1) @?= Right (a1Header, a1Payload) 59 | 60 | it "decodes the JWK to the correct RSA key values" $ do 61 | let Just (Jwk.RsaPrivateJwk (RSA.PrivateKey pubKey d 0 0 0 0 0) _ _ _) = decodeStrict' a1jwk 62 | RSA.public_n pubKey @?= a1RsaModulus 63 | RSA.public_e pubKey @?= rsaExponent 64 | d @?= a1RsaPrivateExponent 65 | 66 | it "decodes the JWT using the JWK" $ do 67 | let Just k1 = decodeStrict' a1jwk 68 | Just k2 = decodeStrict' a2jwk 69 | withBlinder (decode [k2, k1] (Just $ JweEncoding RSA_OAEP A256GCM) a1) @?= Right (Jwe (a1Header, a1Payload)) 70 | 71 | it "a truncated CEK returns BadCrypto" $ do 72 | let [hdr, _, iv, payload, tag] = BC.split '.' a1 73 | newEk = encryptCek a1PubKey RSA_OAEP (BA.drop 1 a1cek) 74 | withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadCrypto 75 | 76 | it "a truncated payload returns BadCrypto" $ do 77 | let [hdr, ek, iv, payload, tag] = BC.split '.' a1 78 | Right ct = B64.decode payload 79 | withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto 80 | 81 | it "a truncated auth tag returns BadCrypto" $ do 82 | let [hdr, ek, iv, payload, tag] = BC.split '.' a1 83 | Right tagBytes = B64.decode tag 84 | badTag = B64.encode $ BC.take 2 tagBytes 85 | withBlinder (Jwe.rsaDecode a1PrivKey (B.intercalate "." [hdr, ek, iv, payload, badTag])) @?= Left BadCrypto 86 | 87 | 88 | it "a truncated IV returns BadCrypto" $ do 89 | let (fore, aft) = BC.breakSubstring (B64.encode a1iv) a1 90 | newIv = B64.encode (BA.drop 1 a1iv) 91 | withBlinder (Jwe.rsaDecode a1PrivKey (B.concat [fore, newIv, aft])) @?= Left BadCrypto 92 | 93 | 94 | context "when using JWE Appendix 2 data" $ do 95 | let a2Header = defJweHdr {jweAlg = RSA1_5, jweEnc = A128CBC_HS256} 96 | let aad = B64.encode ("{\"alg\":\"RSA1_5\",\"enc\":\"A128CBC-HS256\"}" :: B.ByteString) 97 | 98 | it "generates the expected RSA-encrypted content key" $ 99 | withDRG (RNG a2seed) (rsaEncrypt a2PubKey RSA1_5 a2cek) @?= (Right a2jweKey, RNG "") 100 | 101 | it "encrypts the payload to the expected ciphertext and authentication tag" $ 102 | encryptPayload A128CBC_HS256 a2cek a2iv aad a2Payload @?= Just (AuthTag (BA.convert a2Tag), a2Ciphertext) 103 | 104 | it "encodes the payload to the expected JWT" $ 105 | withDRG (RNG $ BA.concat [BA.convert a2cek, a2iv, a2seed]) 106 | (Jwe.rsaEncode RSA1_5 A128CBC_HS256 a2PubKey a2Payload) @?= (Right (Jwt a2), RNG "") 107 | 108 | it "decrypts the ciphertext to the correct payload" $ 109 | decryptPayload A128CBC_HS256 a2cek (IV16 a2iv) aad (Tag16 a2Tag) a2Ciphertext @?= Just a2Payload 110 | 111 | it "decodes the JWT to the expected header and payload" $ 112 | withBlinder (Jwe.rsaDecode a2PrivKey a2) @?= Right (a2Header, a2Payload) 113 | 114 | it "a truncated CEK returns BadCrypto" $ do 115 | let [hdr, _, iv, payload, tag] = BC.split '.' a2 116 | newEk = encryptCek a2PubKey RSA1_5 (BA.drop 1 a2cek) 117 | withBlinder (Jwe.rsaDecode a2PrivKey (B.intercalate "." [hdr, B64.encode newEk, iv, payload, tag])) @?= Left BadCrypto 118 | 119 | it "a truncated payload returns BadCrypto" $ do 120 | let [hdr, ek, iv, payload, tag] = BC.split '.' a2 121 | Right ct = B64.decode payload 122 | withBlinder (Jwe.rsaDecode a2PrivKey (B.intercalate "." [hdr, ek, iv, B64.encode (B.tail ct), tag])) @?= Left BadCrypto 123 | 124 | it "a truncated IV returns BadCrypto" $ do 125 | let (fore, aft) = BC.breakSubstring (B64.encode a2iv) a2 126 | newIv = B64.encode (B.tail a2iv) 127 | withBlinder (Jwe.rsaDecode a2PrivKey (B.concat [fore, newIv, aft])) @?= Left BadCrypto 128 | 129 | context "when using JWE Appendix 3 data" $ do 130 | let Just jwk = decodeStrict' a3jwk 131 | a3Header = defJweHdr {jweAlg = A128KW, jweEnc = A128CBC_HS256} 132 | it "encodes the payload to the expected JWT" $ 133 | withDRG (RNG $ B.concat [a3cek, a3iv]) 134 | (Jwe.jwkEncode A128KW A128CBC_HS256 jwk (Claims a3Payload)) @?= (Right (Jwt a3), RNG "") 135 | 136 | it "decodes the JWT using the JWK" $ 137 | withBlinder (decode [jwk] Nothing a3) @?= Right (Jwe (a3Header, a3Payload)) 138 | 139 | context "when used with quickcheck" $ do 140 | it "padded msg is always a multiple of 16" $ property $ 141 | \s -> B.length (pad (B.pack s)) `mod` 16 == 0 142 | it "unpad is the inverse of pad" $ property $ 143 | \s -> let msg = B.pack s in (unpad . pad) msg == Just msg 144 | it "jwe decode/decode returns the original payload" $ property jweRoundTrip 145 | 146 | context "miscellaneous tests" $ do 147 | it "Padding byte larger than 16 is rejected" $ 148 | up "111a" @?= Nothing 149 | it "Padding byte which doesn't match padding length is rejected" $ 150 | up "111\t\t\t\t\t\t\t" @?= Nothing 151 | it "Padding byte which matches padding length is OK" $ 152 | up "1111111\t\t\t\t\t\t\t\t\t" @?= Just "1111111" 153 | it "Rejects invalid Base64 JWT" $ 154 | withBlinder (Jwe.rsaDecode a2PrivKey "=.") @?= Left BadCrypto 155 | 156 | up :: BC.ByteString -> Maybe BC.ByteString 157 | up = unpad 158 | 159 | -- verboseQuickCheckWith quickCheckWith stdArgs {maxSuccess=10000} jweRoundTrip 160 | jweRoundTrip :: RNG -> JWEAlgs -> [Word8] -> Bool 161 | jweRoundTrip g (JWEAlgs a e) msg = encodeDecode == Right (Jwe (defJweHdr {jweAlg = a, jweEnc = e }, bs)) 162 | where 163 | jwks = [a1jwk, a2jwk, a3jwk, aes192jwk, aes256jwk] >>= \j -> let Just jwk = decodeStrict' j in [jwk] 164 | bs = B.pack msg 165 | encodeDecode = fst (withDRG blinderRNG (decode jwks Nothing encoded)) 166 | Right encoded = unJwt <$> fst (withDRG g (encode jwks (JweEncoding a e) (Claims bs))) 167 | 168 | encryptCek kpub a cek = 169 | let 170 | (Right newEk, _) = withDRG blinderRNG $ rsaEncrypt kpub a (BA.drop 1 cek) 171 | in 172 | newEk :: BC.ByteString 173 | 174 | withBlinder = fst . withDRG blinderRNG 175 | 176 | -- A decidedly non-random, random number generator which allows specific 177 | -- sequences of bytes to be supplied which match the JWE test data. 178 | newtype RNG = RNG B.ByteString deriving (Eq, Show) 179 | 180 | genBytes :: BA.ByteArray ba => Int -> RNG -> (ba, RNG) 181 | genBytes 0 g = (BA.empty, g) 182 | genBytes n (RNG bs) = (BA.convert bytes, RNG next) 183 | where 184 | (bytes, next) = if BA.null bs 185 | then error "RNG is empty" 186 | else BA.splitAt n bs 187 | 188 | instance DRG RNG where 189 | randomBytesGenerate = genBytes 190 | 191 | blinderRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64 192 | 193 | -------------------------------------------------------------------------------- 194 | -- JWE Appendix 1 Test Data 195 | -------------------------------------------------------------------------------- 196 | 197 | a1 :: B.ByteString 198 | a1 = "eyJhbGciOiJSU0EtT0FFUCIsImVuYyI6IkEyNTZHQ00ifQ.OKOawDo13gRp2ojaHV7LFpZcgV7T6DVZKTyKOMTYUmKoTCVJRgckCL9kiMT03JGeipsEdY3mx_etLbbWSrFr05kLzcSr4qKAq7YN7e9jwQRb23nfa6c9d-StnImGyFDbSv04uVuxIp5Zms1gNxKKK2Da14B8S4rzVRltdYwam_lDp5XnZAYpQdb76FdIKLaVmqgfwX7XWRxv2322i-vDxRfqNzo_tETKzpVLzfiwQyeyPGLBIO56YJ7eObdv0je81860ppamavo35UgoRdbYaBcoh9QcfylQr66oc6vFWXRcZ_ZT2LawVCWTIy3brGPi6UklfCpIMfIjf7iGdXKHzg.48V1_ALb6US04U3b.5eym8TW_c8SuK0ltJ3rpYIzOeDQz7TALvtu6UG9oMo4vpzs9tX_EFShS8iB7j6jiSdiwkIr3ajwQzaBtQD_A.XFBoMYUZodetZdvTiFvSkQ" 199 | 200 | a1Payload = "The true sign of intelligence is not knowledge but imagination." 201 | 202 | a1cek :: BA.ScrubbedBytes 203 | 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] 204 | 205 | a1iv :: BA.ScrubbedBytes 206 | a1iv = BA.pack [227, 197, 117, 252, 2, 219, 233, 68, 180, 225, 77, 219] 207 | 208 | 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] 209 | 210 | 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] 211 | 212 | a1Tag = BA.pack [92, 80, 104, 49, 133, 25, 161, 215, 173, 101, 219, 211, 136, 91, 210, 145] 213 | 214 | Right a1jweKey = B64.decode $ BC.pack "OKOawDo13gRp2ojaHV7LFpZcgV7T6DVZKTyKOMTYUmKoTCVJRgckCL9kiMT03JGeipsEdY3mx_etLbbWSrFr05kLzcSr4qKAq7YN7e9jwQRb23nfa6c9d-StnImGyFDbSv04uVuxIp5Zms1gNxKKK2Da14B8S4rzVRltdYwam_lDp5XnZAYpQdb76FdIKLaVmqgfwX7XWRxv2322i-vDxRfqNzo_tETKzpVLzfiwQyeyPGLBIO56YJ7eObdv0je81860ppamavo35UgoRdbYaBcoh9QcfylQr66oc6vFWXRcZ_ZT2LawVCWTIy3brGPi6UklfCpIMfIjf7iGdXKHzg" 215 | 216 | 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\" }" 217 | 218 | a1RsaModulus = 20407373051396142380600281265251892119308905183562582378265551916401741797298132714477564366125574073854325621181754666299468042787718090965019045494120492365709229334674806858420600185271825023335981142192553851711447185679749878133484409202142610505370119489349112667599681596271324052456163162582257897587607185901342235063647947816589525124013368466111231306949063172170503467209564034546753006291531308789606255762727496010190006847721118463557533668762287451483156476421856126198680670740028037673487624895510756370816101325723975021588898704953504010419555312457504338174094966173304768490140232017447246019099 219 | 220 | rsaExponent = 65537 :: Integer 221 | 222 | a1RsaPrivateExponent = 18268766796654718362565236454995853620820821188251417451980738596264305499270399136757621249007756005599271096771478165267306874014871487538744562309757162619646837295513011635819128008143685281506609665247035139326775637222412463191989209202137797209813686014322033219332678022668756745556718137625135245640638710814390273901357613670762406363679831247433360271391936119294533419667412739496199381069233394069901435128732415071218792819358792459421008659625326677236263304891550388749907992141902573512326268421915766834378108391128385175130554819679860804655689526143903449732010240859012168194104458903308465660105 223 | 224 | a1oaepSeed = extractOaepSeed a1PrivKey a1jweKey 225 | 226 | (a1PubKey, a1PrivKey) = createKeyPair a1RsaModulus a1RsaPrivateExponent 227 | 228 | 229 | -------------------------------------------------------------------------------- 230 | -- JWE Appendix 2 Test Data 231 | -------------------------------------------------------------------------------- 232 | 233 | a2Payload = "Live long and prosper." 234 | 235 | a2cek :: BA.ScrubbedBytes 236 | 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] 237 | 238 | --a2cek = B.pack [203, 165, 180, 113, 62, 195, 22, 98, 91, 153, 210, 38, 112, 35, 230, 236] 239 | 240 | --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] 241 | 242 | a2iv = B.pack [3, 22, 60, 12, 43, 67, 104, 105, 108, 108, 105, 99, 111, 116, 104, 101] 243 | 244 | 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] 245 | 246 | a2Tag = B.pack [246, 17, 244, 190, 4, 95, 98, 3, 231, 0, 115, 157, 242, 203, 100, 191] 247 | 248 | Right a2jweKey = B64.decode $ BC.pack "UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A" 249 | 250 | 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\" }" 251 | 252 | a2RsaModulus = 22402924734748322419583087865046136971812964522608965289668050862528140628890468829261358173206844190609885548664216273129288787509446229835492005268681636400878070687042995563617837593077316848511917526886594334868053765054121327206058496913599608196082088434862911200952954663261204130886151917541465131565772711448256433529200865576041706962504490609565420543616528240562874975930318078653328569211055310553145904641192292907110395318778917935975962359665382660933281263049927785938817901532807037136641587608303638483543899849101763615990006657357057710971983052920787558713523025279998057051825799400286243909447 253 | 254 | a2RsaPrivateExponent = 10643756465292254988457796463889735064030094089452909840615134957452106668931481879498770304395097541282329162591478128330968231330113176654221501869950411410564116254672288216799191435916328405513154035654178369543717138143188973636496077305930253145572851787483810154020967535132278148578697716656066036003388130625459567907864689911133288140117207430454310073863484450086676106606775792171446149215594844607410066899028283290532626577379520547350399030663657813726123700613989625283009134539244470878688076926304079342487789922656366430636978871435674556143884272163840709196449089335092169596187792960067104244313 255 | 256 | a2 :: B.ByteString 257 | a2 = "eyJhbGciOiJSU0ExXzUiLCJlbmMiOiJBMTI4Q0JDLUhTMjU2In0.UGhIOguC7IuEvf_NPVaXsGMoLOmwvc1GyqlIKOK1nN94nHPoltGRhWhw7Zx0-kFm1NJn8LE9XShH59_i8J0PH5ZZyNfGy2xGdULU7sHNF6Gp2vPLgNZ__deLKxGHZ7PcHALUzoOegEI-8E66jX2E4zyJKx-YxzZIItRzC5hlRirb6Y5Cl_p-ko3YvkkysZIFNPccxRU7qve1WYPxqbb2Yw8kZqa2rMWI5ng8OtvzlV7elprCbuPhcCdZ6XDP0_F8rkXds2vE4X-ncOIM8hAYHHi29NX0mcKiRaD0-D-ljQTP-cFPgwCp6X-nZZd9OHBv-B3oWh2TbqmScqXMR4gp_A.AxY8DCtDaGlsbGljb3RoZQ.KDlTtXchhZTGufMYmOYGS4HffxPSUrfmqCHXaI9wOGY.9hH0vgRfYgPnAHOd8stkvw" 258 | 259 | (a2PubKey, a2PrivKey) = createKeyPair a2RsaModulus a2RsaPrivateExponent 260 | 261 | a2seed = extractPKCS15Seed a2PrivKey a2jweKey 262 | 263 | a3Payload = a2Payload 264 | 265 | a3jwk = "{\"kty\":\"oct\", \"k\":\"GawgguFyGrWKav7AX4VKUg\"}" 266 | 267 | -- We need keys that are valid for AES192 and AES256 for quickcheck tests 268 | aes192jwk = "{\"kty\":\"oct\", \"k\":\"FatNm7ez26tyPGsXdaqhYHtvThX0jSAA\"}" 269 | aes256jwk = "{\"kty\":\"oct\", \"k\":\"1MeiHdxK8CQBsmjgOM8SCxg06MTjFzG7sFa7EnDCJzo\"}" 270 | 271 | 272 | 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] 273 | 274 | a3iv = B.pack [3, 22, 60, 12, 43, 67, 104, 105, 108, 108, 105, 99, 111, 116, 104, 101] 275 | 276 | a3 :: B.ByteString 277 | a3 = "eyJhbGciOiJBMTI4S1ciLCJlbmMiOiJBMTI4Q0JDLUhTMjU2In0.6KB707dM9YTIgHtLvtgWQ8mKwboJW3of9locizkDTHzBC2IlrT1oOQ.AxY8DCtDaGlsbGljb3RoZQ.KDlTtXchhZTGufMYmOYGS4HffxPSUrfmqCHXaI9wOGY.U0m_YmjN04DJvceFICbCVQ" 278 | 279 | 280 | 281 | -------------------------------------------------------------------------------- 282 | -- Quickcheck Stuff 283 | -------------------------------------------------------------------------------- 284 | 285 | -- Valid JWE Alg/Enc combinations 286 | data JWEAlgs = JWEAlgs JweAlg Enc deriving Show 287 | 288 | instance Arbitrary Enc where 289 | arbitrary = elements [A128CBC_HS256, A192CBC_HS384, A256CBC_HS512, A128GCM, A192GCM, A256GCM] 290 | 291 | instance Arbitrary JWEAlgs where 292 | arbitrary = do 293 | a <- elements [RSA1_5, RSA_OAEP, RSA_OAEP_256, A128KW, A192KW, A256KW] 294 | e <- arbitrary 295 | return $ JWEAlgs a e 296 | 297 | instance Arbitrary RNG where 298 | arbitrary = RNG . B.pack <$> vector 600 299 | 300 | 301 | -------------------------------------------------------------------------------- 302 | -- Utility Functions 303 | -------------------------------------------------------------------------------- 304 | 305 | createKeyPair n d = (pubKey, privKey) 306 | where 307 | privKey = RSA.PrivateKey 308 | { RSA.private_pub = pubKey 309 | , RSA.private_d = d 310 | , RSA.private_q = 0 311 | , RSA.private_p = 0 312 | , RSA.private_dP = 0 313 | , RSA.private_dQ = 0 314 | , RSA.private_qinv = 0 315 | } 316 | pubKey = RSA.PublicKey 317 | { RSA.public_size = 256 318 | , RSA.public_n = n 319 | , RSA.public_e = rsaExponent 320 | } 321 | 322 | -- Extracts the random padding bytes from the decrypted content key 323 | -- allowing them to be used in the test RNG 324 | extractOaepSeed :: RSA.PrivateKey -> B.ByteString -> B.ByteString 325 | extractOaepSeed key ct = B.pack $ B.zipWith xor maskedSeed seedMask 326 | where 327 | em = dp Nothing key ct 328 | hashLen = hashDigestSize SHA1 329 | em0 = B.tail em 330 | (maskedSeed, maskedDB) = B.splitAt hashLen em0 331 | seedMask = mgf1 SHA1 maskedDB hashLen 332 | 333 | -- Decrypt, drop the 02 at the start and take the bytes up to the next 0 334 | extractPKCS15Seed :: RSA.PrivateKey -> B.ByteString -> B.ByteString 335 | extractPKCS15Seed key ct = B.takeWhile (/= 0) . B.drop 2 $ dp Nothing key ct 336 | -------------------------------------------------------------------------------- /tests/Tests/JwkSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, CPP #-} 2 | {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} 3 | 4 | module Tests.JwkSpec where 5 | 6 | import Test.Hspec 7 | import Test.HUnit hiding (Test) 8 | 9 | import Data.Aeson 10 | #if MIN_VERSION_aeson(2,0,0) 11 | import qualified Data.Aeson.KeyMap as KM 12 | #else 13 | import qualified Data.HashMap.Strict as H 14 | #endif 15 | import qualified Data.ByteString.Char8 as B 16 | import Data.Word (Word64) 17 | import qualified Data.Vector as V 18 | import Crypto.PubKey.ECC.ECDSA 19 | import Crypto.PubKey.ECC.Types 20 | import Crypto.Random (drgNewTest, withDRG) 21 | 22 | import Jose.Jwt (defJwsHdr, JwsHeader(..), KeyId(..)) 23 | import Jose.Jwk 24 | import Jose.Jwa 25 | 26 | spec :: Spec 27 | spec = do 28 | jwkFile <- runIO (B.readFile "tests/jwks.json") 29 | let Just (Object keySet) = decodeStrict jwkFile 30 | Success s = fromJSON (Object keySet) :: Result JwkSet 31 | Just s' = decode (encode s) 32 | Just s'' = decode' (encode s') 33 | kss = keys s' 34 | k0 = head kss 35 | k1 = kss !! 1 36 | k3 = kss !! 3 37 | k4 = kss !! 4 38 | describe "JWK encoding and decoding" $ do 39 | it "decodes and encodes an entire key set successfully" $ do 40 | let RsaPublicJwk _ key0Id key0Use a0 = k0 41 | RsaPublicJwk _ key1Id key1Use _ = k1 42 | EcPublicJwk k key2Id key2Use _ _ = kss !! 2 43 | EcPublicJwk _ key3Id key3Use _ _ = k3 44 | SymmetricJwk _ key4Id Nothing _ = k4 45 | EcPublicJwk _ key5Id (Just Enc) _ _ = kss !! 5 46 | RsaPublicJwk _ key6Id Nothing a6 = kss !! 6 47 | EcPrivateJwk _ key7Id (Just Enc) _ _ = kss !! 7 48 | RsaPrivateJwk _ _ Nothing a8 = kss !! 8 49 | Ed25519PrivateJwk _ _ key9Id = kss !! 9 50 | Ed25519PublicJwk _ key10Id = kss !! 10 51 | Success utcKeyId = fromJSON (String "2015-05-16T18:00:14.259Z") 52 | length kss @?= 14 53 | a0 @?= Nothing 54 | key0Id @?= Just (KeyId "a0") 55 | key1Id @?= Just (KeyId "a1") 56 | key2Id @?= Just (KeyId "a2") 57 | public_curve k @?= getCurveByName SEC_p256r1 58 | key3Id @?= Just (KeyId "a3") 59 | key4Id @?= Just (KeyId "HMAC key used in JWS A.1 example") 60 | key5Id @?= Just (KeyId "1") 61 | key6Id @?= Just (UTCKeyId utcKeyId) 62 | key7Id @?= Just (KeyId "1") 63 | key9Id @?= Just (KeyId "rfc8037SecretKey") 64 | key10Id @?= Just (KeyId "rfc8037PublicKey") 65 | key0Use @?= Just Enc 66 | key1Use @?= Just Sig 67 | key2Use @?= Just Sig 68 | key3Use @?= Just Enc 69 | a6 @?= Just (Signed RS256) 70 | a8 @?= Just (Signed RS256) 71 | isPublic k3 @?= True 72 | isPublic k4 @?= False 73 | isPrivate k4 @?= False 74 | it "shameless Show and Eq coverage boosting" $ do 75 | s' @?= s'' 76 | assertBool "Different sets aren't equal" (s' /= JwkSet { keys = take 8 kss ++ [k0]}) 77 | assertBool "Show stuff" $ showCov s' && showCov k0 && showCov k3 && showCov Sig 78 | assertBool "Different keys should be unequal" (k0 /= k1) 79 | 80 | describe "Errors in JWK data" $ do 81 | #if MIN_VERSION_aeson(2,0,0) 82 | let Just (Array ks) = KM.lookup "keys" keySet 83 | #else 84 | let Just (Array ks) = H.lookup "keys" keySet 85 | #endif 86 | Object k0obj = V.head ks 87 | it "invalid Base64 returns an error" $ do 88 | #if MIN_VERSION_aeson(2,0,0) 89 | let result = fromJSON (Object $ KM.insert "n" (String "NotBase64**") k0obj) :: Result Jwk 90 | #else 91 | let result = fromJSON (Object $ H.insert "n" (String "NotBase64**") k0obj) :: Result Jwk 92 | #endif 93 | case result of 94 | Error _ -> assertBool "" True 95 | _ -> assertFailure "Expected an error for invalid base 64" 96 | 97 | describe "JWK Algorithm matching" $ do 98 | let jwks = keys s 99 | it "finds one key for RS256 encoding" $ do 100 | -- Only the RSA Private key 101 | let jwks' = filter (canEncodeJws RS256) jwks 102 | length jwks' @?= 1 103 | 104 | it "finds 3 keys for RS256 decoding with no kid" $ do 105 | -- All RSA keys are valid except for the "enc" one 106 | let jwks' = filter (canDecodeJws (defJwsHdr {jwsAlg = RS256})) jwks 107 | length jwks' @?= 3 108 | 109 | it "finds one key for RS256 decoding with kid specified" $ do 110 | let jwks' = filter (canDecodeJws (defJwsHdr {jwsAlg = RS256, jwsKid = Just (KeyId "a1")})) jwks 111 | length jwks' @?= 1 112 | 113 | it "finds an RS1_5 key for encoding" $ do 114 | -- Only key a0 matches. The other 3 RSA keys are signing keys 115 | let jwks' = filter (canEncodeJwe RSA1_5) jwks 116 | length jwks' @?= 1 117 | 118 | describe "RSA Key generation" $ do 119 | let rng = drgNewTest (w, w, w, w, w) where w = 1 :: Word64 120 | kid = KeyId "mykey" 121 | ((kPub, kPr), _) = withDRG rng (generateRsaKeyPair 512 kid Sig Nothing) 122 | it "keys generated with same RNG are equal" $ do 123 | let ((kPub', kPr'), _) = withDRG rng (generateRsaKeyPair 512 kid Sig Nothing) 124 | kPub' @?= kPub 125 | kPr' @?= kPr 126 | it "isPublic and isPrivate are correct for RSA keys" $ do 127 | isPublic kPub @?= True 128 | isPublic kPr @?= False 129 | isPrivate kPr @?= True 130 | it "keys have supplied ID" $ do 131 | jwkId kPr @?= Just kid 132 | jwkId kPub @?= Just kid 133 | it "keys have supplied use" $ do 134 | jwkUse kPr @?= Just Sig 135 | jwkUse kPub @?= Just Sig 136 | where 137 | showCov x = showList [x] `seq` showsPrec 1 x `seq` show x `seq` True 138 | -------------------------------------------------------------------------------- /tests/Tests/JwsSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-incomplete-uni-patterns #-} 3 | 4 | module Tests.JwsSpec where 5 | 6 | import Test.Hspec 7 | import Test.HUnit hiding (Test) 8 | 9 | import Data.Aeson (decodeStrict') 10 | import qualified Data.ByteString as B 11 | import qualified Data.ByteString.Char8 () 12 | import Data.Word (Word64) 13 | import Crypto.Hash.Algorithms (SHA256(..)) 14 | import Crypto.MAC.HMAC (HMAC, hmac) 15 | import qualified Crypto.PubKey.Ed25519 as Ed25519 16 | import qualified Crypto.PubKey.Ed448 as Ed448 17 | import qualified Crypto.PubKey.RSA as RSA 18 | import qualified Crypto.PubKey.RSA.PKCS15 as RSAPKCS15 19 | import Crypto.Random (withDRG, drgNewTest) 20 | 21 | import Jose.Jwt as Jwt 22 | import Jose.Jwk (Jwk(..)) 23 | import Jose.Jwa 24 | import qualified Jose.Internal.Base64 as B64 25 | import qualified Jose.Jws as Jws 26 | 27 | 28 | testRNG = drgNewTest (w, w, w, w, w) where w = 1 :: Word64 29 | 30 | fstWithRNG = fst . withDRG testRNG 31 | 32 | {-- Examples from the JWS appendix A --} 33 | 34 | spec :: Spec 35 | spec = do 36 | describe "JWS encoding and decoding" $ do 37 | context "when using JWS Appendix A.1 data" $ do 38 | let a11decoded = Right (defJwsHdr {jwsAlg = HS256, jwsTyp = Just "JWT"}, a11Payload) 39 | it "decodes the JWT to the expected header and payload" $ 40 | Jws.hmacDecode hmacKey a11 @?= a11decoded 41 | 42 | it "encodes the payload to the expected JWT" $ 43 | signWithHeader a11mac a11Header a11Payload @?= a11 44 | 45 | it "decodes the payload using the JWK" $ do 46 | let Just k11 = decodeStrict' a11jwk 47 | fstWithRNG (Jwt.decode [k11] Nothing a11) @?= fmap Jws a11decoded 48 | 49 | it "encodes/decodes using HS512" $ 50 | hmacRoundTrip HS512 a11Payload 51 | 52 | it "encodes/decodes using HS384" $ 53 | hmacRoundTrip HS384 a11Payload 54 | 55 | context "when using JWS Appendix A.2 data" $ do 56 | it "decodes the JWT to the expected header and payload" $ 57 | Jws.rsaDecode rsaPublicKey a21 @?= Right (defJwsHdr {jwsAlg = RS256}, a21Payload) 58 | 59 | it "decodes the JWT to the expected header and payload with the JWK" $ do 60 | let Just k21 = decodeStrict' a21jwk 61 | fstWithRNG (Jwt.decode [k21] (Just (JwsEncoding RS256)) a21) @?= (Right $ Jws (defJwsHdr {jwsAlg = RS256}, a21Payload)) 62 | 63 | it "decodes the successfully without verification" $ do 64 | let Right (_, claims) = decodeClaims a21 :: Either JwtError (JwtHeader, JwtClaims) 65 | jwtIss claims @?= Just "joe" 66 | 67 | it "encodes the payload to the expected JWT" $ do 68 | let sign = either (error "Sign failed") id . RSAPKCS15.sign Nothing (Just SHA256) rsaPrivateKey 69 | signWithHeader sign a21Header a21Payload @?= a21 70 | 71 | it "encodes/decodes using RS256" $ 72 | rsaRoundTrip RS256 a21Payload 73 | 74 | it "encodes/decodes using RS384" $ 75 | rsaRoundTrip RS384 a21Payload 76 | 77 | it "encodes/decodes using RS512" $ 78 | rsaRoundTrip RS512 a21Payload 79 | 80 | context "when using JWS Appendix A.3 data" $ do 81 | let a31decoded = Right (defJwsHdr {jwsAlg = ES256}, a31Payload) 82 | it "decodes the JWT to the expected header and payload" $ do 83 | let Just k31 = decodeStrict' a31jwk 84 | fstWithRNG (Jwt.decode [k31] Nothing a31) @?= fmap Jws a31decoded 85 | 86 | context "when using an unsecured JWT" $ do 87 | it "returns an error if chosen alg is unset" $ 88 | fstWithRNG (Jwt.decode [] Nothing jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") 89 | it "returns an error if chosen alg is not 'none'" $ 90 | fstWithRNG (Jwt.decode [] (Just (JwsEncoding RS256)) jwt61) @?= Left (BadAlgorithm "JWT is unsecured but expected 'alg' was not 'none'") 91 | it "decodes the JWT to the expected header and payload if chosen alg is 'none'" $ 92 | fstWithRNG (Jwt.decode [] (Just (JwsEncoding None)) jwt61) @?= Right (Unsecured jwt61Payload) 93 | 94 | describe "Ed25519 signing and verification" $ do 95 | context "When using RFC8037 Appendix A data" $ do 96 | let ed25519JwtDecoded = Right (defJwsHdr { jwsAlg = EdDSA }, ed25519Payload) 97 | Just pubKey = decodeStrict' ed25519PubJwk 98 | Just (secKey@(Ed25519PrivateJwk kPr kPub _)) = decodeStrict' ed25519SecJwk 99 | sign = Ed25519.sign kPr kPub 100 | it "decodes the JWT to the expected header and payload" $ do 101 | fstWithRNG (Jwt.decode [pubKey] Nothing ed25519Jwt) @?= fmap Jws ed25519JwtDecoded 102 | fstWithRNG (Jwt.decode [secKey] Nothing ed25519Jwt) @?= fmap Jws ed25519JwtDecoded 103 | 104 | it "encodes the payload to the exected JWT" $ do 105 | -- Don't really need signWithHeader here, since our function gives the correct value 106 | signWithHeader sign ed25519Hdr ed25519Payload @?= ed25519Jwt 107 | Jws.ed25519Encode kPr kPub ed25519Payload @?= Jwt ed25519Jwt 108 | 109 | it "roundtrip encode/decode" $ do 110 | let Right (Jwt encoded) = fstWithRNG (Jwt.encode [pubKey, secKey] (JwsEncoding EdDSA) (Claims "hello there")) 111 | fstWithRNG (Jwt.decode [pubKey] (Just (JwsEncoding EdDSA)) encoded) @?= Right (Jws (defJwsHdr { jwsAlg = EdDSA }, "hello there")) 112 | 113 | it "encoding rejects invalid alg for Ed25519 key" $ do 114 | fstWithRNG (Jws.jwkEncode RS256 secKey (Claims "hello")) @?= Left (KeyError "Algorithm cannot be used with an Ed25519 key") 115 | fstWithRNG (Jwt.encode [pubKey, secKey] (JwsEncoding RS256) (Claims "hello")) @?= Left (KeyError "No matching key found for JWS algorithm") 116 | 117 | it "verification fails with invalid alg in header" $ do 118 | let badJwt = signWithHeader sign a21Header ed25519Payload 119 | fstWithRNG (Jwt.decode [pubKey] Nothing badJwt) @?= Left (KeyError "No suitable key was found to decode the JWT") 120 | 121 | describe "Ed448 signing and verification" $ do 122 | let Just pubKey = decodeStrict' ed448PubJwk 123 | Just (secKey@(Ed448PrivateJwk kPr kPub _)) = decodeStrict' ed448SecJwk 124 | sign = Ed448.sign kPr kPub 125 | 126 | context "" $ do 127 | it "JWT is encoded to the expected value" $ 128 | signWithHeader sign ed448Hdr "{}" @?= ed448Jwt 129 | 130 | it "roundtrip encode/decode" $ do 131 | let Right (Jwt encoded) = fstWithRNG (Jwt.encode [pubKey, secKey] (JwsEncoding EdDSA) (Claims "hello")) 132 | fstWithRNG (Jwt.decode [pubKey] (Just (JwsEncoding EdDSA)) encoded) @?= Right (Jws (defJwsHdr { jwsAlg = EdDSA }, "hello")) 133 | Jws.ed448Decode kPub (unJwt (Jws.ed448Encode kPr kPub "hello")) @?= Right (defJwsHdr { jwsAlg = EdDSA }, "hello") 134 | 135 | 136 | signWithHeader sign hdr payload = B.intercalate "." [hdrPayload, B64.encode $ sign hdrPayload] 137 | where 138 | hdrPayload = B.intercalate "." $ map B64.encode [hdr, payload] 139 | 140 | hmacRoundTrip a msg = let Right (Jwt encoded) = Jws.hmacEncode a "asecretkey" msg 141 | in Jws.hmacDecode "asecretkey" encoded @?= Right (defJwsHdr {jwsAlg = a}, msg) 142 | 143 | rsaRoundTrip a msg = let Right (Jwt encoded) = fstWithRNG (Jws.rsaEncode a rsaPrivateKey msg) 144 | in Jws.rsaDecode rsaPublicKey encoded @?= Right (defJwsHdr {jwsAlg = a}, msg) 145 | 146 | -- Ed25519 Data from https://tools.ietf.org/html/rfc8037#appendix-A 147 | 148 | ed25519SecJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed25519\", \"d\":\"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A\", \"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}" :: B.ByteString 149 | ed25519PubJwk = "{\"kty\":\"OKP\",\"crv\":\"Ed25519\", \"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}" 150 | ed25519Hdr = "{\"alg\":\"EdDSA\"}" :: B.ByteString 151 | ed25519Payload = "Example of Ed25519 signing" 152 | ed25519Jwt = "eyJhbGciOiJFZERTQSJ9.RXhhbXBsZSBvZiBFZDI1NTE5IHNpZ25pbmc.hgyY0il_MGCjP0JzlnLWG1PPOt7-09PGcvMg3AIbQR6dWbhijcNR4ki4iylGjg5BhVsPt9g7sVvpAr_MuM0KAg" 153 | 154 | -- Ed448 Data signed with ruby for comparison 155 | 156 | ed448SecJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed448\", \"d\":\"-ox5cBHY-QLR0hRdE2gd97LkQ8oRZCT89ALXm-FqhINLdVEd_PtfHuetZoKeHALqwu-NfuADYDBL\", \"x\": \"BnJNZy1_JXpGRlrNLYsz_9I5NCM-Py39P1kEOyrLRXJj38rnOJe7cJaVsOnPj2NkL_jVtG_qkjOA\" }" 157 | ed448PubJwk = "{\"kty\":\"OKP\", \"crv\":\"Ed448\", \"x\": \"BnJNZy1_JXpGRlrNLYsz_9I5NCM-Py39P1kEOyrLRXJj38rnOJe7cJaVsOnPj2NkL_jVtG_qkjOA\" }" 158 | ed448Hdr = "{\"alg\":\"Ed448\"}" :: B.ByteString 159 | ed448Jwt = "eyJhbGciOiJFZDQ0OCJ9.e30.UlqTx962FvZP1G5pZOrScRXlAB0DJI5dtZkknNTm1E70AapkONi8vzpvKd355czflQdc7uyOzTeAz0-eLvffCKgWm_zebLly7L3DLBliynQk14qgJgz0si-60mBFYOIxRghk95kk5hCsFpxpVE45jRIA" :: B.ByteString 160 | 161 | 162 | -- Unsecured JWT from section 6.1 163 | jwt61 = "eyJhbGciOiJub25lIn0.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ." 164 | jwt61Payload = a11Payload 165 | 166 | a11Header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" :: B.ByteString 167 | a11Payload = "{\"iss\":\"joe\",\r\n \"exp\":1300819380,\r\n \"http://example.com/is_root\":true}" 168 | a11 = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk" 169 | a11jwk = "{\"kty\":\"oct\", \"k\":\"AyM1SysPpbyDfgZld3umj1qzKObwVMkoqQ-EstJQLr_T-1qS0gZH75aKtMN3Yj0iPS4hcgUuTwjAzZr1Z9CAow\" }" 170 | 171 | 172 | a21Header = "{\"alg\":\"RS256\"}" :: B.ByteString 173 | a21Payload = a11Payload 174 | a21 = "eyJhbGciOiJSUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.cC4hiUPoj9Eetdgtv3hF80EGrhuB__dzERat0XF9g2VtQgr9PJbu3XOiZj5RZmh7AAuHIm4Bh-0Qc_lF5YKt_O8W2Fp5jujGbds9uJdbF9CUAr7t1dnZcAcQjbKBYNX4BAynRFdiuB--f_nZLgrnbyTyWzO75vRK5h6xBArLIARNPvkSjtQBMHlb1L07Qe7K0GarZRmB_eSN9383LcOLn6_dO--xi12jzDwusC-eOkHWEsqtFZESc6BfI7noOPqvhJ1phCnvWh6IeYI2w9QOYEUipUTI8np6LbgGY9Fs98rqVt5AXLIhWkWywlVmtVrBp0igcN_IoypGlUPQGe77Rw" 175 | 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\"}" 176 | 177 | a31Header = "{\"alg\":\"ES256\"}" :: B.ByteString 178 | a31Payload = a11Payload 179 | a31 = "eyJhbGciOiJFUzI1NiJ9.eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ.DtEhU3ljbEg8L38VWAfUAqOyKAM6-Xx-F4GawxaepmXFCgfTjDxw5djxLa8ISlSApmWQxfKTUJqPP3-Kg6NU1Q" 180 | a31jwk = "{\"kty\":\"EC\", \"crv\":\"P-256\", \"x\":\"f83OJ3D2xF1Bg8vub9tLe1gHMzV76e8Tus9uPHvRVEU\", \"y\":\"x_FEzRu9m36HLN_tue659LNpXW6pCyStikYjKIWI5a0\", \"d\":\"jpsQnnGQmL-YBIffH1136cspYG6-0iY7X1fCE9-E9LI\" }" 181 | 182 | 183 | hmacKey = B.pack [ 184 | 3, 35, 53, 75, 43, 15, 165, 188, 131, 126, 6, 101, 119, 123, 166, 185 | 143, 90, 179, 40, 230, 240, 84, 201, 40, 169, 15, 132, 178, 210, 80, 186 | 46, 191, 211, 251, 90, 146, 210, 6, 71, 239, 150, 138, 180, 195, 119, 187 | 98, 61, 34, 61, 46, 33, 114, 5, 46, 79, 8, 192, 205, 154, 245, 103, 188 | 208, 128, 163] 189 | 190 | -- N 191 | rsaModulus :: Integer 192 | rsaModulus = 20446702916744654562596343388758805860065209639960173505037453331270270518732245089773723012043203236097095623402044690115755377345254696448759605707788965848889501746836211206270643833663949992536246985362693736387185145424787922241585721992924045675229348655595626434390043002821512765630397723028023792577935108185822753692574221566930937805031155820097146819964920270008811327036286786392793593121762425048860211859763441770446703722015857250621107855398693133264081150697423188751482418465308470313958250757758547155699749157985955379381294962058862159085915015369381046959790476428631998204940879604226680285601 193 | 194 | 195 | rsaExponent = 65537 :: Integer 196 | 197 | -- D 198 | rsaPrivateExponent :: Integer 199 | rsaPrivateExponent = 2358310989939619510179986262349936882924652023566213765118606431955566700506538911356936879137503597382515919515633242482643314423192704128296593672966061810149316320617894021822784026407461403384065351821972350784300967610143459484324068427674639688405917977442472804943075439192026107319532117557545079086537982987982522396626690057355718157403493216553255260857777965627529169195827622139772389760130571754834678679842181142252489617665030109445573978012707793010592737640499220015083392425914877847840457278246402760955883376999951199827706285383471150643561410605789710883438795588594095047409018233862167884701 200 | 201 | rsaPrivateKey = RSA.PrivateKey 202 | { RSA.private_pub = rsaPublicKey 203 | , RSA.private_d = rsaPrivateExponent 204 | , RSA.private_q = 0 205 | , RSA.private_p = 0 206 | , RSA.private_dP = 0 207 | , RSA.private_dQ = 0 208 | , RSA.private_qinv = 0 209 | } 210 | 211 | rsaPublicKey = RSA.PublicKey 212 | { RSA.public_size = 256 213 | , RSA.public_n = rsaModulus 214 | , RSA.public_e = rsaExponent 215 | } 216 | 217 | a11mac :: B.ByteString -> HMAC SHA256 218 | a11mac = hmac hmacKey 219 | -------------------------------------------------------------------------------- /tests/jwks.json: -------------------------------------------------------------------------------- 1 | { "keys" : 2 | [ {"use": "enc", "n": "vnifEgZCnBxY5UDt3TJXp3_mNv92VWwHoc3B2oCuzgpgNyBwbBVIu3ScaflvQlntSgfo9VHiu16IqPuCOL4FjcY2RUZY7zizUZ2hFmmMThyx4HfTcDMNFOnetB1mKVUQ3gBOFjdnnj9auO4EK22xRcdB704XhES1TtYIiCxxfPOYBysCDHYcR-0KKjUPyXyhBGFoxiUrYP-c14Pf-aKWgNDqVlYlqayw9JHN4QVeJm8M5DHiPOtxO096Mc-5-X5NwXFMTzjywFWzkbFy7XmJj6BDmmh8-WUOBK1a9gy4zTysL9HfNhJIqi3BJUtLM_x2t-ISROm-Ud3y-4xgavXBTw", "e": "AQAB", "kty": "RSA", "kid": "a0"} 3 | , {"use": "sig", "n": "o9kJbxD1SgwrV_ottw7oHxxkjw83AuRrYbq8PzXDfhmvqvRHjhAOEGk1qDUbI8tkWzXsTuy-0UAvI9Xt3Qqmmk1MSkAx6K355_J1ofTafH5VrtPavC7HMVnz1zDebgwJH869jWHFghzL0Nr32zq4_V-gpt-zugKFpQi_LA9dtuAjcSTCMnDzTMw4WrMbzNOm90q0CkJCrWe6xM9z4Q_GCPgb2S4lsd5iNdtus9pG104wFAkgY7BXNP3hatYa1UVkAQdWMYyQATs6HMBZF4Ljf-upU9ic_vGwTGgunvQ7z29yrAFWaZQ-EqjYUnvQlmPFqMaNxg3TkPIgntqvZOdW_w", "e": "AQAB", "kty": "RSA", "kid": "a1"} 4 | , {"use": "sig", "crv": "P-256", "kty": "EC", "y": "kgFS_XvVOyuS41mBzmwJa-ik8Cy4rvM3uFncxmi_-Y8", "x": "bjX_T6O5OUW6WALJ173CH34TfzK9zEHycFT6KMWDnow", "kid": "a2"} 5 | , {"use": "enc", "crv": "P-256", "kty": "EC", "y": "zcOqE_LYsPTf7a9FOFpJiwK2ZQuUmoNLdsY7BRTICN0", "x": "6eXHDpNoiUaAR5Cle6rfmrVgksSagyi8fzvLF1kedKc", "kid": "a3"} 6 | , {"kty": "oct", "k":"AyM1SysPpbyDfgZld3umj1qzKObwVMkoqQ-EstJQLr_T-1qS0gZH75aKtMN3Yj0iPS4hcgUuTwjAzZr1Z9CAow", "kid":"HMAC key used in JWS A.1 example"} 7 | , {"kty":"EC", "crv":"P-256", "x":"MKBCTNIcKUSDii11ySs3526iDZ8AiTo7Tu6KPAqv7D4", "y":"4Etl6SRW2YiLUrN5vfvVHuhp7x8PxltmWWlbbM4IFyM", "use":"enc", "kid":"1"} 8 | , {"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"} 9 | , {"kty":"EC", "crv":"P-256", "x":"MKBCTNIcKUSDii11ySs3526iDZ8AiTo7Tu6KPAqv7D4", "y":"4Etl6SRW2YiLUrN5vfvVHuhp7x8PxltmWWlbbM4IFyM", "d":"870MB6gfuTJ4HtUnUvYMyJpr5eUZNP4Bk43bVdj3eAE", "use":"enc", "kid":"1"} 10 | , {"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"} 11 | , {"kty":"OKP","crv":"Ed25519", "d":"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A", "x":"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo", "kid": "rfc8037SecretKey"} 12 | , {"kty":"OKP","crv":"Ed25519", "x":"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo", "kid": "rfc8037PublicKey"} 13 | , {"kty": "oct", "alg": "A128KW", "k":"GawgguFyGrWKav7AX4VKUg"} 14 | , {"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" } 15 | , {"kty": "hypothetical-new-kty", "alg": "A256KW", "k":"GawgguFyGrWKav7AX4VKUg"} 16 | ] 17 | } 18 | -------------------------------------------------------------------------------- /tests/tests.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Test.Hspec (hspec) 4 | 5 | import Tests.JwsSpec 6 | import Tests.JweSpec 7 | import Tests.JwkSpec 8 | 9 | main :: IO () 10 | main = hspec $ do 11 | Tests.JwsSpec.spec 12 | Tests.JweSpec.spec 13 | Tests.JwkSpec.spec 14 | --------------------------------------------------------------------------------