{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK prune #-}

-- | Internal functions for encrypting and signing / decrypting
-- and verifying JWT content.

module Jose.Internal.Crypto
    ( hmacSign
    , hmacVerify
    , ed25519Verify
    , ed448Verify
    , rsaSign
    , rsaVerify
    , rsaEncrypt
    , rsaDecrypt
    , ecVerify
    , encryptPayload
    , decryptPayload
    , generateCmkAndIV
    , keyWrap
    , keyUnwrap
    , pad
    , unpad
    )
where


import           Control.Monad (when, unless)
import           Crypto.Error
import           Crypto.Cipher.AES
import           Crypto.Cipher.Types hiding (IV)
import           Crypto.Hash.Algorithms
import           Crypto.Number.Serialize (os2ip)
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15
import qualified Crypto.PubKey.RSA.OAEP as OAEP
import           Crypto.Random (MonadRandom, getRandomBytes)
import           Crypto.MAC.HMAC (HMAC (..), hmac)
import           Data.Bits (xor)
import           Data.Bifunctor (first)
import           Data.ByteArray (ByteArray, ScrubbedBytes)
import qualified Data.ByteArray as BA
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.Serialize as Serialize
import qualified Data.Text as T
import           Data.Word (Word64, Word8)

import           Jose.Jwa
import           Jose.Types (JwtError(..))
import           Jose.Internal.Parser (IV(..), Tag(..))

rightToMaybe :: Either a b -> Maybe b
rightToMaybe :: forall a b. Either a b -> Maybe b
rightToMaybe (Right b
x) = forall a. a -> Maybe a
Just b
x
rightToMaybe Left{}    = forall a. Maybe a
Nothing

-- | Sign a message with an HMAC key.
hmacSign :: JwsAlg      -- ^ HMAC algorithm to use
         -> ByteString  -- ^ Key
         -> ByteString  -- ^ The message/content
         -> Either JwtError ByteString -- ^ HMAC output
hmacSign :: JwsAlg -> ByteString -> ByteString -> Either JwtError ByteString
hmacSign JwsAlg
a ByteString
k ByteString
m = case JwsAlg
a of
    JwsAlg
HS256 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
k ByteString
m :: HMAC SHA256)
    JwsAlg
HS384 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
k ByteString
m :: HMAC SHA384)
    JwsAlg
HS512 -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
k ByteString
m :: HMAC SHA512)
    JwsAlg
_     -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> JwtError
BadAlgorithm forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"Not an HMAC algorithm: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show JwsAlg
a

-- | Verify the HMAC for a given message.
-- Returns false if the MAC is incorrect or the 'Alg' is not an HMAC.
hmacVerify :: JwsAlg      -- ^ HMAC Algorithm to use
           -> ByteString  -- ^ Key
           -> ByteString  -- ^ The message/content
           -> ByteString  -- ^ The signature to check
           -> Bool        -- ^ Whether the signature is correct
hmacVerify :: JwsAlg -> ByteString -> ByteString -> ByteString -> Bool
hmacVerify JwsAlg
a ByteString
key ByteString
msg ByteString
sig = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`BA.constEq` ByteString
sig) forall a b. (a -> b) -> a -> b
$ JwsAlg -> ByteString -> ByteString -> Either JwtError ByteString
hmacSign JwsAlg
a ByteString
key ByteString
msg


-- | Verify an Ed25519 signed message
ed25519Verify :: JwsAlg
              -> Ed25519.PublicKey
              -> ByteString
              -- ^ The message/content
              -> ByteString
              -- ^ The signature to check
              -> Bool
              -- ^ Whether the signature is correct
ed25519Verify :: JwsAlg -> PublicKey -> ByteString -> ByteString -> Bool
ed25519Verify JwsAlg
EdDSA PublicKey
pubKey ByteString
msg ByteString
sig =
    case forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
sig of
       CryptoPassed Signature
sig_ ->
         forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
pubKey ByteString
msg Signature
sig_
       CryptoFailable Signature
_ -> Bool
False
ed25519Verify JwsAlg
_ PublicKey
_ ByteString
_ ByteString
_ = Bool
False


-- | Verify an Ed448 signed message
ed448Verify :: JwsAlg
            -> Ed448.PublicKey
            -> ByteString
            -- ^ The message/content
            -> ByteString
            -- ^ The signature to check
            -> Bool
            -- ^ Whether the signature is correct
ed448Verify :: JwsAlg -> PublicKey -> ByteString -> ByteString -> Bool
ed448Verify JwsAlg
EdDSA PublicKey
pubKey ByteString
msg ByteString
sig =
    case forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature ByteString
sig of
       CryptoPassed Signature
