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

import qualified Amazonka as AWS
import Amazonka.Core
import Amazonka.Prelude
import qualified Amazonka.Response as Response
import qualified Amazonka.S3 as S3
import Amazonka.S3.Encryption.Envelope
import Amazonka.S3.Encryption.Types
import qualified Amazonka.S3.Lens as S3
import Control.Arrow ((&&&))
import Control.Lens ((%~))
import qualified Control.Lens as Lens
import qualified Data.Aeson.Types as Aeson

newtype Instructions = Instructions
  { Instructions
-> forall (m :: * -> *).
   MonadResource m =>
   Key -> Env -> m Envelope
runInstructions :: forall m. MonadResource m => Key -> AWS.Env -> m Envelope
  }

class AWSRequest a => AddInstructions a where
  -- | Determine the bucket and key an instructions file is adjacent to.
  addInstructions :: a -> (S3.BucketName, S3.ObjectKey)

instance AddInstructions S3.PutObject where
  addInstructions :: PutObject -> (BucketName, ObjectKey)
addInstructions =
    Getting BucketName PutObject BucketName -> PutObject -> BucketName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting BucketName PutObject BucketName
Lens' PutObject BucketName
S3.putObject_bucket
      (PutObject -> BucketName)
-> (PutObject -> ObjectKey) -> PutObject -> (BucketName, ObjectKey)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting ObjectKey PutObject ObjectKey -> PutObject -> ObjectKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting ObjectKey PutObject ObjectKey
Lens' PutObject ObjectKey
S3.putObject_key

instance AddInstructions S3.GetObject where
  addInstructions :: GetObject -> (BucketName, ObjectKey)
addInstructions =
    Getting BucketName GetObject BucketName -> GetObject -> BucketName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting BucketName GetObject BucketName
Lens' GetObject BucketName
S3.getObject_bucket
      (GetObject -> BucketName)
-> (GetObject -> ObjectKey) -> GetObject -> (BucketName, ObjectKey)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting ObjectKey GetObject ObjectKey -> GetObject -> ObjectKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting ObjectKey GetObject ObjectKey
Lens' GetObject ObjectKey
S3.getObject_key

instance AddInstructions S3.CreateMultipartUpload where
  addInstructions :: CreateMultipartUpload -> (BucketName, ObjectKey)
addInstructions =
    Getting BucketName CreateMultipartUpload BucketName
-> CreateMultipartUpload -> BucketName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting BucketName CreateMultipartUpload BucketName
Lens' CreateMultipartUpload BucketName
S3.createMultipartUpload_bucket
      (CreateMultipartUpload -> BucketName)
-> (CreateMultipartUpload -> ObjectKey)
-> CreateMultipartUpload
-> (BucketName, ObjectKey)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting ObjectKey CreateMultipartUpload ObjectKey
-> CreateMultipartUpload -> ObjectKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting ObjectKey CreateMultipartUpload ObjectKey
Lens' CreateMultipartUpload ObjectKey
S3.createMultipartUpload_key

instance AddInstructions S3.UploadPart where
  addInstructions :: UploadPart -> (BucketName, ObjectKey)
addInstructions =
    Getting BucketName UploadPart BucketName
-> UploadPart -> BucketName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting BucketName UploadPart BucketName
Lens' UploadPart BucketName
S3.uploadPart_bucket
      (UploadPart -> BucketName)
-> (UploadPart -> ObjectKey)
-> UploadPart
-> (BucketName, ObjectKey)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting ObjectKey UploadPart ObjectKey -> UploadPart -> ObjectKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting ObjectKey UploadPart ObjectKey
Lens' UploadPart ObjectKey
S3.uploadPart_key

data PutInstructions = PutInstructions
  { PutInstructions -> Ext
_piExt :: Ext,
    PutInstructions -> PutObject
_piPut :: S3.PutObject
  }
  deriving stock (Int -> PutInstructions -> ShowS
[PutInstructions] -> ShowS
PutInstructions -> String
(Int -> PutInstructions -> ShowS)
-> (PutInstructions -> String)
-> ([PutInstructions] -> ShowS)
-> Show PutInstructions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutInstructions] -> ShowS
$cshowList :: [PutInstructions] -> ShowS
show :: PutInstructions -> String
$cshow :: PutInstructions -> String
showsPrec :: Int -> PutInstructions -> ShowS
$cshowsPrec :: Int -> PutInstructions -> ShowS
Show)

