{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.S3.PutObjectLockConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Places an Object Lock configuration on the specified bucket. The rule
-- specified in the Object Lock configuration will be applied by default to
-- every new object placed in the specified bucket. For more information,
-- see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/object-lock.html Locking Objects>.
--
-- -   The @DefaultRetention@ settings require both a mode and a period.
--
-- -   The @DefaultRetention@ period can be either @Days@ or @Years@ but
--     you must select one. You cannot specify @Days@ and @Years@ at the
--     same time.
--
-- -   You can only enable Object Lock for new buckets. If you want to turn
--     on Object Lock for an existing bucket, contact Amazon Web Services
--     Support.
module Amazonka.S3.PutObjectLockConfiguration
  ( -- * Creating a Request
    PutObjectLockConfiguration (..),
    newPutObjectLockConfiguration,

    -- * Request Lenses
    putObjectLockConfiguration_checksumAlgorithm,
    putObjectLockConfiguration_contentMD5,
    putObjectLockConfiguration_expectedBucketOwner,
    putObjectLockConfiguration_objectLockConfiguration,
    putObjectLockConfiguration_requestPayer,
    putObjectLockConfiguration_token,
    putObjectLockConfiguration_bucket,

    -- * Destructuring the Response
    PutObjectLockConfigurationResponse (..),
    newPutObjectLockConfigurationResponse,

    -- * Response Lenses
    putObjectLockConfigurationResponse_requestCharged,
    putObjectLockConfigurationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.S3.Types

-- | /See:/ 'newPutObjectLockConfiguration' smart constructor.
data PutObjectLockConfiguration = PutObjectLockConfiguration'
  { -- | Indicates the algorithm used to create the checksum for the object when
    -- using the SDK. This header will not provide any additional functionality
    -- if not using the SDK. When sending this header, there must be a
    -- corresponding @x-amz-checksum@ or @x-amz-trailer@ header sent.
    -- Otherwise, Amazon S3 fails the request with the HTTP status code
    -- @400 Bad Request@. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
    -- in the /Amazon S3 User Guide/.
    --
    -- If you provide an individual checksum, Amazon S3 ignores any provided
    -- @ChecksumAlgorithm@ parameter.
    PutObjectLockConfiguration -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | The MD5 hash for the request body.
    --
    -- For requests made using the Amazon Web Services Command Line Interface
    -- (CLI) or Amazon Web Services SDKs, this field is calculated
    -- automatically.
    PutObjectLockConfiguration -> Maybe Text
contentMD5 :: Prelude.Maybe Prelude.Text,
    -- | The account ID of the expected bucket owner. If the bucket is owned by a
    -- different account, the request fails with the HTTP status code
    -- @403 Forbidden@ (access denied).
    PutObjectLockConfiguration -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | The Object Lock configuration that you want to apply to the specified
    -- bucket.
    PutObjectLockConfiguration -> Maybe ObjectLockConfiguration
objectLockConfiguration :: Prelude.Maybe ObjectLockConfiguration,
    PutObjectLockConfiguration -> Maybe RequestPayer
requestPayer :: Prelude.Maybe RequestPayer,
    -- | A token to allow Object Lock to be enabled for an existing bucket.
    PutObjectLockConfiguration -> Maybe Text
token :: Prelude.Maybe Prelude.Text,
    -- | The bucket whose Object Lock configuration you want to create or
    -- replace.
    PutObjectLockConfiguration -> BucketName
bucket :: BucketName
  }
  deriving (PutObjectLockConfiguration -> PutObjectLockConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutObjectLockConfiguration -> PutObjectLockConfiguration -> Bool
$c/= :: PutObjectLockConfiguration -> PutObjectLockConfiguration -> Bool
== :: PutObjectLockConfiguration -> PutObjectLockConfiguration -> Bool
$c== :: PutObjectLockConfiguration -> PutObjectLockConfiguration -> Bool
Prelude.Eq, ReadPrec [PutObjectLockConfiguration]
ReadPrec PutObjectLockConfiguration
Int -> ReadS PutObjectLockConfiguration
ReadS [PutObjectLockConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutObjectLockConfiguration]
$creadListPrec :: ReadPrec [PutObjectLockConfiguration]
readPrec :: ReadPrec PutObjectLockConfiguration
$creadPrec :: ReadPrec PutObjectLockConfiguration
readList :: ReadS [PutObjectLockConfiguration]
$creadList :: ReadS [PutObjectLockConfiguration]
readsPrec :: Int -> ReadS PutObjectLockConfiguration
$creadsPrec :: Int -> ReadS PutObjectLockConfiguration
Prelude.Read, Int -> PutObjectLockConfiguration -> ShowS
[PutObjectLockConfiguration] -> ShowS
PutObjectLockConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutObjectLockConfiguration] -> ShowS
$cshowList :: [PutObjectLockConfiguration] -> ShowS
show :: PutObjectLockConfiguration -> String
$cshow :: PutObjectLockConfiguration -> String
showsPrec :: Int -> PutObjectLockConfiguration -> ShowS
$cshowsPrec :: Int -> PutObjectLockConfiguration -> ShowS
Prelude.Show, forall x.
Rep PutObjectLockConfiguration x -> PutObjectLockConfiguration
forall x.
PutObjectLockConfiguration -> Rep PutObjectLockConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutObjectLockConfiguration x -> PutObjectLockConfiguration
$cfrom :: forall x.
PutObjectLockConfiguration -> Rep PutObjectLockConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PutObjectLockConfiguration' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'checksumAlgorithm', 'putObjectLockConfiguration_checksumAlgorithm' - Indicates the algorithm used to create the checksum for the object when
-- using the SDK. This header will not provide any additional functionality
-- if not using the SDK. When sending this header, there must be a
-- corresponding @x-amz-checksum@ or @x-amz-trailer@ header sent.
-- Otherwise, Amazon S3 fails the request with the HTTP status code
-- @400 Bad Request@. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
-- in the /Amazon S3 User Guide/.
--
-- If you provide an individual checksum, Amazon S3 ignores any provided
-- @ChecksumAlgorithm@ parameter.
--
-- 'contentMD5', 'putObjectLockConfiguration_contentMD5' - The MD5 hash for the request body.
--
-- For requests made using the Amazon Web Services Command Line Interface
-- (CLI) or Amazon Web Services SDKs, this field is calculated
-- automatically.
--
-- 'expectedBucketOwner', 'putObjectLockConfiguration_expectedBucketOwner' - The account ID of the expected bucket owner. If the bucket is owned by a
-- different account, the request fails with the HTTP status code
-- @403 Forbidden@ (access denied).
--
-- 'objectLockConfiguration', 'putObjectLockConfiguration_objectLockConfiguration' - The Object Lock configuration that you want to apply to the specified
-- bucket.
--
-- 'requestPayer', 'putObjectLockConfiguration_requestPayer' - Undocumented member.
--
-- 'token', 'putObjectLockConfiguration_token' - A token to allow Object Lock to be enabled for an existing bucket.
--
-- 'bucket', 'putObjectLockConfiguration_bucket' - The bucket whose Object Lock configuration you want to create or
-- replace.
newPutObjectLockConfiguration ::
  -- | 'bucket'
  BucketName ->
  PutObjectLockConfiguration
newPutObjectLockConfiguration :: BucketName -> PutObjectLockConfiguration
newPutObjectLockConfiguration BucketName
pBucket_ =
  PutObjectLockConfiguration'
    { $sel:checksumAlgorithm:PutObjectLockConfiguration' :: Maybe ChecksumAlgorithm
checksumAlgorithm =
        forall a. Maybe a
Prelude.Nothing,
      $sel:contentMD5:PutObjectLockConfiguration' :: Maybe Text
contentMD5 = forall a. Maybe a
Prelude.Nothing,
      $sel:expectedBucketOwner:PutObjectLockConfiguration' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:objectLockConfiguration:PutObjectLockConfiguration' :: Maybe ObjectLockConfiguration
objectLockConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:requestPayer:PutObjectLockConfiguration' :: Maybe RequestPayer
requestPayer = forall a. Maybe a
Prelude.Nothing,
      $sel:token:PutObjectLockConfiguration' :: Maybe Text
token = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:PutObjectLockConfiguration' :: BucketName
bucket = BucketName
pBucket_
    }

-- | Indicates the algorithm used to create the checksum for the object when
-- using the SDK. This header will not provide any additional functionality
-- if not using the SDK. When sending this header, there must be a
-- corresponding @x-amz-checksum@ or @x-amz-trailer@ header sent.
-- Otherwise, Amazon S3 fails the request with the HTTP status code
-- @400 Bad Request@. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
-- in the /Amazon S3 User Guide/.
--
-- If you provide an individual checksum, Amazon S3 ignores any provided
-- @ChecksumAlgorithm@ parameter.
putObjectLockConfiguration_checksumAlgorithm :: Lens.Lens' PutObjectLockConfiguration (Prelude.Maybe ChecksumAlgorithm)
putObjectLockConfiguration_checksumAlgorithm :: Lens' PutObjectLockConfiguration (Maybe ChecksumAlgorithm)
putObjectLockConfiguration_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfiguration' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: PutObjectLockConfiguration
s@PutObjectLockConfiguration' {} Maybe ChecksumAlgorithm
a -> PutObjectLockConfiguration
s {$sel:checksumAlgorithm:PutObjectLockConfiguration' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: PutObjectLockConfiguration)

-- | The MD5 hash for the request body.
--
-- For requests made using the Amazon Web Services Command Line Interface
-- (CLI) or Amazon Web Services SDKs, this field is calculated
-- automatically.
putObjectLockConfiguration_contentMD5 :: Lens.Lens' PutObjectLockConfiguration (Prelude.Maybe Prelude.Text)
putObjectLockConfiguration_contentMD5 :: Lens' PutObjectLockConfiguration (Maybe Text)
putObjectLockConfiguration_contentMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfiguration' {Maybe Text
contentMD5 :: Maybe Text
$sel:contentMD5:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
contentMD5} -> Maybe Text
contentMD5) (\s :: PutObjectLockConfiguration
s@PutObjectLockConfiguration' {} Maybe Text
a -> PutObjectLockConfiguration
s {$sel:contentMD5:PutObjectLockConfiguration' :: Maybe Text
contentMD5 = Maybe Text
a} :: PutObjectLockConfiguration)

-- | The account ID of the expected bucket owner. If the bucket is owned by a
-- different account, the request fails with the HTTP status code
-- @403 Forbidden@ (access denied).
putObjectLockConfiguration_expectedBucketOwner :: Lens.Lens' PutObjectLockConfiguration (Prelude.Maybe Prelude.Text)
putObjectLockConfiguration_expectedBucketOwner :: Lens' PutObjectLockConfiguration (Maybe Text)
putObjectLockConfiguration_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfiguration' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: PutObjectLockConfiguration
s@PutObjectLockConfiguration' {} Maybe Text
a -> PutObjectLockConfiguration
s {$sel:expectedBucketOwner:PutObjectLockConfiguration' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: PutObjectLockConfiguration)

-- | The Object Lock configuration that you want to apply to the specified
-- bucket.
putObjectLockConfiguration_objectLockConfiguration :: Lens.Lens' PutObjectLockConfiguration (Prelude.Maybe ObjectLockConfiguration)
putObjectLockConfiguration_objectLockConfiguration :: Lens' PutObjectLockConfiguration (Maybe ObjectLockConfiguration)
putObjectLockConfiguration_objectLockConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfiguration' {Maybe ObjectLockConfiguration
objectLockConfiguration :: Maybe ObjectLockConfiguration
$sel:objectLockConfiguration:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ObjectLockConfiguration
objectLockConfiguration} -> Maybe ObjectLockConfiguration
objectLockConfiguration) (\s :: PutObjectLockConfiguration
s@PutObjectLockConfiguration' {} Maybe ObjectLockConfiguration
a -> PutObjectLockConfiguration
s {$sel:objectLockConfiguration:PutObjectLockConfiguration' :: Maybe ObjectLockConfiguration
objectLockConfiguration = Maybe ObjectLockConfiguration
a} :: PutObjectLockConfiguration)