sig_ ->
         forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed448.verify PublicKey
pubKey ByteString
msg Signature
sig_
       CryptoFailable Signature
_ -> Bool
False
ed448Verify JwsAlg
_ PublicKey
_ ByteString
_ ByteString
_ = Bool
False


-- | Sign a message using an RSA private key.
--
-- The failure condition should only occur if the algorithm is not an RSA
-- algorithm, or the RSA key is too small, causing the padding of the
-- signature to fail. With real-world RSA keys this shouldn't happen in practice.
rsaSign :: Maybe RSA.Blinder  -- ^ RSA blinder
        -> JwsAlg             -- ^ Algorithm to use. Must be one of @RSA256@, @RSA384@ or @RSA512@
        -> RSA.PrivateKey     -- ^ Private key to sign with
        -> ByteString         -- ^ Message to sign
        -> Either JwtError ByteString    -- ^ The signature
rsaSign :: Maybe Blinder
-> JwsAlg -> PrivateKey -> ByteString -> Either JwtError ByteString
rsaSign Maybe Blinder
blinder JwsAlg
a PrivateKey
key ByteString
msg = case JwsAlg
a of
    JwsAlg
RS256 -> forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
hashAlg -> Either JwtError ByteString
go SHA256
SHA256
    JwsAlg
RS384 -> forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
hashAlg -> Either JwtError ByteString
go SHA384
SHA384
    JwsAlg
RS512 -> forall {hashAlg}.
HashAlgorithmASN1 hashAlg =>
hashAlg -> Either JwtError ByteString
go SHA512
SHA512
    JwsAlg
_     -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> JwtError
BadAlgorithm forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"Not an RSA algorithm: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show JwsAlg
a
  where
    go :: hashAlg -> Either JwtError ByteString
go hashAlg
h = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left JwtError
BadCrypto) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
PKCS15.sign Maybe Blinder
blinder (forall a. a -> Maybe a
Just hashAlg
h) PrivateKey
key ByteString
msg

-- | Verify the signature for a message using an RSA public key.
--
-- Returns false if the check fails or if the 'Alg' value is not
-- an RSA signature algorithm.
rsaVerify :: JwsAlg        -- ^ The signature algorithm. Used to obtain the hash function.
          -> RSA.PublicKey -- ^ The key to check the signature with
          -> ByteString    -- ^ The message/content
          -> ByteString    -- ^ The signature to check
          -> Bool          -- ^ Whether the signature is correct
rsaVerify :: JwsAlg -> PublicKey -> ByteString -> ByteString -> Bool
rsaVerify JwsAlg
a PublicKey
key ByteString
msg ByteString
sig = case JwsAlg
a of
    JwsAlg
RS256 -> forall {hashAlg}. HashAlgorithmASN1 hashAlg => hashAlg -> Bool
go SHA256
SHA256
    JwsAlg
RS384 -> forall {hashAlg}. HashAlgorithmASN1 hashAlg => hashAlg -> Bool
go SHA384
SHA384
    JwsAlg
RS512 -> forall {hashAlg}. HashAlgorithmASN1 hashAlg => hashAlg -> Bool
go SHA512
SHA512
    JwsAlg
_     -> Bool
False
  where
    go :: hashAlg -> Bool
go hashAlg
h = forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
PKCS15.verify (forall a. a -> Maybe a
Just hashAlg
h) PublicKey
key ByteString
msg ByteString
sig

-- | Verify the signature for a message using an EC public key.
--
-- Returns false if the check fails or if the 'Alg' value is not
-- an EC signature algorithm.
ecVerify :: JwsAlg          -- ^ The signature algorithm. Used to obtain the hash function.
         -> ECDSA.PublicKey -- ^ The key to check the signature with
         -> ByteString      -- ^ The message/content
         -> ByteString      -- ^ The signature to check
         -> Bool            -- ^ Whether the signature is correct
ecVerify :: JwsAlg -> PublicKey -> ByteString -> ByteString -> Bool
ecVerify JwsAlg
a PublicKey
key ByteString
msg ByteString
sig = case JwsAlg
a of
    JwsAlg
ES256 -> forall {hash}. HashAlgorithm hash => hash -> Bool
go SHA256
SHA256
    JwsAlg
ES384 -> forall {hash}. HashAlgorithm hash => hash -> Bool
go SHA384
SHA384
    JwsAlg
ES512 -> forall {hash}. HashAlgorithm hash => hash -> Bool
go SHA512
SHA512
    JwsAlg
_     -> Bool
False
  where
    (ByteString
r, ByteString
s) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
sig forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
sig
    ecSig :: Signature