putInstructions :: AddInstructions a => a -> Envelope -> PutInstructions
putInstructions :: a -> Envelope -> PutInstructions
putInstructions (a -> (BucketName, ObjectKey)
forall a. AddInstructions a => a -> (BucketName, ObjectKey)
addInstructions -> (BucketName
b, ObjectKey
k)) =
  Ext -> PutObject -> PutInstructions
PutInstructions Ext
defaultExtension (PutObject -> PutInstructions)
-> (Envelope -> PutObject) -> Envelope -> PutInstructions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BucketName -> ObjectKey -> RequestBody -> PutObject
S3.newPutObject BucketName
b ObjectKey
k (RequestBody -> PutObject)
-> (Envelope -> RequestBody) -> Envelope -> PutObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope -> RequestBody
forall a. ToBody a => a -> RequestBody
toBody

piExtension :: Lens' PutInstructions Ext
piExtension :: (Ext -> f Ext) -> PutInstructions -> f PutInstructions
piExtension = (PutInstructions -> Ext)
-> (PutInstructions -> Ext -> PutInstructions)
-> Lens PutInstructions PutInstructions Ext Ext
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens PutInstructions -> Ext
_piExt (\PutInstructions
s Ext
a -> PutInstructions
s {_piExt :: Ext
_piExt = Ext
a})

instance AWSRequest PutInstructions where
  type AWSResponse PutInstructions = S3.PutObjectResponse

  request :: PutInstructions -> Request PutInstructions
request PutInstructions
x =
    Request PutObject -> Request PutInstructions
coerce (Request PutObject -> Request PutInstructions)
-> (PutObject -> Request PutObject)
-> PutObject
-> Request PutInstructions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutObject -> Request PutObject
forall a. AWSRequest a => a -> Request a
request (PutObject -> Request PutInstructions)
-> PutObject -> Request PutInstructions
forall a b. (a -> b) -> a -> b
$
      PutInstructions -> PutObject
_piPut PutInstructions
x PutObject -> (PutObject -> PutObject) -> PutObject
forall a b. a -> (a -> b) -> b
& (ObjectKey -> Identity ObjectKey)
-> PutObject -> Identity PutObject
Lens' PutObject ObjectKey
S3.putObject_key ((ObjectKey -> Identity ObjectKey)
 -> PutObject -> Identity PutObject)
-> (ObjectKey -> ObjectKey) -> PutObject -> PutObject
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ext -> ObjectKey -> ObjectKey
appendExtension (PutInstructions -> Ext
_piExt PutInstructions
x)

  response :: Logger
-> Service
-> Proxy PutInstructions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutInstructions)))
response Logger
s Service
l Proxy PutInstructions
_ = Logger
-> Service
-> Proxy PutObject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutObject)))
forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
Logger
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
response Logger
s Service
l (Proxy PutObject
forall k (t :: k). Proxy t
Proxy :: Proxy S3.PutObject)

data GetInstructions = GetInstructions
  { GetInstructions -> Ext
_giExt :: Ext,
    GetInstructions -> GetObject
_giGet :: S3.GetObject
  }
  deriving stock (Int -> GetInstructions -> ShowS
[GetInstructions] -> ShowS
GetInstructions -> String
(Int -> GetInstructions -> ShowS)
-> (GetInstructions -> String)
-> ([GetInstructions] -> ShowS)
-> Show GetInstructions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetInstructions] -> ShowS
$cshowList :: [GetInstructions] -> ShowS
show :: GetInstructions -> String
$cshow :: GetInstructions -> String
showsPrec :: Int -> GetInstructions -> ShowS
$cshowsPrec :: Int -> GetInstructions -> ShowS
Show)

getInstructions :: AddInstructions a => a -> GetInstructions
getInstructions :: a -> GetInstructions
getInstructions =
  Ext -> GetObject -> GetInstructions
GetInstructions Ext
defaultExtension
    (GetObject -> GetInstructions)
-> (a -> GetObject) -> a -> GetInstructions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BucketName -> ObjectKey -> GetObject)
-> (BucketName, ObjectKey) -> GetObject
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BucketName -> ObjectKey -> GetObject
S3.newGetObject
    ((BucketName, ObjectKey) -> GetObject)
-> (a -> (BucketName, ObjectKey)) -> a -> GetObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (BucketName, ObjectKey)
forall a. AddInstructions a => a -> (BucketName, ObjectKey)
addInstructions

giExtension :: Lens' GetInstructions Ext
giExtension :: (Ext -> f Ext) -> GetInstructions -> f GetInstructions
giExtension = (GetInstructions -> Ext)
-> (GetInstructions -> Ext -> GetInstructions)
-> Lens GetInstructions GetInstructions Ext Ext
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens GetInstructions -> Ext
_giExt (\GetInstructions
s Ext
a -> GetInstructions
s {_giExt :: Ext
_giExt = Ext
a})