-- | Undocumented member.
putObjectLockConfiguration_requestPayer :: Lens.Lens' PutObjectLockConfiguration (Prelude.Maybe RequestPayer)
putObjectLockConfiguration_requestPayer :: Lens' PutObjectLockConfiguration (Maybe RequestPayer)
putObjectLockConfiguration_requestPayer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfiguration' {Maybe RequestPayer
requestPayer :: Maybe RequestPayer
$sel:requestPayer:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe RequestPayer
requestPayer} -> Maybe RequestPayer
requestPayer) (\s :: PutObjectLockConfiguration
s@PutObjectLockConfiguration' {} Maybe RequestPayer
a -> PutObjectLockConfiguration
s {$sel:requestPayer:PutObjectLockConfiguration' :: Maybe RequestPayer
requestPayer = Maybe RequestPayer
a} :: PutObjectLockConfiguration)

-- | A token to allow Object Lock to be enabled for an existing bucket.
putObjectLockConfiguration_token :: Lens.Lens' PutObjectLockConfiguration (Prelude.Maybe Prelude.Text)
putObjectLockConfiguration_token :: Lens' PutObjectLockConfiguration (Maybe Text)
putObjectLockConfiguration_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfiguration' {Maybe Text
token :: Maybe Text
$sel:token:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
token} -> Maybe Text
token) (\s :: PutObjectLockConfiguration
s@PutObjectLockConfiguration' {} Maybe Text
a -> PutObjectLockConfiguration
s {$sel:token:PutObjectLockConfiguration' :: Maybe Text
token = Maybe Text
a} :: PutObjectLockConfiguration)