ecSig  = Integer -> Integer -> Signature
ECDSA.Signature (forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
r) (forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
s)
    go :: hash -> Bool
go hash
h   = forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify hash
h PublicKey
key Signature
ecSig ByteString
msg

-- | Generates the symmetric key (content management key) and IV
--
-- Used to encrypt a message.
generateCmkAndIV :: MonadRandom m
    => Enc
    -- ^ The encryption algorithm to be used
    -> m (ScrubbedBytes, ScrubbedBytes)
    -- ^ The key, IV
generateCmkAndIV :: forall (m :: * -> *).
MonadRandom m =>
Enc -> m (ScrubbedBytes, ScrubbedBytes)
generateCmkAndIV Enc
e = do
    ScrubbedBytes
cmk <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (forall {a}. Num a => Enc -> a
keySize Enc
e)
    ScrubbedBytes
iv  <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (forall {a}. Num a => Enc -> a
ivSize Enc
e)   -- iv for aes gcm or cbc
    forall (m :: * -> *) a. Monad m => a -> m a
return (ScrubbedBytes
cmk, ScrubbedBytes
iv)
  where
    keySize :: Enc -> a
keySize Enc
A128GCM = a
16
    keySize Enc
A192GCM = a
24
    keySize Enc
A256GCM = a
32
    keySize Enc
A128CBC_HS256 = a
32
    keySize Enc
A192CBC_HS384 = a
48
    keySize Enc
A256CBC_HS512 = a
64

    ivSize :: Enc -> a
ivSize Enc
A128GCM = a
12
    ivSize Enc
A192GCM = a
12
    ivSize Enc
A256GCM = a
12
    ivSize Enc
_       = a
16

-- | Encrypts a message (typically a symmetric key) using RSA.
rsaEncrypt :: (MonadRandom m, ByteArray msg, ByteArray out)
    => RSA.PublicKey
    -- ^ The encryption key
    -> JweAlg
    -- ^ The algorithm (@RSA1_5@, @RSA_OAEP@, or @RSA_OAEP_256@)
    -> msg
    -- ^ The message to encrypt
    -> m (Either JwtError out)
    -- ^ The encrypted message
rsaEncrypt :: forall (m :: * -> *) msg out.
(MonadRandom m, ByteArray msg, ByteArray out) =>
PublicKey -> JweAlg -> msg -> m (Either JwtError out)
rsaEncrypt PublicKey
k JweAlg
a msg
msg = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case JweAlg
a of
    JweAlg
RSA1_5       -> forall {a} {c}. m (Either a c) -> m (Either JwtError c)
mapErr (forall (m :: * -> *).
MonadRandom m =>
PublicKey -> ByteString -> m (Either Error ByteString)
PKCS15.encrypt PublicKey
k ByteString
bs)
    JweAlg
RSA_OAEP     -> forall {a} {c}. m (Either a c) -> m (Either JwtError c)
mapErr (forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt (forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
OAEP.defaultOAEPParams SHA1
SHA1) PublicKey
k ByteString
bs)
    JweAlg
RSA_OAEP_256 -> forall {a} {c}. m (Either a c) -> m (Either JwtError c)
mapErr (forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt (forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
OAEP.defaultOAEPParams SHA256
SHA256) PublicKey
k ByteString
bs)
    JweAlg
_            -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (Text -> JwtError
BadAlgorithm Text
"Not an RSA algorithm"))
  where
    bs :: ByteString
bs = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert msg
msg
    mapErr :: m (Either a c) -> m (Either JwtError c)
mapErr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const JwtError
BadCrypto))

-- | Decrypts an RSA encrypted message.
rsaDecrypt :: ByteArray ct
    => Maybe RSA.Blinder
    -> RSA.PrivateKey
    -- ^ The decryption key
    -> JweAlg
    -- ^ The RSA algorithm to use
    -> ct
    -- ^ The encrypted content
    -> Either JwtError ScrubbedBytes
    -- ^ The decrypted key
rsaDecrypt :: forall ct.
ByteArray ct =>
Maybe Blinder
-> PrivateKey -> JweAlg -> ct -> Either JwtError ScrubbedBytes
rsaDecrypt Maybe Blinder
blinder PrivateKey
rsaKey JweAlg
a ct
ct = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case JweAlg
a of
    JweAlg
RSA1_5       -> forall {a} {c}. Either a c -> Either JwtError c
mapErr (Maybe Blinder
-> PrivateKey -> ByteString -> Either Error ByteString
PKCS15.decrypt Maybe Blinder
blinder PrivateKey
rsaKey ByteString
bs)
    JweAlg
