{-# LANGUAGE CPP #-}

-- |
-- Module      : Amazonka.S3.Encryption.Envelope
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.S3.Encryption.Envelope where

import qualified Amazonka as AWS
import Amazonka.Core
import qualified Amazonka.KMS as KMS
import qualified Amazonka.KMS.Lens as KMS
import Amazonka.Prelude
import Amazonka.S3.Encryption.Body
import Amazonka.S3.Encryption.Types
import Conduit ((.|))
import qualified Conduit
import qualified Control.Exception as Exception
import Control.Lens ((+~), (?~), (^.))
import Crypto.Cipher.AES (AES256)
import qualified Crypto.Cipher.AES as AES
import Crypto.Cipher.Types (BlockCipher, Cipher, IV)
import qualified Crypto.Cipher.Types as Cipher
import qualified Crypto.Data.Padding as Padding
import qualified Crypto.Error
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
import Crypto.PubKey.RSA.Types (KeyPair, toPrivateKey, toPublicKey)
import Crypto.Random (getRandomBytes)
import qualified Data.Aeson as Aeson
import Data.ByteArray (ByteArray)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as Map

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Key
#endif

data V1Envelope = V1Envelope
  { -- | @x-amz-key@: Content encrypting key (cek) in encrypted form, base64
    -- encoded. The cek is randomly generated per S3 object, and is always
    -- an AES 256-bit key. The corresponding cipher is always @AES/CBC/PKCS5Padding@.
    V1Envelope -> ByteString
_v1Key :: !ByteString,
    -- | @x-amz-iv@: Randomly generated IV (per S3 object), base64 encoded.
    V1Envelope -> IV AES256
_v1IV :: !(Cipher.IV AES.AES256),
    -- | @x-amz-matdesc@: Customer provided material description in JSON (UTF8)
    -- format.
    V1Envelope -> Description
_v1Description :: !Description
  }

newV1 :: MonadIO m => (ByteString -> IO ByteString) -> Description -> m Envelope
newV1 :: (ByteString -> IO ByteString) -> Description -> m Envelope
newV1 ByteString -> IO ByteString
f Description
d =
  IO Envelope -> m Envelope
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Envelope -> m Envelope) -> IO Envelope -> m Envelope
forall a b. (a -> b) -> a -> b
$ do
    ByteString
k <- Int -> IO ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
aesKeySize
    AES256
c <- ByteString -> IO AES256
forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher ByteString
k
    ByteString
ek <- ByteString -> IO ByteString
f ByteString
k
    IV AES256
iv <- ByteString -> IO (IV AES256)
forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV (ByteString -> IO (IV AES256)) -> IO ByteString -> IO (IV AES256)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
aesBlockSize

    Envelope -> IO Envelope
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope -> IO Envelope)
-> (V1Envelope -> Envelope) -> V1Envelope -> IO Envelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V1Envelope -> Envelope
V1 AES256
c (V1Envelope -> IO Envelope) -> V1Envelope -> IO Envelope
forall a b. (a -> b) -> a -> b
$
      V1Envelope :: ByteString -> IV AES256 -> Description -> V1Envelope
V1Envelope
        { _v1Key :: ByteString
_v1Key = ByteString
ek,
          _v1IV :: IV AES256
_v1IV = IV AES256
iv,
          _v1Description :: Description
_v1Description = Description
d
        }

decodeV1 ::
  MonadResource m =>
  (ByteString -> IO ByteString) ->
  [(CI Text, Text)] ->
  m Envelope
decodeV1 :: (ByteString -> IO ByteString) -> [(CI Text, Text)] -> m Envelope
decodeV1 ByteString -> IO ByteString
decryptKey [(CI Text, Text)]
meta = do
  Base64 ByteString
k <- [(CI Text, Text)]
meta [(CI Text, Text)] -> CI Text -> m Base64
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Key"
  Base64 ByteString
i <- [(CI Text, Text)]
meta [(CI Text, Text)] -> CI Text -> m Base64
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-IV"
  Description
d <- [(CI Text, Text)]
meta [(CI Text, Text)] -> CI Text -> m Description
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Matdesc"

  ByteString
key <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO ByteString
decryptKey ByteString
k)
  IV AES256
iv <- ByteString -> m (IV AES256)
forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV ByteString
i
  AES256
cipher <- ByteString -> m AES256
forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher ByteString
key

  Envelope -> m Envelope
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope -> m Envelope)
-> (V1Envelope -> Envelope) -> V1Envelope -> m Envelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V1Envelope -> Envelope
V1 AES256
cipher (V1Envelope -> m Envelope) -> V1Envelope -> m Envelope
forall a b. (a -> b) -> a -> b
$
    V1Envelope :: ByteString -> IV AES256 -> Description -> V1Envelope
