-- |
-- Module      : Amazonka.S3.Encryption.Encrypt
-- 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.Encrypt where

import qualified Amazonka as AWS
import Amazonka.Core
import Amazonka.Prelude
import qualified Amazonka.S3 as S3
import Amazonka.S3.Encryption.Envelope
import Amazonka.S3.Encryption.Instructions
import Amazonka.S3.Encryption.Types
import qualified Amazonka.S3.Lens as S3
import Control.Lens ((%~), (<>~), (^.))
import qualified Control.Lens as Lens

-- FIXME: Material

-- | Note about how it doesn't attach metadata by default.
-- You can re-set the location and then discard the PutInstructions request.
encrypted ::
  (MonadResource m, ToEncrypted a) =>
  Key ->
  AWS.Env ->
  a ->
  m (Encrypted a, PutInstructions)
encrypted :: Key -> Env -> a -> m (Encrypted a, PutInstructions)
encrypted Key
key Env
env a
x = do
  Envelope
e <- Key -> Env -> m Envelope
forall (m :: * -> *). MonadResource m => Key -> Env -> m Envelope
newEnvelope Key
key Env
env

  (Encrypted a, PutInstructions) -> m (Encrypted a, PutInstructions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( a -> Location -> Envelope -> Encrypted a
forall a. ToEncrypted a => a -> Location -> Envelope -> Encrypted a
encryptWith a
x Location
Discard Envelope
e,
      a -> Envelope -> PutInstructions
forall a. AddInstructions a => a -> Envelope -> PutInstructions
putInstructions a
x Envelope
e
    )

encryptPart ::
  Encrypted S3.CreateMultipartUpload ->
  S3.UploadPart ->
  Encrypted S3.UploadPart
encryptPart :: Encrypted CreateMultipartUpload
-> UploadPart -> Encrypted UploadPart
encryptPart Encrypted CreateMultipartUpload
e UploadPart
x = UploadPart -> Location -> Envelope -> Encrypted UploadPart
forall a. ToEncrypted a => a -> Location -> Envelope -> Encrypted a
encryptWith UploadPart
x Location
Discard (Encrypted CreateMultipartUpload -> Envelope
forall a. Encrypted a -> Envelope
envelope Encrypted CreateMultipartUpload
e)

data Encrypted a = Encrypted
  { Encrypted a -> a
_encPayload :: a,
    Encrypted a -> [Header]
_encHeaders :: [Header],
    Encrypted a -> Location
_encLocation :: Location,
    Encrypted a -> Envelope
_encEnvelope :: Envelope
  }

location :: Setter' (Encrypted a) Location
location :: (Location -> f Location) -> Encrypted a -> f (Encrypted a)
location = (Encrypted a -> Location)
-> (Encrypted a -> Location -> Encrypted a)
-> Lens (Encrypted a) (Encrypted a) Location Location
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Encrypted a -> Location
forall a. Encrypted a -> Location
_encLocation (\Encrypted a
s Location
a -> Encrypted a
s {_encLocation :: Location
_encLocation = Location
a})

envelope :: Encrypted a -> Envelope
envelope :: Encrypted a -> Envelope
envelope = Encrypted a -> Envelope
forall a. Encrypted a -> Envelope
_encEnvelope

instance AWSRequest a => AWSRequest (Encrypted a) where
  type AWSResponse (Encrypted a) = AWSResponse a

  request :: Encrypted a -> Request (Encrypted a)
request (Encrypted a
x [Header]
xs Location
l Envelope
e) =
    Request a -> Request (Encrypted a)
coerce (a -> Request a
forall a. AWSRequest a => a -> Request a
request a
x)
      Request (Encrypted a)
-> (Request (Encrypted a) -> Request (Encrypted a))
-> Request (Encrypted a)
forall a b. a -> (a -> b) -> b
& (RequestBody -> Identity RequestBody)
-> Request (Encrypted a) -> Identity (Request (Encrypted a))
forall a. Lens' (Request a) RequestBody
requestBody ((RequestBody -> Identity RequestBody)
 -> Request (Encrypted a) -> Identity (Request (Encrypted a)))
-> (RequestBody -> RequestBody)
-> Request (Encrypted a)
-> Request (Encrypted a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RequestBody -> RequestBody
f
      Request (Encrypted a)
-> (Request (Encrypted a) -> Request (Encrypted a))
-> Request (Encrypted a)
forall a b. a -> (a -> b) -> b
& ([Header] -> Identity [Header])
-> Request (Encrypted a) -> Identity (Request (Encrypted a))
forall a. Lens' (Request a) [Header]
requestHeaders (([Header] -> Identity [Header])
 -> Request (Encrypted a) -> Identity (Request (Encrypted a)))
-> [Header] -> Request (Encrypted a) -> Request (Encrypted a)
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Header]
hs
    where
      f :: RequestBody -> RequestBody
f RequestBody
b
        | RequestBody -> Integer
contentLength RequestBody
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = Envelope -> RequestBody -> RequestBody
bodyEncrypt Envelope
e RequestBody
b
        | Bool
otherwise = RequestBody
b

      hs :: [Header]
hs
        | Location
l Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
== Location
Metadata = [Header]
xs [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> Envelope -> [Header]
forall a. ToHeaders a => a -> [Header]
toHeaders Envelope
e
        | Bool
otherwise = [Header]
xs

  response :: Logger
-> Service
-> Proxy (Encrypted a)
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse (Encrypted a))))
response Logger
l Service
s Proxy (Encrypted a)
p =
    Logger
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
Logger
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
response Logger
l Service
s (Proxy (Encrypted a) -> Proxy a
forall a. Proxy (Encrypted a) -> Proxy a
proxy Proxy (Encrypted a)
p)