RSA_OAEP     -> forall {a} {c}. Either a c -> Either JwtError c
mapErr (forall hash.
HashAlgorithm hash =>
Maybe Blinder
-> OAEPParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
OAEP.decrypt Maybe Blinder
blinder (forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
OAEP.defaultOAEPParams SHA1
SHA1) PrivateKey
rsaKey ByteString
bs)
    JweAlg
RSA_OAEP_256 -> forall {a} {c}. Either a c -> Either JwtError c
mapErr (forall hash.
HashAlgorithm hash =>
Maybe Blinder
-> OAEPParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
OAEP.decrypt Maybe Blinder
blinder (forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
OAEP.defaultOAEPParams SHA256
SHA256) PrivateKey
rsaKey ByteString
bs)
    JweAlg
_            -> forall a b. a -> Either a b
Left (Text -> JwtError
BadAlgorithm Text
"Not an RSA algorithm")
  where
    bs :: ByteString
bs = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ct
ct
    mapErr :: Either a c -> Either JwtError c
mapErr = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const JwtError
BadCrypto)

-- Dummy type to constrain Cipher type
data C c = C

initCipher :: BlockCipher c => C c -> ScrubbedBytes -> Either JwtError c
initCipher :: forall c.
BlockCipher c =>
C c -> ScrubbedBytes -> Either JwtError c
initCipher C c
_ ScrubbedBytes
k = forall a. CryptoFailable a -> Either JwtError a
mapFail (forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ScrubbedBytes
k)

-- Map CryptoFailable to JwtError
mapFail :: CryptoFailable a -> Either JwtError a
mapFail :: forall a. CryptoFailable a -> Either JwtError a
mapFail (CryptoPassed a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
mapFail (CryptoFailed CryptoError
e) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ case CryptoError
e of
    CryptoError
CryptoError_KeySizeInvalid -> Text -> JwtError
KeyError Text
"cipher key length is invalid"
    CryptoError
_ -> JwtError
BadCrypto


-- | Decrypt an AES encrypted message.
decryptPayload :: forall ba. (ByteArray ba)
    => Enc
    -- ^ Encryption algorithm
    -> ScrubbedBytes
    -- ^ Content encryption key
    -> IV
    -- ^ IV
    -> ba
    -- ^ Additional authentication data
    -> Tag
    -- ^ The integrity protection value to be checked
    -> ba
    -- ^ The encrypted JWT payload
    -> Maybe ba
decryptPayload :: forall ba.
ByteArray ba =>
Enc -> ScrubbedBytes -> IV -> ba -> Tag -> ba -> Maybe ba
decryptPayload Enc
enc ScrubbedBytes
cek IV
iv_ ba
aad Tag
tag_ ba
ct = case (Enc
enc, IV
iv_, Tag
tag_) of
    (Enc
A128GCM, IV12 ByteString
b, Tag16 ByteString
t) -> forall c.
BlockCipher c =>
C c -> ByteString -> ByteString -> Maybe ba
doGCM (forall c. C c
C :: C AES128) ByteString
b ByteString
t
    (Enc
A192GCM, IV12 ByteString
b, Tag16 ByteString
t) -> forall c.
BlockCipher c =>
C c -> ByteString -> ByteString -> Maybe ba
doGCM (forall c. C c
C :: C AES192) ByteString
b ByteString
t
    (Enc
A256GCM, IV12 ByteString
b, Tag16 ByteString
t) -> forall c.
BlockCipher c =>
C c -> ByteString -> ByteString -> Maybe ba
doGCM (forall c. C c
C :: C AES256) ByteString
b ByteString
t
    (Enc
A128CBC_HS256, IV16 ByteString
b, Tag16 ByteString
t) -> forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> ByteString -> ByteString -> a -> Int -> Maybe ba
doCBC (forall c. C c
C :: C AES128) ByteString
b ByteString
t SHA256
SHA256 Int
16
    (Enc
A192CBC_HS384, IV16 ByteString
b, Tag24 ByteString
t) -> forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> ByteString -> ByteString -> a -> Int -> Maybe ba
doCBC (forall c. C c
C :: C AES192) ByteString
b ByteString
t SHA384
SHA384 Int
24
    (Enc
A256CBC_HS512, IV16 ByteString
b, Tag32 ByteString
t) -> forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> ByteString -> ByteString -> a -> Int -> Maybe ba
doCBC (forall c. C c
C :: C AES256) ByteString
b ByteString
t SHA512
SHA512 Int
32
    (Enc, IV, Tag)
_ -> forall a. Maybe a
Nothing -- This shouldn't be possible if the JWT was parsed first
  where
    (ScrubbedBytes
cbcMacKey, ScrubbedBytes
cbcEncKey) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt (forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
cek forall a. Integral a => a -> a -> a
`div` Int
2) ScrubbedBytes
cek :: (ScrubbedBytes, ScrubbedBytes)
    al :: Word64
al = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
aad) forall a. Num a => a -> a -> a
* Word64
8 :: Word64

    doGCM :: BlockCipher c => C c -> ByteString -> ByteString -> Maybe ba
    doGCM :: forall c.