V1Envelope
      { _v1Key :: ByteString
_v1Key = ByteString
key,
        _v1IV :: IV AES256
_v1IV = IV AES256
iv,
        _v1Description :: Description
_v1Description = Description
d
      }

data V2Envelope = V2Envelope
  { -- | @x-amz-key-v2@: CEK in key wrapped form. This is necessary so that
    -- the S3 encryption client that doesn't recognize the v2 format will not
    -- mistakenly decrypt S3 object encrypted in v2 format.
    V2Envelope -> ByteString
_v2Key :: !ByteString,
    -- | @x-amz-iv@: Randomly generated IV (per S3 object), base64 encoded.
    V2Envelope -> IV AES256
_v2IV :: !(Cipher.IV AES.AES256),
    -- | @x-amz-cek-alg@: Content encryption algorithm used.  Supported values:
    -- @AES/GCM/NoPadding@, @AES/CBC/PKCS5Padding@ Default to @AES/CBC/PKCS5Padding@
    -- if this key is absent.
    --
    -- Supported values: @AESWrap@, @RSA/ECB/OAEPWithSHA-256AndMGF1Padding@, @kms@ No
    -- standard key wrapping is used if this meta information is absent Always set to
    -- @kms@ if KMS is used for client-side encryption
    V2Envelope -> ContentAlgorithm
_v2CEKAlgorithm :: !ContentAlgorithm,
    -- | @x-amz-wrap-alg@: Key wrapping algorithm used.
    V2Envelope -> WrappingAlgorithm
_v2WrapAlgorithm :: !WrappingAlgorithm,
    -- | @x-amz-matdesc@: Customer provided material description in JSON format.
    -- Used to identify the client-side master key. For KMS client side
    -- encryption, the KMS Customer Master Key ID is stored as part of the material
    -- description, @x-amz-matdesc, under the key-name @kms_cmk_id@.
    V2Envelope -> Description
_v2Description :: !Description
  }

newV2 ::
  MonadResource m =>
  Text ->
  AWS.Env ->
  Description ->
  m Envelope
newV2 :: Text -> Env -> Description -> m Envelope
newV2 Text
kid Env
env Description
d = do
  let context :: HashMap Text Text
context = Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert Text
"kms_cmk_id" Text
kid (Description -> HashMap Text Text
fromDescription Description
d)

  GenerateDataKeyResponse
rs <-
    Env -> GenerateDataKey -> m (AWSResponse GenerateDataKey)
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a) =>
Env -> a -> m (AWSResponse a)
AWS.send Env
env (GenerateDataKey -> m (AWSResponse GenerateDataKey))
-> GenerateDataKey -> m (AWSResponse GenerateDataKey)
forall a b. (a -> b) -> a -> b
$
      Text -> GenerateDataKey
KMS.newGenerateDataKey Text
kid
        GenerateDataKey
-> (GenerateDataKey -> GenerateDataKey) -> GenerateDataKey
forall a b. a -> (a -> b) -> b
& (Maybe (HashMap Text Text) -> Identity (Maybe (HashMap Text Text)))
-> GenerateDataKey -> Identity GenerateDataKey
Lens' GenerateDataKey (Maybe (HashMap Text Text))
KMS.generateDataKey_encryptionContext ((Maybe (HashMap Text Text)
  -> Identity (Maybe (HashMap Text Text)))
 -> GenerateDataKey -> Identity GenerateDataKey)
-> HashMap Text Text -> GenerateDataKey -> GenerateDataKey
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ HashMap Text Text
context
        GenerateDataKey
-> (GenerateDataKey -> GenerateDataKey) -> GenerateDataKey
forall a b. a -> (a -> b) -> b
& (Maybe DataKeySpec -> Identity (Maybe DataKeySpec))
-> GenerateDataKey -> Identity GenerateDataKey
Lens' GenerateDataKey (Maybe DataKeySpec)
KMS.generateDataKey_keySpec ((Maybe DataKeySpec -> Identity (Maybe DataKeySpec))
 -> GenerateDataKey -> Identity GenerateDataKey)
-> DataKeySpec -> GenerateDataKey -> GenerateDataKey
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ DataKeySpec
KMS.DataKeySpec_AES_256

  ByteString
ivBytes <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
aesBlockSize)
  IV AES256
iv <- ByteString -> m (IV AES256)
forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV ByteString
ivBytes
  AES256
