-- |
-- Module      : Amazonka.S3.Encryption.Instructions
-- 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.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 =
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Lens' PutObject BucketName
S3.putObject_bucket
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Lens' PutObject ObjectKey
S3.putObject_key

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

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

instance AddInstructions S3.UploadPart where
  addInstructions :: UploadPart -> (BucketName, ObjectKey)
addInstructions =
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Lens' UploadPart BucketName
S3.uploadPart_bucket
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view 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
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 :: forall a. AddInstructions a => a -> Envelope -> PutInstructions
putInstructions (forall a. AddInstructions a => a -> (BucketName, ObjectKey)
addInstructions -> (BucketName
b, ObjectKey
k)) =
  Ext -> PutObject -> PutInstructions
PutInstructions Ext
defaultExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. BucketName -> ObjectKey -> RequestBody -> PutObject
S3.newPutObject BucketName
b ObjectKey
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToBody a => a -> RequestBody
toBody

piExtension :: Lens' PutInstructions Ext
piExtension :: Lens' PutInstructions Ext
piExtension = 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 :: (Service -> Service) -> PutInstructions -> Request PutInstructions
request Service -> Service
overrides PutInstructions
x =
    coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request Service -> Service
overrides forall a b. (a -> b) -> a -> b
$
      PutInstructions -> PutObject
_piPut PutInstructions
x forall a b. a -> (a -> b) -> b
& Lens' PutObject ObjectKey
S3.putObject_key forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ext -> ObjectKey -> ObjectKey
appendExtension (PutInstructions -> Ext
_piExt PutInstructions
x)

  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutInstructions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutInstructions)))
response ByteStringLazy -> IO ByteStringLazy
s Service
l Proxy PutInstructions
_ = 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
s Service
l (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
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 :: forall a. AddInstructions a => a -> GetInstructions
getInstructions =
  Ext -> GetObject -> GetInstructions
GetInstructions Ext
defaultExtension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BucketName -> ObjectKey -> GetObject
S3.newGetObject
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AddInstructions a => a -> (BucketName, ObjectKey)
addInstructions

giExtension :: Lens' GetInstructions Ext
giExtension :: Lens' GetInstructions Ext
giExtension = 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 :: (Service -> Service) -> GetInstructions -> Request GetInstructions
request Service -> Service
overrides GetInstructions
x =
    coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request Service -> Service
overrides forall a b. (a -> b) -> a -> b
$
      GetInstructions -> GetObject
_giGet GetInstructions
x forall a b. a -> (a -> b) -> b
& Lens' GetObject ObjectKey
S3.getObject_key forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ext -> ObjectKey -> ObjectKey
appendExtension (GetInstructions -> Ext
_giExt GetInstructions
x)

  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetInstructions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetInstructions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON forall a b. (a -> b) -> a -> b
$ \Int
_ ResponseHeaders
_ Object
o -> do
      HashMap Text Text
e <- forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *). MonadResource m => Key -> Env -> m Envelope)
-> Instructions
Instructions forall a b. (a -> b) -> a -> b
$ \Key
key Env
env -> 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 =
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Lens' AbortMultipartUpload BucketName
S3.abortMultipartUpload_bucket
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Lens' AbortMultipartUpload ObjectKey
S3.abortMultipartUpload_key

instance RemoveInstructions S3.DeleteObject where
  removeInstructions :: DeleteObject -> (BucketName, ObjectKey)
removeInstructions =
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Lens' DeleteObject BucketName
S3.deleteObject_bucket
      forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view 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
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 :: forall a. RemoveInstructions a => a -> DeleteInstructions
deleteInstructions =
  Ext -> DeleteObject -> DeleteInstructions
DeleteInstructions Ext
defaultExtension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BucketName -> ObjectKey -> DeleteObject
S3.newDeleteObject
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RemoveInstructions a => a -> (BucketName, ObjectKey)
removeInstructions

diExtension :: Lens' DeleteInstructions Ext
diExtension :: Lens' DeleteInstructions Ext
diExtension = 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 :: (Service -> Service)
-> DeleteInstructions -> Request DeleteInstructions
request Service -> Service
overrides DeleteInstructions
x =
    coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request Service -> Service
overrides forall a b. (a -> b) -> a -> b
$
      DeleteInstructions -> DeleteObject
_diDelete DeleteInstructions
x forall a b. a -> (a -> b) -> b
& Lens' DeleteObject ObjectKey
S3.deleteObject_key forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ext -> ObjectKey -> ObjectKey
appendExtension (DeleteInstructions -> Ext
_diExt DeleteInstructions
x)

  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteInstructions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteInstructions)))
response ByteStringLazy -> IO ByteStringLazy
s Service
l Proxy DeleteInstructions
_ = 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
s Service
l (forall {k} (t :: k). Proxy t
Proxy :: Proxy S3.DeleteObject)