BlockCipher c =>
C c -> ByteString -> ByteString -> Maybe ba
doGCM C c
c ByteString
iv ByteString
tag = do
        c
cipher <- forall a b. Either a b -> Maybe b
rightToMaybe (forall c.
BlockCipher c =>
C c -> ScrubbedBytes -> Either JwtError c
initCipher C c
c ScrubbedBytes
cek)
        AEAD c
aead <- forall a. CryptoFailable a -> Maybe a
maybeCryptoError (forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
aeadInit AEADMode
AEAD_GCM c
cipher ByteString
iv)
        forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
aeadSimpleDecrypt AEAD c
aead ba
aad ba
ct (Bytes -> AuthTag
AuthTag forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
tag)

    doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> ByteString -> ByteString -> a -> Int -> Maybe ba
    doCBC :: forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> ByteString -> ByteString -> a -> Int -> Maybe ba
doCBC C c
c ByteString
iv ByteString
tag a
a Int
tagLen = do
        forall a.
HashAlgorithm a =>
a -> ByteString -> ByteString -> Int -> Maybe ()
checkMac a
a ByteString
tag ByteString
iv Int
tagLen
        c
cipher <- forall a b. Either a b -> Maybe b
rightToMaybe (forall c.
BlockCipher c =>
C c -> ScrubbedBytes -> Either JwtError c
initCipher C c
c ScrubbedBytes
cbcEncKey)
        IV c
iv'    <- forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
iv
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
ct forall a. Integral a => a -> a -> a
`mod` forall cipher. BlockCipher cipher => cipher -> Int
blockSize c
cipher forall a. Eq a => a -> a -> Bool
== Int
0) forall a. Maybe a
Nothing
        forall ba. ByteArray ba => ba -> Maybe ba
unpad forall a b. (a -> b) -> a -> b
$ forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt c
cipher IV c
iv' ba
ct

    checkMac :: HashAlgorithm a => a -> ByteString -> ByteString -> Int -> Maybe ()
    checkMac :: forall a.
HashAlgorithm a =>
a -> ByteString -> ByteString -> Int -> Maybe ()
checkMac a
a ByteString
tag ByteString
iv Int
l = do
        let mac :: Bytes
mac = forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
l forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall a b. (a -> b) -> a -> b
$ forall a. HashAlgorithm a => a -> ByteString -> HMAC a
doMac a
a ByteString
iv :: BA.Bytes
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
tag forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`BA.constEq` Bytes
mac) forall a. Maybe a
Nothing

    doMac :: HashAlgorithm a => a -> ByteString -> HMAC a
    doMac :: forall a. HashAlgorithm a => a -> ByteString -> HMAC a
doMac a
_ ByteString
iv = forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ScrubbedBytes
cbcMacKey (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat [forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
aad, ByteString
iv, forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ct, forall a. Serialize a => a -> ByteString
Serialize.encode Word64
al] :: ByteString)

-- | Encrypt a message using AES.
encryptPayload :: forall ba iv. (ByteArray ba, ByteArray iv)
    => Enc
    -- ^ Encryption algorithm
    -> ScrubbedBytes
    -- ^ Content management key
    -> iv
    -- ^ IV
    -> ba
    -- ^ Additional authenticated data
    -> ba
    -- ^ The message/JWT claims
    -> Maybe (AuthTag, ba)
    -- ^ Ciphertext claims and signature tag
encryptPayload :: forall ba iv.
(ByteArray ba, ByteArray iv) =>
Enc -> ScrubbedBytes -> iv -> ba -> ba -> Maybe (AuthTag, ba)
encryptPayload Enc
e ScrubbedBytes
cek iv
iv ba
aad ba
msg = case Enc
e of
    Enc
A128GCM       -> forall {a}. BlockCipher a => C a -> Maybe (AuthTag, ba)
doGCM (forall c. C c
C :: C AES128)
    Enc
A192GCM       -> forall {a}. BlockCipher a => C a -> Maybe (AuthTag, ba)
doGCM (forall c. C c
C :: C AES192)
    Enc
A256GCM       -> forall {a}. BlockCipher a => C a -> Maybe (AuthTag, ba)
doGCM (forall c. C c
C :: C AES256)
    Enc