cipher <- ByteString -> m AES256
forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher (GenerateDataKeyResponse
rs GenerateDataKeyResponse
-> Getting ByteString GenerateDataKeyResponse ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString GenerateDataKeyResponse ByteString
Lens' GenerateDataKeyResponse ByteString
KMS.generateDataKeyResponse_plaintext)

  Envelope -> m Envelope
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope -> m Envelope)
-> (V2Envelope -> Envelope) -> V2Envelope -> m Envelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V2Envelope -> Envelope
V2 AES256
cipher (V2Envelope -> m Envelope) -> V2Envelope -> m Envelope
forall a b. (a -> b) -> a -> b
$
    V2Envelope :: ByteString
-> IV AES256
-> ContentAlgorithm
-> WrappingAlgorithm
-> Description
-> V2Envelope
V2Envelope
      { _v2Key :: ByteString
_v2Key = GenerateDataKeyResponse
rs GenerateDataKeyResponse
-> Getting ByteString GenerateDataKeyResponse ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString GenerateDataKeyResponse ByteString
Lens' GenerateDataKeyResponse ByteString
KMS.generateDataKeyResponse_ciphertextBlob,
        _v2IV :: IV AES256
_v2IV = IV AES256
iv,
        _v2CEKAlgorithm :: ContentAlgorithm
_v2CEKAlgorithm = ContentAlgorithm
AES_CBC_PKCS5Padding,
        _v2WrapAlgorithm :: WrappingAlgorithm
_v2WrapAlgorithm = WrappingAlgorithm
KMSWrap,
        _v2Description :: Description
_v2Description = HashMap Text Text -> Description
Description HashMap Text Text
context
      }

decodeV2 ::
  MonadResource m =>
  AWS.Env ->
  [(CI Text, Text)] ->
  Description ->
  m Envelope
decodeV2 :: Env -> [(CI Text, Text)] -> Description -> m Envelope
decodeV2 Env
env [(CI Text, Text)]
xs Description
m = do
  ContentAlgorithm
a <- [(CI Text, Text)]
xs [(CI Text, Text)] -> CI Text -> m ContentAlgorithm
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-CEK-Alg"
  WrappingAlgorithm
w <- [(CI Text, Text)]
xs [(CI Text, Text)] -> CI Text -> m WrappingAlgorithm
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Wrap-Alg"
  ByteString
raw <- [(CI Text, Text)]
xs [(CI Text, Text)] -> CI Text -> m Base64
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Key-V2" m Base64 -> (Base64 -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Base64 -> ByteString) -> Base64 -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
unBase64
  IV AES256
iv <- [(CI Text, Text)]
xs [(CI Text, Text)] -> CI Text -> m Base64
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-IV" m Base64 -> (Base64 -> m (IV AES256)) -> m (IV AES256)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m (IV AES256)
forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV (ByteString -> m (IV AES256))
-> (Base64 -> ByteString) -> Base64 -> m (IV AES256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
unBase64
  Description
d <- [(CI Text, Text)]
xs [(CI Text, Text)] -> CI Text -> m Description
forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Matdesc"

  DecryptResponse
rs <-
    Env -> Decrypt -> m (AWSResponse Decrypt)
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a) =>
Env -> a -> m (AWSResponse a)
AWS.send Env
env (Decrypt -> m (AWSResponse Decrypt))
-> Decrypt -> m (AWSResponse Decrypt)
forall a b. (a -> b) -> a -> b
$
      ByteString -> Decrypt
KMS.newDecrypt ByteString
raw
        Decrypt -> (Decrypt -> Decrypt) -> Decrypt
forall a b. a -> (a -> b) -> b
& (Maybe (HashMap Text Text) -> Identity (Maybe (HashMap Text Text)))
-> Decrypt -> Identity Decrypt
Lens' Decrypt (Maybe (HashMap Text Text))
KMS.decrypt_encryptionContext ((Maybe (HashMap Text Text)
  -> Identity (Maybe (HashMap Text Text)))
 -> Decrypt -> Identity Decrypt)
-> HashMap Text Text -> Decrypt -> Decrypt
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Description -> HashMap Text Text
fromDescription (Description
m Description -> Description -> Description
forall a. Semigroup a => a -> a -> a
<> Description
d)
  -- Left-associative merge for material description,
  -- keys in the supplied description override those
  -- on the envelope.

  ByteString
k <- DecryptResponse -> m ByteString
forall (m :: * -> *). MonadIO m => DecryptResponse -> m ByteString
plaintext DecryptResponse
rs
  AES256