-- | The bucket whose Object Lock configuration you want to create or
-- replace.
putObjectLockConfiguration_bucket :: Lens.Lens' PutObjectLockConfiguration BucketName
putObjectLockConfiguration_bucket :: Lens' PutObjectLockConfiguration BucketName
putObjectLockConfiguration_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfiguration' {BucketName
bucket :: BucketName
$sel:bucket:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> BucketName
bucket} -> BucketName
bucket) (\s :: PutObjectLockConfiguration
s@PutObjectLockConfiguration' {} BucketName
a -> PutObjectLockConfiguration
s {$sel:bucket:PutObjectLockConfiguration' :: BucketName
bucket = BucketName
a} :: PutObjectLockConfiguration)

instance Core.AWSRequest PutObjectLockConfiguration where
  type
    AWSResponse PutObjectLockConfiguration =
      PutObjectLockConfigurationResponse
  request :: (Service -> Service)
-> PutObjectLockConfiguration -> Request PutObjectLockConfiguration
request Service -> Service
overrides =
    forall a. Request a -> Request a
Request.s3vhost
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.putXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutObjectLockConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutObjectLockConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Maybe RequestCharged -> Int -> PutObjectLockConfigurationResponse
PutObjectLockConfigurationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-request-charged")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable PutObjectLockConfiguration where
  hashWithSalt :: Int -> PutObjectLockConfiguration -> Int