A128CBC_HS256 -> forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> a -> Int -> Maybe (AuthTag, ba)
doCBC (forall c. C c
C :: C AES128) SHA256
SHA256 Int
16
    Enc
A192CBC_HS384 -> forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> a -> Int -> Maybe (AuthTag, ba)
doCBC (forall c. C c
C :: C AES192) SHA384
SHA384 Int
24
    Enc
A256CBC_HS512 -> forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> a -> Int -> Maybe (AuthTag, ba)
doCBC (forall c. C c
C :: C AES256) SHA512
SHA512 Int
32
  where
    (ScrubbedBytes
cbcMacKey, ScrubbedBytes
cbcEncKey) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt (forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
cek forall a. Integral a => a -> a -> a
`div` Int
2) ScrubbedBytes
cek :: (ScrubbedBytes, ScrubbedBytes)
    al :: Word64
al = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
aad) forall a. Num a => a -> a -> a
* Word64
8 :: Word64

    doGCM :: C a -> Maybe (AuthTag, ba)
doGCM C a
c = do
        a
cipher <- forall a b. Either a b -> Maybe b
rightToMaybe (forall c.
BlockCipher c =>
C c -> ScrubbedBytes -> Either JwtError c
initCipher C a
c ScrubbedBytes
cek)
        AEAD a
aead <- forall a. CryptoFailable a -> Maybe a
maybeCryptoError (forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
aeadInit AEADMode
AEAD_GCM a
cipher iv
iv)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
aeadSimpleEncrypt AEAD a
aead ba
aad ba
msg Int
16

    doCBC :: (HashAlgorithm a, BlockCipher c) => C c -> a -> Int -> Maybe (AuthTag, ba)
    doCBC :: forall a c.
(HashAlgorithm a, BlockCipher c) =>
C c -> a -> Int -> Maybe (AuthTag, ba)
doCBC C c
c a
a Int
tagLen = do
        c
cipher <- forall a b. Either a b -> Maybe b
rightToMaybe (forall c.
BlockCipher c =>
C c -> ScrubbedBytes -> Either JwtError c
initCipher C c
c ScrubbedBytes
cbcEncKey)
        IV c
iv'    <- forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV iv
iv
        let ct :: ba
ct = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt c
cipher IV c
iv' (forall ba. ByteArray ba => ba -> ba
pad ba
msg)
            mac :: HMAC a
mac = forall a. HashAlgorithm a => a -> ba -> HMAC a
doMac a
a ba
ct
            tag :: Bytes
tag = forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
tagLen (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert HMAC a
mac)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> AuthTag
AuthTag Bytes
tag, ba
ct)

    doMac :: HashAlgorithm a => a -> ba -> HMAC a
    doMac :: forall a. HashAlgorithm a => a -> ba -> HMAC a
doMac a
_ ba
ct = forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ScrubbedBytes
cbcMacKey (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat [forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
aad, forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert iv
iv, forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ct, forall a. Serialize a => a -> ByteString
Serialize.encode Word64
al] :: ByteString)

unpad :: (ByteArray ba) => ba -> Maybe ba
unpad :: forall ba. ByteArray ba => ba -> Maybe ba
unpad ba
bs
    | Int
padLen forall a. Ord a => a -> a -> Bool
> Int
16 Bool -> Bool -> Bool
|| Int
padLen forall a. Eq a => a -> a -> Bool
/= forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
padding = forall a. Maybe a
Nothing
    | forall ba. ByteArrayAccess ba => (Word8 -> Bool) -> ba -> Bool
BA.any (forall a. Eq a => a -> a -> Bool
/= Word8
padByte) ba
padding = forall a. Maybe a
Nothing
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ba
pt
  where
    len :: Int
len     = forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
bs
    padByte :: Word8
padByte = forall a. ByteArrayAccess a => a -> Int -> Word8
BA.index ba
bs (Int
lenforall a. Num a => a -> a -> a
-Int
1)
    padLen :: Int
padLen  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
padByte
    (ba
pt, ba
padding) = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt (Int
len forall a. Num a => a -> a -> a
- Int
padLen) ba
bs

pad ::  (ByteArray ba) => ba -> ba
pad :: forall ba. ByteArray ba => ba -> ba
pad ba
bs = forall bs. ByteArray bs => bs -> bs -> bs
BA.append ba
bs ba
padding
  where
    lastBlockSize :: Int
lastBlockSize = forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
bs forall a. Integral a => a -> a -> a
`mod` Int
16
    padByte :: Word8
padByte       = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
16 forall a. Num a => a -> a -> a
- Int
lastBlockSize :: Word8
    padding :: ba
padding       = forall ba. ByteArray ba => Int -> Word8 -> ba
BA.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
padByte) Word8
padByte


