{-# LANGUAGE DuplicateRecordFields #-}

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

import qualified Amazonka as AWS
import Amazonka.Core
import Amazonka.Data
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 :: forall (m :: * -> *) a.
(MonadResource m, ToEncrypted a) =>
Key -> Env -> a -> m (Encrypted a, PutInstructions)
encrypted Key
key Env
env a
x = do
  Envelope
e <- forall (m :: * -> *). MonadResource m => Key -> Env -> m Envelope
newEnvelope Key
key Env
env

  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( forall a. ToEncrypted a => a -> Location -> Envelope -> Encrypted a
encryptWith a
x Location
Discard Envelope
e,
      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 = forall a. ToEncrypted a => a -> Location -> Envelope -> Encrypted a
encryptWith UploadPart
x Location
Discard (forall a. Encrypted a -> Envelope
envelope Encrypted CreateMultipartUpload
e)

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

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

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

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

  request :: (Service -> Service) -> Encrypted a -> Request (Encrypted a)
request Service -> Service
overrides (Encrypted a
x [Header]
xs Location
l Envelope
e) =
    coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request Service -> Service
overrides a
x) forall a b. a -> (a -> b) -> b
& forall x. Request x -> Request x
updateBodyAndHeaders
    where
      updateBodyAndHeaders :: Request x -> Request x
      updateBodyAndHeaders :: forall x. Request x -> Request x
updateBodyAndHeaders rq :: Request x
rq@Request {RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body :: RequestBody
body, [Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers :: [Header]
headers} =
        Request x
rq
          { $sel:body:Request :: RequestBody
body = RequestBody -> RequestBody
f RequestBody
body,
            $sel:headers:Request :: [Header]
headers = [Header]
headers forall a. Semigroup a => a -> a -> a
<> [Header]
hs
          }

      f :: RequestBody -> RequestBody
f RequestBody
b
        | RequestBody -> Integer
contentLength RequestBody
b 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 forall a. Eq a => a -> a -> Bool
== Location
Metadata = [Header]
xs forall a. Semigroup a => a -> a -> a
<> forall a. ToHeaders a => a -> [Header]
toHeaders Envelope
e
        | Bool
otherwise = [Header]
xs

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

proxy :: forall a. Proxy (Encrypted a) -> Proxy a
proxy :: forall a. Proxy (Encrypted a) -> Proxy a
proxy = forall a b. a -> b -> a
const 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 = 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 = forall a. a -> [Header] -> Location -> Envelope -> Encrypted a
Encrypted PutObject
x (Header
len forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe Header
md5)
    where
      len :: Header
len = (HeaderName
"X-Amz-Unencrypted-Content-Length", forall a. ToByteString a => a -> ByteString
toBS (RequestBody -> Integer
contentLength RequestBody
body))
      md5 :: Maybe Header
md5 = (HeaderName
"X-Amz-Unencrypted-Content-MD5",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestBody -> Maybe ByteString
md5Base64 RequestBody
body

      body :: RequestBody
body = PutObject
x forall s a. s -> Getting a s a -> a
^. 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 = forall a. a -> [Header] -> Location -> Envelope -> Encrypted a
Encrypted UploadPart
x (Header
len forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe Header
md5)
    where
      len :: Header
len = (HeaderName
"X-Amz-Unencrypted-Content-Length", forall a. ToByteString a => a -> ByteString
toBS (RequestBody -> Integer
contentLength RequestBody
body))
      md5 :: Maybe Header
md5 = (HeaderName
"X-Amz-Unencrypted-Content-MD5",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestBody -> Maybe ByteString
md5Base64 RequestBody
body

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