hashWithSalt Int
_salt PutObjectLockConfiguration' {Maybe Text
Maybe ChecksumAlgorithm
Maybe ObjectLockConfiguration
Maybe RequestPayer
BucketName
bucket :: BucketName
token :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockConfiguration :: Maybe ObjectLockConfiguration
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:bucket:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> BucketName
$sel:token:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:requestPayer:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe RequestPayer
$sel:objectLockConfiguration:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ObjectLockConfiguration
$sel:expectedBucketOwner:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:contentMD5:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:checksumAlgorithm:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ChecksumAlgorithm
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChecksumAlgorithm
checksumAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentMD5
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedBucketOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ObjectLockConfiguration
objectLockConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestPayer
requestPayer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
token
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket

instance Prelude.NFData PutObjectLockConfiguration where
  rnf :: PutObjectLockConfiguration -> ()
rnf PutObjectLockConfiguration' {Maybe Text
Maybe ChecksumAlgorithm
Maybe ObjectLockConfiguration
Maybe RequestPayer
BucketName
bucket :: BucketName
token :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockConfiguration :: Maybe ObjectLockConfiguration
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:bucket:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> BucketName
$sel:token:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:requestPayer:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe RequestPayer
$sel:objectLockConfiguration:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ObjectLockConfiguration
$sel:expectedBucketOwner:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:contentMD5:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:checksumAlgorithm:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ChecksumAlgorithm
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ChecksumAlgorithm
checksumAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentMD5
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expectedBucketOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectLockConfiguration
objectLockConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestPayer
requestPayer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
token
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketName
bucket