c <- ByteString -> m AES256
forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher ByteString
k

  Envelope -> m Envelope
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope -> m Envelope)
-> (V2Envelope -> Envelope) -> V2Envelope -> m Envelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V2Envelope -> Envelope
V2 AES256
c (V2Envelope -> m Envelope) -> V2Envelope -> m Envelope
forall a b. (a -> b) -> a -> b
$ ByteString
-> IV AES256
-> ContentAlgorithm
-> WrappingAlgorithm
-> Description
-> V2Envelope
V2Envelope ByteString
k IV AES256
iv ContentAlgorithm
a WrappingAlgorithm
w Description
d

data Envelope
  = V1 AES.AES256 V1Envelope
  | V2 AES.AES256 V2Envelope

instance ToHeaders Envelope where
  toHeaders :: Envelope -> [Header]
toHeaders = (Header -> Header) -> [Header] -> [Header]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CI ByteString -> CI ByteString) -> Header -> Header
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ByteString -> ByteString) -> CI ByteString -> CI ByteString
forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map (ByteString
"X-Amz-Meta-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>))) ([Header] -> [Header])
-> (Envelope -> [Header]) -> Envelope -> [Header]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope -> [Header]
toMetadata

#if MIN_VERSION_aeson(2,0,0)
instance ToJSON Envelope where
  toJSON = object . map (bimap k v) . toMetadata
    where
      k = Key.fromText . toText . CI.foldedCase
      v = Aeson.String . toText
#else
instance ToJSON Envelope where
  toJSON :: Envelope -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (Envelope -> [Pair]) -> Envelope -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> Pair) -> [Header] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ((CI ByteString -> Text) -> (ByteString -> Value) -> Header -> Pair
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CI ByteString -> Text
k ByteString -> Value
v) ([Header] -> [Pair])
-> (Envelope -> [Header]) -> Envelope -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope -> [Header]
toMetadata
    where
      k :: CI ByteString -> Text
k = ByteString -> Text
forall a. ToText a => a -> Text
toText (ByteString -> Text)
-> (CI ByteString -> ByteString) -> CI ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> ByteString
forall s. CI s -> s
CI.foldedCase
      v :: ByteString -> Value
v = Text -> Value
Aeson.String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a. ToText a => a -> Text
toText
#endif

instance ToBody Envelope where
  toBody :: Envelope -> RequestBody
toBody = Value -> RequestBody
forall a. ToBody a => a -> RequestBody
toBody (Value -> RequestBody)
-> (Envelope -> Value) -> Envelope -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope -> Value
forall a. ToJSON a => a -> Value
toJSON

toMetadata :: Envelope -> [(CI ByteString, ByteString)]
toMetadata :: Envelope -> [Header]
toMetadata = \case
  V1 AES256
_ V1Envelope
x -> V1Envelope -> [Header]
forall a. IsString a => V1Envelope -> [(a, ByteString)]
v1 V1Envelope
x
  V2 AES256
_ V2Envelope
x -> V2Envelope -> [Header]
forall a. IsString a => V2Envelope -> [(a, ByteString)]
v2 V2Envelope
x
  where
    v1 :: V1Envelope -> [(a, ByteString)]
v1 V1Envelope {ByteString
IV AES256
Description
_v1Description :: Description
_v1IV :: IV AES256
_v1Key :: ByteString
_v1Description :: V1Envelope -> Description
_v1IV :: V1Envelope -> IV AES256
_v1Key :: V1Envelope -> ByteString
..} =
      [ (a
"X-Amz-Key", ByteString -> ByteString
b64 ByteString
_v1Key),
        (a
"X-Amz-IV", ByteString -> ByteString
b64 (IV AES256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert IV AES256
_v1IV)),
        (a
"X-Amz-Matdesc", Description -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Description
_v1Description)
      ]

    v2 :: V2Envelope -> [(a, ByteString)]
v2 V2Envelope {ByteString
IV AES256
Description
WrappingAlgorithm
ContentAlgorithm
_v2Description :: Description
_v2WrapAlgorithm :: WrappingAlgorithm
_v2CEKAlgorithm :: ContentAlgorithm
_v2IV :: IV AES256
_v2Key :: ByteString
_v2Description :: V2Envelope -> Description
_v2WrapAlgorithm :: V2Envelope -> WrappingAlgorithm
_v2CEKAlgorithm :: V2Envelope -> ContentAlgorithm
_v2IV :: V2Envelope -> IV AES256
_v2Key :: V2Envelope -> ByteString
..} =
      [ (a
"X-Amz-Key-V2", ByteString -> ByteString
b64 ByteString
_v2Key),
        (a
"X-Amz-IV", ByteString -> ByteString
b64 (IV AES256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert IV AES256
_v2IV)),
        (a
"X-Amz-CEK-Alg", ContentAlgorithm -> ByteString
forall a. ToByteString a => a -> ByteString
toBS ContentAlgorithm
_v2CEKAlgorithm),
        (a
"X-Amz-Wrap-Alg", WrappingAlgorithm -> ByteString
forall a. ToByteString a => a -> ByteString
toBS WrappingAlgorithm
_v2WrapAlgorithm),
        (a
"X-Amz-Matdesc", Description -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Description
_v2Description)
      ]

    b64 :: ByteString -> ByteString
    b64 :: ByteString -> ByteString