-- Key wrapping and unwrapping functions

-- | <https://tools.ietf.org/html/rfc3394#section-2.2.1>
keyWrap :: ByteArray ba => JweAlg -> ScrubbedBytes -> ScrubbedBytes -> Either JwtError ba
keyWrap :: forall ba.
ByteArray ba =>
JweAlg -> ScrubbedBytes -> ScrubbedBytes -> Either JwtError ba
keyWrap JweAlg
alg ScrubbedBytes
kek ScrubbedBytes
cek = case JweAlg
alg of
    JweAlg
A128KW -> forall {a} {b}.
(ByteArray b, BlockCipher a) =>
C a -> Either JwtError b
doKeyWrap (forall c. C c
C :: C AES128)
    JweAlg
A192KW -> forall {a} {b}.
(ByteArray b, BlockCipher a) =>
C a -> Either JwtError b
doKeyWrap (forall c. C c
C :: C AES192)
    JweAlg
A256KW -> forall {a} {b}.
(ByteArray b, BlockCipher a) =>
C a -> Either JwtError b
doKeyWrap (forall c. C c
C :: C AES256)
    JweAlg
_      -> forall a b. a -> Either a b
Left (Text -> JwtError
BadAlgorithm Text
"Not a keywrap algorithm")
  where
    l :: Int
l = forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
cek
    n :: Int
n = Int
l forall a. Integral a => a -> a -> a
`div` Int
8
    iv :: ByteString
iv = forall ba. ByteArray ba => Int -> Word8 -> ba
BA.replicate Int
8 Word8
166 :: ByteString

    doKeyWrap :: C a -> Either JwtError b
doKeyWrap C a
c = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l forall a. Ord a => a -> a -> Bool
< Int
16 Bool -> Bool -> Bool
|| Int
l forall a. Integral a => a -> a -> a
`mod` Int
8 forall a. Eq a => a -> a -> Bool
/= Int
0) (forall a b. a -> Either a b
Left (Text -> JwtError
KeyError Text
"Invalid content key"))
        a
cipher <- forall c.
BlockCipher c =>
C c -> ScrubbedBytes -> Either JwtError c
initCipher C a
c ScrubbedBytes
kek
        let p :: [ScrubbedBytes]
p = forall ba. ByteArray ba => ba -> [ba]
toBlocks ScrubbedBytes
cek
            (ScrubbedBytes
r0, [ScrubbedBytes]
r) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {a} {a}.
(ByteArray a, ByteArray a) =>
(a -> a) -> Int -> (a, [a]) -> Int -> (a, [a])
doRound (forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbEncrypt a
cipher) Int
1) (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
iv, [ScrubbedBytes]
p) [Int
0..Int
5]
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat (ScrubbedBytes
r0 forall a. a -> [a] -> [a]
: [ScrubbedBytes]
r)

    doRound :: (a -> a) -> Int -> (a, [a]) -> Int -> (a, [a])
doRound a -> a
_ Int
_  (a
a, []) Int
_ = (a
a, [])
    doRound a -> a
enc Int
i (a
a, a
r:[a]
rs) Int
j =
        let b :: a
b  = a -> a
enc forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat [a
a, a
r]
            t :: Word8
t  = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
nforall a. Num a => a -> a -> a
*Int
j) forall a. Num a => a -> a -> a
+ Int
i) :: Word8
            a' :: a
a' = forall ba. ByteArray ba => Word8 -> ba -> ba
txor Word8
t (forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
8 a
b)
            r' :: a
r' = forall bs. ByteArray bs => Int -> bs -> bs
BA.drop Int
8 a
b
            next :: (a, [a])
next = (a -> a) -> Int -> (a, [a]) -> Int -> (a, [a])
doRound a -> a
enc (Int
iforall a. Num a => a -> a -> a
+Int
1) (a
a', [a]
rs) Int
j
        in (forall a b. (a, b) -> a
fst (a, [a])
next, a
r' forall a. a -> [a] -> [a]
: forall a b. (a, b) -> b
snd (a, [a])
next)

txor :: ByteArray ba => Word8 -> ba -> ba
txor :: forall ba. ByteArray ba => Word8 -> ba -> ba
txor Word8
t ba
b =
    let n :: Int
n = forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
b
        lastByte :: Word8
lastByte = forall a. ByteArrayAccess a => a -> Int -> Word8
BA.index ba
b (Int
nforall a. Num a => a -> a -> a
-Int
1)
        initBytes :: ba
initBytes = forall bs. ByteArray bs => Int -> bs -> bs
BA.take (Int
nforall a. Num a => a -> a -> a
-Int
1) ba
b
      in forall a. ByteArray a => a -> Word8 -> a