instance Data.ToElement PutObjectLockConfiguration where
  toElement :: PutObjectLockConfiguration -> Element
toElement PutObjectLockConfiguration' {Maybe Text
Maybe ChecksumAlgorithm
Maybe ObjectLockConfiguration
Maybe RequestPayer
BucketName
bucket :: BucketName
token :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockConfiguration :: Maybe ObjectLockConfiguration
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:bucket:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> BucketName
$sel:token:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:requestPayer:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe RequestPayer
$sel:objectLockConfiguration:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ObjectLockConfiguration
$sel:expectedBucketOwner:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:contentMD5:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:checksumAlgorithm:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ChecksumAlgorithm
..} =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://s3.amazonaws.com/doc/2006-03-01/}ObjectLockConfiguration"
      Maybe ObjectLockConfiguration
objectLockConfiguration

instance Data.ToHeaders PutObjectLockConfiguration where
  toHeaders :: PutObjectLockConfiguration -> ResponseHeaders
toHeaders PutObjectLockConfiguration' {Maybe Text
Maybe ChecksumAlgorithm
Maybe ObjectLockConfiguration
Maybe RequestPayer
BucketName
bucket :: BucketName
token :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockConfiguration :: Maybe ObjectLockConfiguration
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:bucket:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> BucketName
$sel:token:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:requestPayer:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe RequestPayer
$sel:objectLockConfiguration:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ObjectLockConfiguration
$sel:expectedBucketOwner:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:contentMD5:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:checksumAlgorithm:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ChecksumAlgorithm
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-sdk-checksum-algorithm"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ChecksumAlgorithm
checksumAlgorithm,
        HeaderName
"Content-MD5" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
contentMD5,
        HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
expectedBucketOwner,
        HeaderName
"x-amz-request-payer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe RequestPayer
requestPayer,
        HeaderName
"x-amz-bucket-object-lock-token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
token
      ]

instance Data.ToPath PutObjectLockConfiguration where
  toPath :: PutObjectLockConfiguration -> ByteString
toPath PutObjectLockConfiguration' {Maybe Text
Maybe ChecksumAlgorithm
Maybe ObjectLockConfiguration
Maybe RequestPayer
BucketName
bucket :: BucketName
token :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockConfiguration :: Maybe ObjectLockConfiguration
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:bucket:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> BucketName
$sel:token:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:requestPayer:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe RequestPayer
$sel:objectLockConfiguration:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ObjectLockConfiguration
$sel:expectedBucketOwner:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:contentMD5:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe Text
$sel:checksumAlgorithm:PutObjectLockConfiguration' :: PutObjectLockConfiguration -> Maybe ChecksumAlgorithm
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS BucketName
bucket]

instance Data.ToQuery PutObjectLockConfiguration where
  toQuery :: PutObjectLockConfiguration -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const (forall a. Monoid a => [a] -> a
Prelude.mconcat [QueryString
"object-lock"])