instance AWSRequest GetInstructions where
  type AWSResponse GetInstructions = Instructions

  request :: GetInstructions -> Request GetInstructions
request GetInstructions
x =
    Request GetObject -> Request GetInstructions
coerce (Request GetObject -> Request GetInstructions)
-> (GetObject -> Request GetObject)
-> GetObject
-> Request GetInstructions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetObject -> Request GetObject
forall a. AWSRequest a => a -> Request a
request (GetObject -> Request GetInstructions)
-> GetObject -> Request GetInstructions
forall a b. (a -> b) -> a -> b
$
      GetInstructions -> GetObject
_giGet GetInstructions
x GetObject -> (GetObject -> GetObject) -> GetObject
forall a b. a -> (a -> b) -> b
& (ObjectKey -> Identity ObjectKey)
-> GetObject -> Identity GetObject
Lens' GetObject ObjectKey
S3.getObject_key ((ObjectKey -> Identity ObjectKey)
 -> GetObject -> Identity GetObject)
-> (ObjectKey -> ObjectKey) -> GetObject -> GetObject
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ext -> ObjectKey -> ObjectKey
appendExtension (GetInstructions -> Ext
_giExt GetInstructions
x)

  response :: Logger
-> Service
-> Proxy GetInstructions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetInstructions)))
response =
    (Int
 -> ResponseHeaders
 -> Object
 -> Either String (AWSResponse GetInstructions))
-> Logger
-> Service
-> Proxy GetInstructions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetInstructions)))
forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> Logger
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON ((Int
  -> ResponseHeaders
  -> Object
  -> Either String (AWSResponse GetInstructions))
 -> Logger
 -> Service
 -> Proxy GetInstructions
 -> ClientResponse ClientBody
 -> m (Either Error (ClientResponse (AWSResponse GetInstructions))))
-> (Int
    -> ResponseHeaders
    -> Object
    -> Either String (AWSResponse GetInstructions))
-> Logger
-> Service
-> Proxy GetInstructions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetInstructions)))
forall a b. (a -> b) -> a -> b
$ \Int
_ ResponseHeaders
_ Object
o -> do
      HashMap Text Text
e <- (Value -> Parser (HashMap Text Text))
-> Value -> Either String (HashMap Text Text)
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser (HashMap Text Text)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
      Instructions -> Either String Instructions
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instructions -> Either String Instructions)
-> Instructions -> Either String Instructions
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *). MonadResource m => Key -> Env -> m Envelope)
-> Instructions
Instructions ((forall (m :: * -> *).
  MonadResource m =>
  Key -> Env -> m Envelope)
 -> Instructions)
-> (forall (m :: * -> *).
    MonadResource m =>
    Key -> Env -> m Envelope)
-> Instructions
forall a b. (a -> b) -> a -> b
$ \Key
key Env
env -> Key -> Env -> HashMap Text Text -> m Envelope
forall (m :: * -> *).
MonadResource m =>
Key -> Env -> HashMap Text Text -> m Envelope
fromMetadata Key
key Env
env HashMap Text Text
e

class AWSRequest a => RemoveInstructions a where
  -- | Determine the bucket and key an instructions file is adjacent to.
  removeInstructions :: a -> (S3.BucketName, S3.ObjectKey)

instance RemoveInstructions S3.AbortMultipartUpload where
  removeInstructions :: AbortMultipartUpload -> (BucketName, ObjectKey)
removeInstructions =
    Getting BucketName AbortMultipartUpload BucketName
-> AbortMultipartUpload -> BucketName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting BucketName AbortMultipartUpload BucketName
Lens' AbortMultipartUpload BucketName
S3.abortMultipartUpload_bucket
      (AbortMultipartUpload -> BucketName)
-> (AbortMultipartUpload -> ObjectKey)
-> AbortMultipartUpload
-> (BucketName, ObjectKey)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting ObjectKey AbortMultipartUpload ObjectKey
-> AbortMultipartUpload -> ObjectKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting ObjectKey AbortMultipartUpload ObjectKey
Lens' AbortMultipartUpload ObjectKey
S3.abortMultipartUpload_key

instance RemoveInstructions S3.DeleteObject where
  removeInstructions :: DeleteObject -> (BucketName, ObjectKey)
removeInstructions =
    Getting BucketName DeleteObject BucketName