proxy :: forall a. Proxy (Encrypted a) -> Proxy a
proxy :: Proxy (Encrypted a) -> Proxy a
proxy = Proxy a -> Proxy (Encrypted a) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy

class AddInstructions a => ToEncrypted a where
  -- | Create an encryption context.
  encryptWith :: a -> Location -> Envelope -> Encrypted a

instance ToEncrypted S3.CreateMultipartUpload where
  encryptWith :: CreateMultipartUpload
-> Location -> Envelope -> Encrypted CreateMultipartUpload
encryptWith CreateMultipartUpload
x = CreateMultipartUpload
-> [Header]
-> Location
-> Envelope
-> Encrypted CreateMultipartUpload
forall a. a -> [Header] -> Location -> Envelope -> Encrypted a
Encrypted CreateMultipartUpload
x []

instance ToEncrypted S3.PutObject where
  encryptWith :: PutObject -> Location -> Envelope -> Encrypted PutObject
encryptWith PutObject
x = PutObject
-> [Header] -> Location -> Envelope -> Encrypted PutObject
forall a. a -> [Header] -> Location -> Envelope -> Encrypted a
Encrypted PutObject
x (Header
len Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: Maybe Header -> [Header]
forall a. Maybe a -> [a]
maybeToList Maybe Header
md5)
    where
      len :: Header
len = (HeaderName
"X-Amz-Unencrypted-Content-Length", Integer -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (RequestBody -> Integer
contentLength RequestBody
body))
      md5 :: Maybe Header
md5 = (HeaderName
"X-Amz-Unencrypted-Content-MD5",) (ByteString -> Header) -> Maybe ByteString -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestBody -> Maybe ByteString
md5Base64 RequestBody
body

      body :: RequestBody
body = PutObject
x PutObject
-> Getting RequestBody PutObject RequestBody -> RequestBody
forall s a. s -> Getting a s a -> a
^. Getting RequestBody PutObject RequestBody
Lens' PutObject RequestBody
S3.putObject_body

-- FIXME: verify these additional headers.
instance ToEncrypted S3.UploadPart where
  encryptWith :: UploadPart -> Location -> Envelope -> Encrypted UploadPart
encryptWith UploadPart
x = UploadPart
-> [Header] -> Location -> Envelope -> Encrypted UploadPart
forall a. a -> [Header] -> Location -> Envelope -> Encrypted a
Encrypted UploadPart
x (Header
len Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: Maybe Header -> [Header]
forall a. Maybe a -> [a]
maybeToList Maybe Header
md5)
    where
      len :: Header
len = (HeaderName
"X-Amz-Unencrypted-Content-Length", Integer -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (RequestBody -> Integer
contentLength RequestBody
body))
      md5 :: Maybe Header
md5 = (HeaderName
"X-Amz-Unencrypted-Content-MD5",) (ByteString -> Header) -> Maybe ByteString -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestBody -> Maybe ByteString
md5Base64 RequestBody
body

      body :: RequestBody
body = UploadPart
x UploadPart
-> Getting RequestBody UploadPart RequestBody -> RequestBody
forall s a. s -> Getting a s a -> a
^. Getting RequestBody UploadPart RequestBody
Lens' UploadPart RequestBody
S3.uploadPart_body