-- | /See:/ 'newPutObjectLockConfigurationResponse' smart constructor.
data PutObjectLockConfigurationResponse = PutObjectLockConfigurationResponse'
  { PutObjectLockConfigurationResponse -> Maybe RequestCharged
requestCharged :: Prelude.Maybe RequestCharged,
    -- | The response's http status code.
    PutObjectLockConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutObjectLockConfigurationResponse
-> PutObjectLockConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutObjectLockConfigurationResponse
-> PutObjectLockConfigurationResponse -> Bool
$c/= :: PutObjectLockConfigurationResponse
-> PutObjectLockConfigurationResponse -> Bool
== :: PutObjectLockConfigurationResponse
-> PutObjectLockConfigurationResponse -> Bool
$c== :: PutObjectLockConfigurationResponse
-> PutObjectLockConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [PutObjectLockConfigurationResponse]
ReadPrec PutObjectLockConfigurationResponse
Int -> ReadS PutObjectLockConfigurationResponse
ReadS [PutObjectLockConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutObjectLockConfigurationResponse]
$creadListPrec :: ReadPrec [PutObjectLockConfigurationResponse]
readPrec :: ReadPrec PutObjectLockConfigurationResponse
$creadPrec :: ReadPrec PutObjectLockConfigurationResponse
readList :: ReadS [PutObjectLockConfigurationResponse]
$creadList :: ReadS [PutObjectLockConfigurationResponse]
readsPrec :: Int -> ReadS PutObjectLockConfigurationResponse
$creadsPrec :: Int -> ReadS PutObjectLockConfigurationResponse
Prelude.Read, Int -> PutObjectLockConfigurationResponse -> ShowS
[PutObjectLockConfigurationResponse] -> ShowS
PutObjectLockConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutObjectLockConfigurationResponse] -> ShowS
$cshowList :: [PutObjectLockConfigurationResponse] -> ShowS
show :: PutObjectLockConfigurationResponse -> String
$cshow :: PutObjectLockConfigurationResponse -> String
showsPrec :: Int -> PutObjectLockConfigurationResponse -> ShowS
$cshowsPrec :: Int -> PutObjectLockConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep PutObjectLockConfigurationResponse x
-> PutObjectLockConfigurationResponse
forall x.
PutObjectLockConfigurationResponse
-> Rep PutObjectLockConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutObjectLockConfigurationResponse x
-> PutObjectLockConfigurationResponse
$cfrom :: forall x.
PutObjectLockConfigurationResponse
-> Rep PutObjectLockConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutObjectLockConfigurationResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'requestCharged', 'putObjectLockConfigurationResponse_requestCharged' - Undocumented member.
--
-- 'httpStatus', 'putObjectLockConfigurationResponse_httpStatus' - The response's http status code.
newPutObjectLockConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutObjectLockConfigurationResponse
newPutObjectLockConfigurationResponse :: Int -> PutObjectLockConfigurationResponse
newPutObjectLockConfigurationResponse Int
pHttpStatus_ =
  PutObjectLockConfigurationResponse'
    { $sel:requestCharged:PutObjectLockConfigurationResponse' :: Maybe RequestCharged
requestCharged =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutObjectLockConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
putObjectLockConfigurationResponse_requestCharged :: Lens.Lens' PutObjectLockConfigurationResponse (Prelude.Maybe RequestCharged)
putObjectLockConfigurationResponse_requestCharged :: Lens' PutObjectLockConfigurationResponse (Maybe RequestCharged)
putObjectLockConfigurationResponse_requestCharged = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfigurationResponse' {Maybe RequestCharged
requestCharged :: Maybe RequestCharged
$sel:requestCharged:PutObjectLockConfigurationResponse' :: PutObjectLockConfigurationResponse -> Maybe RequestCharged
requestCharged} -> Maybe RequestCharged
requestCharged) (\s :: PutObjectLockConfigurationResponse
s@PutObjectLockConfigurationResponse' {} Maybe RequestCharged
a -> PutObjectLockConfigurationResponse
s {$sel:requestCharged:PutObjectLockConfigurationResponse' :: Maybe RequestCharged
requestCharged = Maybe RequestCharged
a} :: PutObjectLockConfigurationResponse)

-- | The response's http status code.
putObjectLockConfigurationResponse_httpStatus :: Lens.Lens' PutObjectLockConfigurationResponse Prelude.Int
putObjectLockConfigurationResponse_httpStatus :: Lens' PutObjectLockConfigurationResponse Int
putObjectLockConfigurationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectLockConfigurationResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutObjectLockConfigurationResponse' :: PutObjectLockConfigurationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutObjectLockConfigurationResponse
s@PutObjectLockConfigurationResponse' {} Int
a -> PutObjectLockConfigurationResponse
s {$sel:httpStatus:PutObjectLockConfigurationResponse' :: Int
httpStatus = Int
a} :: PutObjectLockConfigurationResponse)

instance
  Prelude.NFData
    PutObjectLockConfigurationResponse
  where
  rnf :: PutObjectLockConfigurationResponse -> ()
rnf PutObjectLockConfigurationResponse' {Int
Maybe RequestCharged
httpStatus :: Int
requestCharged :: Maybe RequestCharged
$sel:httpStatus:PutObjectLockConfigurationResponse' :: PutObjectLockConfigurationResponse -> Int
$sel:requestCharged:PutObjectLockConfigurationResponse' :: PutObjectLockConfigurationResponse -> Maybe RequestCharged
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestCharged
requestCharged
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus