{-# LANGUAGE CPP #-}
module Amazonka.S3.Encryption.Envelope where
import qualified Amazonka as AWS
import Amazonka.Data
import qualified Amazonka.KMS as KMS
import qualified Amazonka.KMS.Lens as KMS
import Amazonka.Prelude hiding (length)
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 Data.Functor ((<&>))
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
{
V1Envelope -> ByteString
_v1Key :: !ByteString,
V1Envelope -> IV AES256
_v1IV :: !(Cipher.IV AES.AES256),
V1Envelope -> Description
_v1Description :: !Description
}
newV1 :: MonadIO m => (ByteString -> IO ByteString) -> Description -> m Envelope
newV1 :: forall (m :: * -> *).
MonadIO m =>
(ByteString -> IO ByteString) -> Description -> m Envelope
newV1 ByteString -> IO ByteString
f Description
d =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
ByteString
k <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
aesKeySize
AES256
c <- 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 <- forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
aesBlockSize
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V1Envelope -> Envelope
V1 AES256
c forall a b. (a -> b) -> a -> b
$
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 :: forall (m :: * -> *).
MonadResource m =>
(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 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 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 forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Matdesc"
ByteString
key <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO ByteString
decryptKey ByteString
k)
IV AES256
iv <- forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV ByteString
i
AES256
cipher <- forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher ByteString
key
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V1Envelope -> Envelope
V1 AES256
cipher forall a b. (a -> b) -> a -> b
$
V1Envelope
{ _v1Key :: ByteString
_v1Key = ByteString
key,
_v1IV :: IV AES256
_v1IV = IV AES256
iv,
_v1Description :: Description
_v1Description = Description
d
}
data V2Envelope = V2Envelope
{
V2Envelope -> ByteString
_v2Key :: !ByteString,
V2Envelope -> IV AES256
_v2IV :: !(Cipher.IV AES.AES256),
V2Envelope -> ContentAlgorithm
_v2CEKAlgorithm :: !ContentAlgorithm,
V2Envelope -> WrappingAlgorithm
_v2WrapAlgorithm :: !WrappingAlgorithm,
V2Envelope -> Description
_v2Description :: !Description
}
newV2 ::
MonadResource m =>
Text ->
AWS.Env ->
Description ->
m Envelope
newV2 :: forall (m :: * -> *).
MonadResource m =>
Text -> Env -> Description -> m Envelope
newV2 Text
kid Env
env Description
d = do
let context :: HashMap Text Text
context = 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 <-
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a,
Typeable (AWSResponse a)) =>
Env -> a -> m (AWSResponse a)
AWS.send Env
env forall a b. (a -> b) -> a -> b
$
Text -> GenerateDataKey
KMS.newGenerateDataKey Text
kid
forall a b. a -> (a -> b) -> b
& Lens' GenerateDataKey (Maybe (HashMap Text Text))
KMS.generateDataKey_encryptionContext forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ HashMap Text Text
context
forall a b. a -> (a -> b) -> b
& Lens' GenerateDataKey (Maybe DataKeySpec)
KMS.generateDataKey_keySpec forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ DataKeySpec
KMS.DataKeySpec_AES_256
ByteString
ivBytes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
aesBlockSize)
IV AES256
iv <- forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV ByteString
ivBytes
AES256
cipher <- forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher (GenerateDataKeyResponse
rs forall s a. s -> Getting a s a -> a
^. Lens' GenerateDataKeyResponse ByteString
KMS.generateDataKeyResponse_plaintext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V2Envelope -> Envelope
V2 AES256
cipher forall a b. (a -> b) -> a -> b
$
V2Envelope
{ _v2Key :: ByteString
_v2Key = GenerateDataKeyResponse
rs forall s a. s -> Getting a s a -> a
^. 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 :: forall (m :: * -> *).
MonadResource m =>
Env -> [(CI Text, Text)] -> Description -> m Envelope
decodeV2 Env
env [(CI Text, Text)]
xs Description
m = do
ContentAlgorithm
a <- [(CI Text, Text)]
xs 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 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 forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Key-V2") forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Base64 -> ByteString
unBase64
IV AES256
iv <- [(CI Text, Text)]
xs forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-IV" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
unBase64
Description
d <- [(CI Text, Text)]
xs forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
"X-Amz-Matdesc"
DecryptResponse
rs <-
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a,
Typeable (AWSResponse a)) =>
Env -> a -> m (AWSResponse a)
AWS.send Env
env forall a b. (a -> b) -> a -> b
$
ByteString -> Decrypt
KMS.newDecrypt ByteString
raw
forall a b. a -> (a -> b) -> b
& Lens' Decrypt (Maybe (HashMap Text Text))
KMS.decrypt_encryptionContext forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Description -> HashMap Text Text
fromDescription (Description
m forall a. Semigroup a => a -> a -> a
<> Description
d)
ByteString
k <- forall (m :: * -> *). MonadIO m => DecryptResponse -> m ByteString
plaintext DecryptResponse
rs
AES256
c <- forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher ByteString
k
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. AES256 -> V2Envelope -> Envelope
V2 AES256
c 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 = 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 s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map (ByteString
"X-Amz-Meta-" forall a. Semigroup a => a -> a -> a
<>))) 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 :: Envelope -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CI ByteString -> Key
k ByteString -> Value
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope -> [Header]
toMetadata
where
k :: CI ByteString -> Key
k = Text -> Key
Key.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.foldedCase
v :: ByteString -> Value
v = Text -> Value
Aeson.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText
#else
instance ToJSON Envelope where
toJSON = object . map (bimap k v) . toMetadata
where
k = toText . CI.foldedCase
v = Aeson.String . toText
#endif
instance ToBody Envelope where
toBody :: Envelope -> RequestBody
toBody = forall a. ToBody a => a -> RequestBody
toBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON
toMetadata :: Envelope -> [(CI ByteString, ByteString)]
toMetadata :: Envelope -> [Header]
toMetadata = \case
V1 AES256
_ V1Envelope
x -> forall {a}. IsString a => V1Envelope -> [(a, ByteString)]
v1 V1Envelope
x
V2 AES256
_ V2Envelope
x -> 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 (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert IV AES256
_v1IV)),
(a
"X-Amz-Matdesc", 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 (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert IV AES256
_v2IV)),
(a
"X-Amz-CEK-Alg", forall a. ToByteString a => a -> ByteString
toBS ContentAlgorithm
_v2CEKAlgorithm),
(a
"X-Amz-Wrap-Alg", forall a. ToByteString a => a -> ByteString
toBS WrappingAlgorithm
_v2WrapAlgorithm),
(a
"X-Amz-Matdesc", forall a. ToByteString a => a -> ByteString
toBS Description
_v2Description)
]
b64 :: ByteString -> ByteString
b64 :: ByteString -> ByteString
b64 = forall a. ToByteString a => a -> ByteString
toBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64
Base64
newEnvelope ::
MonadResource m =>
Key ->
AWS.Env ->
m Envelope
newEnvelope :: forall (m :: * -> *). MonadResource m => Key -> Env -> m Envelope
newEnvelope Key
key Env
env =
case Key
key of
Symmetric AES256
c Description
d -> forall (m :: * -> *).
MonadIO m =>
(ByteString -> IO ByteString) -> Description -> m Envelope
newV1 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
Cipher.ecbEncrypt AES256
c) Description
d
Asymmetric KeyPair
p Description
d -> 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 -> 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 :: forall (m :: * -> *).
MonadResource m =>
Key -> Env -> [(CI Text, Text)] -> m Envelope
decodeEnvelope Key
key Env
env [(CI Text, Text)]
xs =
case Key
key of
Symmetric AES256
c Description
_ -> forall (m :: * -> *).
MonadResource m =>
(ByteString -> IO ByteString) -> [(CI Text, Text)] -> m Envelope
decodeV1 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
Cipher.ecbDecrypt AES256
c) [(CI Text, Text)]
xs
Asymmetric KeyPair
p Description
_ -> 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 -> 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 :: forall (m :: * -> *).
MonadResource m =>
Key -> Env -> HashMap Text Text -> m Envelope
fromMetadata Key
key Env
env =
forall (m :: * -> *).
MonadResource m =>
Key -> Env -> [(CI Text, Text)] -> m Envelope
decodeEnvelope Key
key Env
env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s. FoldCase s => s -> CI s
CI.mk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$
forall a. ToChunkedBody a => a -> ChunkedBody
toChunked RequestBody
rqBody
forall a b. a -> (a -> b) -> b
& (ChunkedBody
-> ConduitM ByteString ByteString (ResourceT IO) () -> ChunkedBody
`fuseChunks` (ConduitM ByteString ByteString (ResourceT IO) ()
encryptChunks forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
Conduit.chunksOfCE (forall a b. (Integral a, Num b) => a -> b
fromIntegral ChunkSize
defaultChunkSize)))
forall a b. a -> (a -> b) -> b
& ChunkedBody -> ChunkedBody
addPadding
where
encryptChunks :: ConduitM ByteString ByteString (ResourceT IO) ()
encryptChunks = 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' = forall a. a -> Maybe a -> a
fromMaybe IV AES256
iv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
Cipher.makeIV forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (ByteString -> Int
BS.length ByteString
b forall a. Num a => a -> a -> a
- Int
aesBlockSize) ByteString
r
r :: ByteString
r = 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 = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
Cipher.cbcEncrypt AES256
aes IV AES256
iv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
Padding.pad (Int -> Format
Padding.PKCS7 Int
aesBlockSize)
addPadding :: ChunkedBody -> ChunkedBody
addPadding c :: ChunkedBody
c@ChunkedBody {Integer
$sel:length:ChunkedBody :: ChunkedBody -> Integer
length :: Integer
length} = ChunkedBody
c {$sel:length:ChunkedBody :: Integer
length = Integer
length forall a. Num a => a -> a -> a
+ Integer
padding}
padding :: Integer
padding = Integer
n forall a. Num a => a -> a -> a
- (RequestBody -> Integer
contentLength RequestBody
rqBody forall a. Integral a => a -> a -> a
`mod` Integer
n)
n :: Integer
n = 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 = 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' = forall a. a -> Maybe a -> a
fromMaybe IV AES256
iv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
Cipher.makeIV forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (ByteString -> Int
BS.length ByteString
b forall a. Num a => a -> a -> a
- Int
aesBlockSize) ByteString
b
r :: ByteString
r = 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 = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
Cipher.cbcDecrypt AES256
aes IV AES256
iv ByteString
b
in forall a. a -> Maybe a -> a
fromMaybe ByteString
r (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 :: 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)
onNextChunk IV AES256 -> ByteString -> ByteString
onLastChunk =
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
Conduit.chunksOfCE Int
aesBlockSize forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| IV AES256
-> Maybe ByteString -> ConduitT ByteString ByteString m ()
goChunk IV AES256
iv0 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' <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
Conduit.await
case Maybe ByteString
carry' of
Maybe ByteString
Nothing -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
Conduit.yield 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
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 =
forall (m :: * -> *).
MonadRandom m =>
PublicKey -> ByteString -> m (Either Error ByteString)
RSA.encrypt (KeyPair -> PublicKey
toPublicKey KeyPair
k)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
MonadIO m =>
Either EncryptionError a -> m a
hoistEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall (m :: * -> *).
MonadRandom m =>
PrivateKey -> ByteString -> m (Either Error ByteString)
RSA.decryptSafer (KeyPair -> PrivateKey
toPrivateKey KeyPair
k)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
MonadIO m =>
Either EncryptionError a -> m a
hoistEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
(MonadIO m, ByteArray a, Cipher b) =>
a -> m b
createCipher =
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
Crypto.Error.onCryptoFailure (forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> EncryptionError
CipherFailure) forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
Cipher.cipherInit
createIV :: (MonadIO m, BlockCipher a) => ByteString -> m (Cipher.IV a)
createIV :: forall (m :: * -> *) a.
(MonadIO m, BlockCipher a) =>
ByteString -> m (IV a)
createIV ByteString
b = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO forall a b. (a -> b) -> a -> b
$ ByteString -> EncryptionError
IVInvalid (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
b)) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
Cipher.makeIV ByteString
b)
plaintext :: MonadIO m => KMS.DecryptResponse -> m ByteString
plaintext :: forall (m :: * -> *). MonadIO m => DecryptResponse -> m ByteString
plaintext DecryptResponse
rs =
case DecryptResponse
rs forall s a. s -> Getting a s a -> a
^. Lens' DecryptResponse (Maybe ByteString)
KMS.decryptResponse_plaintext of
Maybe ByteString
Nothing -> forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO EncryptionError
PlaintextUnavailable
Just ByteString
x -> 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 .& :: forall (m :: * -> *) a.
(MonadIO m, FromText a) =>
[(CI Text, Text)] -> CI Text -> m a
.& CI Text
k =
case CI Text
k forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(CI Text, Text)]
xs of
Maybe Text
Nothing -> forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO (CI Text -> EncryptionError
EnvelopeMissing CI Text
k)
Just Text
x -> forall (m :: * -> *) a.
MonadIO m =>
Either EncryptionError a -> m a
hoistEither (CI Text -> String -> EncryptionError
EnvelopeInvalid CI Text
k forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
`first` forall a. FromText a => Text -> Either String a
fromText Text
x)
hoistEither :: MonadIO m => Either EncryptionError a -> m a
hoistEither :: forall (m :: * -> *) a.
MonadIO m =>
Either EncryptionError a -> m a
hoistEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure
throwIO :: MonadIO m => EncryptionError -> m a
throwIO :: forall (m :: * -> *) a. MonadIO m => EncryptionError -> m a
throwIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
Exception.throwIO