b64 = Base64 -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (Base64 -> ByteString)
-> (ByteString -> Base64) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64
Base64

newEnvelope ::
  MonadResource m =>
  Key ->
  AWS.Env ->
  m Envelope
newEnvelope :: Key -> Env -> m Envelope
newEnvelope Key
key Env
env =
  case Key
key of
    Symmetric AES256
c Description
d -> (ByteString -> IO ByteString) -> Description -> m Envelope
forall (m :: * -> *).
MonadIO m =>
(ByteString -> IO ByteString) -> Description -> m Envelope
newV1 (ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
Cipher.ecbEncrypt AES256
c) Description
d
    Asymmetric KeyPair
p Description
d -> (ByteString -> IO ByteString) -> Description -> m Envelope
forall (m :: * -> *).
MonadIO m =>
(ByteString -> IO ByteString) -> Description -> m Envelope
newV1 (KeyPair -> ByteString -> IO ByteString
rsaEncrypt KeyPair
p) Description
d
    KMS Text
kid Description
d -> Text -> Env -> Description -> m Envelope
forall (m :: * -> *).
MonadResource m =>
Text -> Env -> Description -> m Envelope
newV2 Text
kid Env
env Description
d

decodeEnvelope ::
  MonadResource m =>
  Key ->
  AWS.Env ->
  [(CI Text, Text)] ->
  m Envelope
decodeEnvelope :: Key -> Env -> [(CI Text, Text)] -> m Envelope
decodeEnvelope Key
key Env
env [(CI Text, Text)]
xs =
  case Key
key of
    Symmetric AES256
c Description
_ -> (ByteString -> IO ByteString) -> [(CI Text, Text)] -> m Envelope
forall (m :: * -> *).
MonadResource m =>
(ByteString -> IO ByteString) -> [(CI Text, Text)] -> m Envelope
decodeV1 (ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
Cipher.ecbDecrypt AES256
c) [(CI Text, Text)]
xs
    Asymmetric KeyPair
p Description
_ -> (ByteString -> IO ByteString) -> [(CI Text, Text)] -> m Envelope
forall (m :: * -> *).
MonadResource m =>
(ByteString -> IO ByteString) -> [(CI Text, Text)] -> m Envelope
decodeV1 (KeyPair -> ByteString -> IO ByteString
rsaDecrypt KeyPair
p) [(CI Text, Text)]
xs
    KMS Text
_ Description
d -> Env -> [(CI Text, Text)] -> Description -> m Envelope
forall (m :: * -> *).
MonadResource m =>
Env -> [(CI Text, Text)] -> Description -> m Envelope
decodeV2 Env
env [(CI Text, Text)]
xs Description
d

fromMetadata ::
  MonadResource m =>
  Key ->
  AWS.Env ->
  HashMap Text Text ->
  m Envelope
fromMetadata :: Key -> Env -> HashMap Text Text -> m Envelope
fromMetadata Key
key Env
env =
  Key -> Env -> [(CI Text, Text)] -> m Envelope
forall (m :: * -> *).
MonadResource m =>
Key -> Env -> [(CI Text, Text)] -> m Envelope
decodeEnvelope Key
key Env
env
    ([(CI Text, Text)] -> m Envelope)