BA.snoc ba
initBytes (Word8
lastByte forall a. Bits a => a -> a -> a
`xor` Word8
t)

toBlocks :: ByteArray ba => ba -> [ba]
toBlocks :: forall ba. ByteArray ba => ba -> [ba]
toBlocks ba
bytes
    | forall a. ByteArrayAccess a => a -> Bool
BA.null ba
bytes = []
    | Bool
otherwise = let (ba
b, ba
bs') = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt Int
8 ba
bytes
                   in ba
b forall a. a -> [a] -> [a]
: forall ba. ByteArray ba => ba -> [ba]
toBlocks ba
bs'

keyUnwrap :: ByteArray ba => ScrubbedBytes -> JweAlg -> ba -> Either JwtError ScrubbedBytes
keyUnwrap :: forall ba.
ByteArray ba =>
ScrubbedBytes -> JweAlg -> ba -> Either JwtError ScrubbedBytes
keyUnwrap ScrubbedBytes
kek JweAlg
alg ba
encK = case JweAlg
alg of
    JweAlg
A128KW -> forall {a} {b}.
(ByteArray b, BlockCipher a) =>
C a -> Either JwtError b
doUnWrap (forall c. C c
C :: C AES128)
    JweAlg
A192KW -> forall {a} {b}.
(ByteArray b, BlockCipher a) =>
C a -> Either JwtError b
doUnWrap (forall c. C c
C :: C AES192)
    JweAlg
A256KW -> forall {a} {b}.
(ByteArray b, BlockCipher a) =>
C a -> Either JwtError b
doUnWrap (forall c. C c
C :: C AES256)
    JweAlg
_      -> forall a b. a -> Either a b
Left (Text -> JwtError
BadAlgorithm Text
"Not a keywrap algorithm")
  where
    l :: Int
l = forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
encK
    n :: Int
n = (Int
l forall a. Integral a => a -> a -> a
`div` Int
8) forall a. Num a => a -> a -> a
- Int
1
    iv :: ba
iv = forall ba. ByteArray ba => Int -> Word8 -> ba
BA.replicate Int
8 Word8
166

    doUnWrap :: C a -> Either JwtError b
doUnWrap C a
c = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
|| Int
l forall a. Integral a => a -> a -> a
`mod` Int
8 forall a. Eq a => a -> a -> Bool
/= Int
0) (forall a b. a -> Either a b
Left JwtError
BadCrypto)
        a
cipher <- forall c.
BlockCipher c =>
C c -> ScrubbedBytes -> Either JwtError c
initCipher C a
c ScrubbedBytes
kek
        let r :: [ba]
r = forall ba. ByteArray ba => ba -> [ba]
toBlocks ba
encK
            (ba
p0, [ba]
p) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {a} {a}.
(ByteArray a, ByteArray a) =>
(a -> a) -> Int -> (a, [a]) -> Int -> (a, [a])
doRound (forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
ecbDecrypt a
cipher) Int
n) (forall a. [a] -> a
head [ba]
r, forall a. [a] -> [a]
reverse (forall a. [a] -> [a]
tail [ba]
r)) (forall a. [a] -> [a]
reverse [Int
0..Int
5])
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ba
p0 forall a. Eq a => a -> a -> Bool
== ba
iv) (forall a b. a -> Either a b
Left JwtError
BadCrypto)
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat (forall a. [a] -> [a]
reverse [ba]
p)

    doRound :: (a -> a) -> Int -> (a, [a]) -> Int -> (a, [a])
doRound a -> a
_ Int
_  (a
a, []) Int
_ = (a
a, [])
    doRound a -> a
dec Int
i (a
a, a
r:[a]
rs) Int
j =
        let b :: a
b  = a -> a
dec forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat [forall ba. ByteArray ba => Word8 -> ba -> ba
txor Word8
t a
a, a
r]
            t :: Word8
t  = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
nforall a. Num a => a -> a -> a
*Int
j) forall a. Num a => a -> a -> a
+ Int
i) :: Word8
            a' :: a
a' = forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
8 a
b
            r' :: a
r' = forall bs. ByteArray bs => Int -> bs -> bs
BA.drop Int
8 a
b
            next :: (a, [a])
next = (a -> a) -> Int -> (a, [a]) -> Int -> (a, [a])
doRound a -> a
dec (Int
iforall a. Num a => a -> a -> a
-Int
1) (a
a', [a]
rs) Int
j
        in (forall a b. (a, b) -> a
fst (a, [a])
next, a
r' forall a. a -> [a] -> [a]
: forall a b. (a, b) -> b
snd (a, [a])
next)