-> DeleteObject -> BucketName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting BucketName DeleteObject BucketName
Lens' DeleteObject BucketName
S3.deleteObject_bucket
      (DeleteObject -> BucketName)
-> (DeleteObject -> ObjectKey)
-> DeleteObject
-> (BucketName, ObjectKey)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting ObjectKey DeleteObject ObjectKey
-> DeleteObject -> ObjectKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting ObjectKey DeleteObject ObjectKey
Lens' DeleteObject ObjectKey
S3.deleteObject_key

data DeleteInstructions = DeleteInstructions
  { DeleteInstructions -> Ext
_diExt :: Ext,
    DeleteInstructions -> DeleteObject
_diDelete :: S3.DeleteObject
  }
  deriving stock (Int -> DeleteInstructions -> ShowS
[DeleteInstructions] -> ShowS
DeleteInstructions -> String
(Int -> DeleteInstructions -> ShowS)
-> (DeleteInstructions -> String)
-> ([DeleteInstructions] -> ShowS)
-> Show DeleteInstructions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInstructions] -> ShowS
$cshowList :: [DeleteInstructions] -> ShowS
show :: DeleteInstructions -> String
$cshow :: DeleteInstructions -> String
showsPrec :: Int -> DeleteInstructions -> ShowS
$cshowsPrec :: Int -> DeleteInstructions -> ShowS
Show)

deleteInstructions :: RemoveInstructions a => a -> DeleteInstructions
deleteInstructions :: a -> DeleteInstructions
deleteInstructions =
  Ext -> DeleteObject -> DeleteInstructions
DeleteInstructions Ext
defaultExtension
    (DeleteObject -> DeleteInstructions)
-> (a -> DeleteObject) -> a -> DeleteInstructions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BucketName -> ObjectKey -> DeleteObject)
-> (BucketName, ObjectKey) -> DeleteObject
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BucketName -> ObjectKey -> DeleteObject
S3.newDeleteObject
    ((BucketName, ObjectKey) -> DeleteObject)
-> (a -> (BucketName, ObjectKey)) -> a -> DeleteObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (BucketName, ObjectKey)
forall a. RemoveInstructions a => a -> (BucketName, ObjectKey)
removeInstructions

diExtension :: Lens' DeleteInstructions Ext
diExtension :: (Ext -> f Ext) -> DeleteInstructions -> f DeleteInstructions
diExtension = (DeleteInstructions -> Ext)
-> (DeleteInstructions -> Ext -> DeleteInstructions)
-> Lens DeleteInstructions DeleteInstructions Ext Ext
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens DeleteInstructions -> Ext
_diExt (\DeleteInstructions
s Ext
a -> DeleteInstructions
s {_diExt :: Ext
_diExt = Ext
a})

instance AWSRequest DeleteInstructions where
  type AWSResponse DeleteInstructions = S3.DeleteObjectResponse

  request :: DeleteInstructions -> Request DeleteInstructions
request DeleteInstructions
x =
    Request DeleteObject -> Request DeleteInstructions
coerce (Request DeleteObject -> Request DeleteInstructions)
-> (DeleteObject -> Request DeleteObject)
-> DeleteObject
-> Request DeleteInstructions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeleteObject -> Request DeleteObject
forall a. AWSRequest a => a -> Request a
request (DeleteObject -> Request DeleteInstructions)
-> DeleteObject -> Request DeleteInstructions
forall a b. (a -> b) -> a -> b
$
      DeleteInstructions -> DeleteObject
_diDelete DeleteInstructions
x DeleteObject -> (DeleteObject -> DeleteObject) -> DeleteObject
forall a b. a -> (a -> b) -> b
& (ObjectKey -> Identity ObjectKey)
-> DeleteObject -> Identity DeleteObject
Lens' DeleteObject ObjectKey
S3.deleteObject_key ((ObjectKey -> Identity ObjectKey)
 -> DeleteObject -> Identity DeleteObject)
-> (ObjectKey -> ObjectKey) -> DeleteObject -> DeleteObject
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ext -> ObjectKey -> ObjectKey
appendExtension (DeleteInstructions -> Ext
_diExt DeleteInstructions
x)

  response :: Logger
-> Service
-> Proxy DeleteInstructions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteInstructions)))
response Logger
s Service
l Proxy DeleteInstructions
_ = Logger
-> Service
-> Proxy DeleteObject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteObject)))
forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
Logger
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
response Logger
s Service
l (Proxy DeleteObject
forall k (t :: k). Proxy t
Proxy :: Proxy S3.DeleteObject)