-> (HashMap Text Text -> [(CI Text, Text)])
-> HashMap Text Text
-> m Envelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (CI Text, Text))
-> [(Text, Text)] -> [(CI Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> CI Text) -> (Text, Text) -> (CI Text, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk)
    ([(Text, Text)] -> [(CI Text, Text)])
-> (HashMap Text Text -> [(Text, Text)])
-> HashMap Text Text
-> [(CI Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
Map.toList

aesKeySize, aesBlockSize :: Int
aesKeySize :: Int
aesKeySize = Int
32
aesBlockSize :: Int
aesBlockSize = Int
16

bodyEncrypt :: Envelope -> RequestBody -> RequestBody
bodyEncrypt :: Envelope -> RequestBody -> RequestBody
bodyEncrypt (Envelope -> (AES256, IV AES256)
getCipher -> (AES256
aes, IV AES256
iv0)) RequestBody
rqBody =
  ChunkedBody -> RequestBody
Chunked (ChunkedBody -> RequestBody) -> ChunkedBody -> RequestBody
forall a b. (a -> b) -> a -> b
$
    RequestBody -> ChunkedBody
forall a. ToChunkedBody a => a -> ChunkedBody
toChunked RequestBody
rqBody
      -- Realign body chunks for upload (AWS enforces chunk limits on all but last)
      ChunkedBody -> (ChunkedBody -> ChunkedBody) -> ChunkedBody
forall a b. a -> (a -> b) -> b
& (ChunkedBody
-> ConduitM ByteString ByteString (ResourceT IO) () -> ChunkedBody
`fuseChunks` (ConduitM ByteString ByteString (ResourceT IO) ()
encryptChunks ConduitM ByteString ByteString (ResourceT IO) ()
-> ConduitM ByteString ByteString (ResourceT IO) ()
-> ConduitM ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Index ByteString
-> ConduitM ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
Conduit.chunksOfCE (ChunkSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ChunkSize
defaultChunkSize)))
      ChunkedBody -> (ChunkedBody -> ChunkedBody) -> ChunkedBody
forall a b. a -> (a -> b) -> b
& (Integer -> Identity Integer)
-> ChunkedBody -> Identity ChunkedBody
Lens' ChunkedBody Integer
chunkedLength ((Integer -> Identity Integer)
 -> ChunkedBody -> Identity ChunkedBody)
-> Integer -> ChunkedBody -> ChunkedBody
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Integer
padding -- extend length for any required AES padding
  where
    encryptChunks :: ConduitM ByteString ByteString (ResourceT IO) ()
encryptChunks = IV AES256
-> (IV AES256 -> ByteString -> (IV AES256, ByteString))
-> (IV AES256 -> ByteString -> ByteString)
-> ConduitM ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
Monad m =>
IV AES256
-> (IV AES256 -> ByteString -> (IV AES256, ByteString))
-> (IV AES256 -> ByteString -> ByteString)
-> ConduitT ByteString ByteString m ()
aesCbc IV AES256
iv0 IV AES256 -> ByteString -> (IV AES256, ByteString)
nextChunk IV AES256 -> ByteString -> ByteString
lastChunk

    nextChunk :: IV AES256 -> ByteString -> (IV AES256, ByteString)
nextChunk IV AES256
iv ByteString
b =
      let iv' :: IV AES256
iv' = IV AES256 -> Maybe (IV AES256) -> IV AES256
forall a. a -> Maybe a -> a
fromMaybe IV AES256
iv (Maybe (IV AES256) -> IV AES256)
-> (ByteString -> Maybe (IV AES256)) -> ByteString -> IV AES256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (IV AES256)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
Cipher.makeIV (ByteString -> IV AES256) -> ByteString -> IV AES256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (ByteString -> Int
BS.length ByteString
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aesBlockSize) ByteString
r
          r :: ByteString
r = AES256 -> IV AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
Cipher.cbcEncrypt AES256
aes IV AES256
iv ByteString
b
       in (IV AES256
iv', ByteString
r)

    lastChunk :: IV AES256 -> ByteString -> ByteString
lastChunk IV AES256
iv = AES256 -> IV AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
Cipher.cbcEncrypt AES256
aes IV AES256
iv (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> ByteString -> ByteString
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
Padding.pad (Int -> Format
Padding.PKCS7 Int
aesBlockSize)

    padding :: Integer
padding = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (RequestBody -> Integer
contentLength RequestBody
rqBody Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n)
    n :: Integer
n = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aesBlockSize

bodyDecrypt :: Envelope -> ResponseBody -> ResponseBody
bodyDecrypt :: Envelope -> ResponseBody -> ResponseBody
bodyDecrypt (Envelope -> (AES256, IV AES256)
getCipher -> (AES256
aes, IV AES256
iv0)) ResponseBody
rsBody =
  ResponseBody
rsBody ResponseBody
-> ConduitM ByteString ByteString (ResourceT IO) () -> ResponseBody
`fuseStream` ConduitM ByteString ByteString (ResourceT IO) ()
decryptChunks
  where
    decryptChunks :: ConduitM ByteString ByteString (ResourceT IO) ()
decryptChunks = IV AES256
-> (IV AES256 -> ByteString -> (IV AES256, ByteString))
-> (IV AES256 -> ByteString -> ByteString)
-> ConduitM ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
Monad m =>
IV AES256
-> (IV AES256 -> ByteString -> (IV AES256, ByteString))
-> (IV AES256 -> ByteString -> ByteString)
-> ConduitT ByteString ByteString m ()
aesCbc IV AES256
iv0 IV AES256 -> ByteString -> (IV AES256, ByteString)
nextChunk IV AES256 -> ByteString -> ByteString
lastChunk

    nextChunk :: IV AES256 -> ByteString -> (IV AES256, ByteString)
nextChunk IV AES256
iv ByteString
b =
      let iv' :: IV AES256
iv' = IV AES256 -> Maybe (IV AES256) -> IV AES256
forall a. a -> Maybe a -> a
fromMaybe IV AES256
iv (Maybe (IV AES256) -> IV AES256)
-> (ByteString -> Maybe (IV AES256)) -> ByteString -> IV AES256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (IV AES256)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
Cipher.makeIV (ByteString -> IV AES256) -> ByteString -> IV AES256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (ByteString -> Int
BS.length ByteString
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aesBlockSize) ByteString
b
          r :: ByteString
r = AES256 -> IV AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
Cipher.cbcDecrypt AES256
aes IV AES256
iv ByteString
b
       in (IV AES256
iv', ByteString
r)

    lastChunk :: IV AES256 -> ByteString -> ByteString
lastChunk IV AES256
iv ByteString
b =
      let r :: ByteString
r = AES256 -> IV AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
Cipher.cbcDecrypt AES256
aes IV AES256
iv ByteString
b
       in ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
r (Format -> ByteString -> Maybe ByteString
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> Maybe byteArray
Padding.unpad (Int -> Format
Padding.PKCS7 Int
aesBlockSize) ByteString
r)

aesCbc ::
  Monad m =>
  IV AES256 ->
  (IV AES256 -> ByteString -> (IV AES256, ByteString)) ->
  (IV AES256 -> ByteString -> ByteString) ->
  Conduit.ConduitT ByteString ByteString m ()
aesCbc :: IV AES256
-> (IV AES256 -> ByteString -> (IV AES256, ByteString))
-> (IV AES256 -> ByteString -> ByteString)
-> ConduitT ByteString ByteString m ()
aesCbc IV AES256
iv0 IV AES256 -> ByteString -> (IV AES256, ByteString)
onNextChunk IV AES256 -> ByteString -> ByteString
onLastChunk =
  Index ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
Conduit.chunksOfCE Int
Index ByteString
aesBlockSize ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| IV AES256
-> Maybe ByteString -> ConduitT ByteString ByteString m ()
goChunk IV AES256
iv0 Maybe ByteString
forall a. Maybe a
Nothing
  where
    goChunk :: IV AES256
-> Maybe ByteString -> ConduitT ByteString ByteString m ()
goChunk IV AES256
iv Maybe ByteString
carry =
      do
        Maybe ByteString
carry' <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
Conduit.await
        case Maybe ByteString
carry' of
          Maybe ByteString
Nothing -> ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT ByteString ByteString m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield (ByteString -> ConduitT ByteString ByteString m ())
-> (ByteString -> ByteString)
-> ByteString
-> ConduitT ByteString ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IV AES256 -> ByteString -> ByteString
onLastChunk IV AES256
iv) Maybe ByteString
carry
          Just ByteString
_ -> case Maybe ByteString
carry of
            Maybe ByteString
Nothing -> IV AES256
-> Maybe ByteString -> ConduitT ByteString ByteString m ()
goChunk IV AES256
iv Maybe ByteString
carry'
            Just ByteString
chunk -> do
              let (IV AES256
iv', ByteString
encrypted) = IV AES256 -> ByteString -> (IV AES256, ByteString)
onNextChunk IV AES256
iv ByteString
chunk
              ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield ByteString
encrypted
              IV AES256
-> Maybe ByteString -> ConduitT ByteString ByteString m ()
goChunk IV AES256
iv' Maybe ByteString
carry'

rsaEncrypt :: KeyPair -> ByteString -> IO ByteString
rsaEncrypt :: KeyPair -> ByteString -> IO ByteString
rsaEncrypt KeyPair
k =
  PublicKey -> ByteString -> IO (Either Error ByteString)
forall (m :: * -> *).
MonadRandom m =>
PublicKey -> ByteString -> m (Either Error ByteString)
RSA.encrypt (KeyPair -> PublicKey
toPublicKey KeyPair
k)
    (ByteString -> IO (Either Error ByteString))
-> (Either Error ByteString -> IO ByteString)
-> ByteString
-> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either EncryptionError ByteString -> IO ByteString
forall (m :: * -> *) a.
MonadIO m =>
Either EncryptionError a -> m a
hoistEither (Either EncryptionError ByteString -> IO ByteString)
-> (Either Error ByteString -> Either EncryptionError ByteString)
-> Either Error ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error -> EncryptionError)
-> Either Error ByteString -> Either EncryptionError ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Error -> EncryptionError
PubKeyFailure

rsaDecrypt :: KeyPair -> ByteString -> IO ByteString
rsaDecrypt :: KeyPair -> ByteString -> IO ByteString
rsaDecrypt KeyPair
k =
  PrivateKey -> ByteString -> IO (Either Error ByteString)
forall (m :: * -> *).
MonadRandom m =>
PrivateKey -> ByteString -> m (Either Error ByteString)
RSA.decryptSafer (KeyPair -> PrivateKey
toPrivateKey KeyPair
k)
    (ByteString -> IO (Either Error ByteString))
-> (Either Error ByteString -> IO ByteString)
-> ByteString
-> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either EncryptionError ByteString -> IO ByteString
forall (m :: * -> *) a.
MonadIO m =>
Either EncryptionError a -> m a
hoistEither (Either EncryptionError ByteString -> IO ByteString)
-> (Either Error ByteString -> Either EncryptionError ByteString)
-> Either Error ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error -> EncryptionError)
-> Either Error ByteString -> Either EncryptionError ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Error -> EncryptionError
PubKeyFailure

getCipher :: Envelope -> (AES.AES256, Cipher.IV AES.AES256)
getCipher :: Envelope -> (AES256, IV AES256)
getCipher = \case
  V1 AES256
c V1Envelope
v1 -> (AES256
c, V1Envelope -> IV AES256
_v1IV V1Envelope
v1)
  V2 AES256
c V2Envelope
v2 -> (AES256
c, V2Envelope -> IV AES256
_v2IV V2Envelope
v2)

createCipher :: (MonadIO m, ByteArray a, Cipher b) => a -> m b
createCipher :: a -> m b
createCipher =
  (CryptoError -> m b) -> (b -> m b) -> CryptoFailable b -> m b
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
Crypto.Error.onCryptoFailure (EncryptionError -> m b
forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO (EncryptionError -> m b)
-> (CryptoError -> EncryptionError) -> CryptoError -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> EncryptionError
CipherFailure) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (CryptoFailable b -> m b) -> (a -> CryptoFailable b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CryptoFailable b
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
Cipher.cipherInit

createIV :: (MonadIO m, BlockCipher a) => ByteString -> m (Cipher.IV a)
createIV :: ByteString -> m (IV a)
createIV ByteString
b = m (IV a) -> (IV a -> m (IV a)) -> Maybe (IV a) -> m (IV a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncryptionError -> m (IV a)
forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO (EncryptionError -> m (IV a)) -> EncryptionError -> m (IV a)
forall a b. (a -> b) -> a -> b
$ ByteString -> EncryptionError
IVInvalid (ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
b)) IV a -> m (IV a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe (IV a)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
Cipher.makeIV ByteString
b)

plaintext :: MonadIO m => KMS.DecryptResponse -> m ByteString
plaintext :: DecryptResponse -> m ByteString
plaintext DecryptResponse
rs =
  case DecryptResponse
rs DecryptResponse
-> Getting (Maybe ByteString) DecryptResponse (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) DecryptResponse (Maybe ByteString)
Lens' DecryptResponse (Maybe ByteString)
KMS.decryptResponse_plaintext of
    Maybe ByteString
Nothing -> EncryptionError -> m ByteString
forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO EncryptionError
PlaintextUnavailable
    Just ByteString
x -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x

(.&) :: (MonadIO m, FromText a) => [(CI Text, Text)] -> CI Text -> m a
[(CI Text, Text)]
xs .& :: [(CI Text, Text)] -> CI Text -> m a
.& CI Text
k =
  case CI Text
k CI Text -> [(CI Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(CI Text, Text)]
xs of
    Maybe Text
Nothing -> EncryptionError -> m a
forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO (CI Text -> EncryptionError
EnvelopeMissing CI Text
k)
    Just Text
x -> Either EncryptionError a -> m a
forall (m :: * -> *) a.
MonadIO m =>
Either EncryptionError a -> m a
hoistEither (CI Text -> String -> EncryptionError
EnvelopeInvalid CI Text
k (String -> EncryptionError)
-> Either String a -> Either EncryptionError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
`first` Text -> Either String a
forall a. FromText a => Text -> Either String a
fromText Text
x)

hoistEither :: MonadIO m => Either EncryptionError a -> m a
hoistEither :: Either EncryptionError a -> m a
hoistEither = (EncryptionError -> m a)
-> (a -> m a) -> Either EncryptionError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EncryptionError -> m a
forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

throwIO :: MonadIO m => EncryptionError -> m a
throwIO :: EncryptionError -> m a
throwIO = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a)
-> (EncryptionError -> IO a) -> EncryptionError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncryptionError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO