{-# 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.GetObjectLockConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the Object Lock configuration for a 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 following action is related to @GetObjectLockConfiguration@:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectAttributes.html GetObjectAttributes>
module Amazonka.S3.GetObjectLockConfiguration
  ( -- * Creating a Request
    GetObjectLockConfiguration (..),
    newGetObjectLockConfiguration,

    -- * Request Lenses
    getObjectLockConfiguration_expectedBucketOwner,
    getObjectLockConfiguration_bucket,

    -- * Destructuring the Response
    GetObjectLockConfigurationResponse (..),
    newGetObjectLockConfigurationResponse,

    -- * Response Lenses
    getObjectLockConfigurationResponse_objectLockConfiguration,
    getObjectLockConfigurationResponse_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:/ 'newGetObjectLockConfiguration' smart constructor.
data GetObjectLockConfiguration = GetObjectLockConfiguration'
  { -- | 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).
    GetObjectLockConfiguration -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | The bucket whose Object Lock configuration you want to retrieve.
    --
    -- When using this action with an access point, you must direct requests to
    -- the access point hostname. The access point hostname takes the form
    -- /AccessPointName/-/AccountId/.s3-accesspoint./Region/.amazonaws.com.
    -- When using this action with an access point through the Amazon Web
    -- Services SDKs, you provide the access point ARN in place of the bucket
    -- name. For more information about access point ARNs, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-access-points.html Using access points>
    -- in the /Amazon S3 User Guide/.
    GetObjectLockConfiguration -> BucketName
bucket :: BucketName
  }
  deriving (GetObjectLockConfiguration -> GetObjectLockConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObjectLockConfiguration -> GetObjectLockConfiguration -> Bool
$c/= :: GetObjectLockConfiguration -> GetObjectLockConfiguration -> Bool
== :: GetObjectLockConfiguration -> GetObjectLockConfiguration -> Bool
$c== :: GetObjectLockConfiguration -> GetObjectLockConfiguration -> Bool
Prelude.Eq, ReadPrec [GetObjectLockConfiguration]
ReadPrec GetObjectLockConfiguration
Int -> ReadS GetObjectLockConfiguration
ReadS [GetObjectLockConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetObjectLockConfiguration]
$creadListPrec :: ReadPrec [GetObjectLockConfiguration]
readPrec :: ReadPrec GetObjectLockConfiguration
$creadPrec :: ReadPrec GetObjectLockConfiguration
readList :: ReadS [GetObjectLockConfiguration]
$creadList :: ReadS [GetObjectLockConfiguration]
readsPrec :: Int -> ReadS GetObjectLockConfiguration
$creadsPrec :: Int -> ReadS GetObjectLockConfiguration
Prelude.Read, Int -> GetObjectLockConfiguration -> ShowS
[GetObjectLockConfiguration] -> ShowS
GetObjectLockConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectLockConfiguration] -> ShowS
$cshowList :: [GetObjectLockConfiguration] -> ShowS
show :: GetObjectLockConfiguration -> String
$cshow :: GetObjectLockConfiguration -> String
showsPrec :: Int -> GetObjectLockConfiguration -> ShowS
$cshowsPrec :: Int -> GetObjectLockConfiguration -> ShowS
Prelude.Show, forall x.
Rep GetObjectLockConfiguration x -> GetObjectLockConfiguration
forall x.
GetObjectLockConfiguration -> Rep GetObjectLockConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetObjectLockConfiguration x -> GetObjectLockConfiguration
$cfrom :: forall x.
GetObjectLockConfiguration -> Rep GetObjectLockConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectLockConfiguration' 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:
--
-- 'expectedBucketOwner', 'getObjectLockConfiguration_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).
--
-- 'bucket', 'getObjectLockConfiguration_bucket' - The bucket whose Object Lock configuration you want to retrieve.
--
-- When using this action with an access point, you must direct requests to
-- the access point hostname. The access point hostname takes the form
-- /AccessPointName/-/AccountId/.s3-accesspoint./Region/.amazonaws.com.
-- When using this action with an access point through the Amazon Web
-- Services SDKs, you provide the access point ARN in place of the bucket
-- name. For more information about access point ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-access-points.html Using access points>
-- in the /Amazon S3 User Guide/.
newGetObjectLockConfiguration ::
  -- | 'bucket'
  BucketName ->
  GetObjectLockConfiguration
newGetObjectLockConfiguration :: BucketName -> GetObjectLockConfiguration
newGetObjectLockConfiguration BucketName
pBucket_ =
  GetObjectLockConfiguration'
    { $sel:expectedBucketOwner:GetObjectLockConfiguration' :: Maybe Text
expectedBucketOwner =
        forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:GetObjectLockConfiguration' :: BucketName
bucket = BucketName
pBucket_
    }

-- | 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).
getObjectLockConfiguration_expectedBucketOwner :: Lens.Lens' GetObjectLockConfiguration (Prelude.Maybe Prelude.Text)
getObjectLockConfiguration_expectedBucketOwner :: Lens' GetObjectLockConfiguration (Maybe Text)
getObjectLockConfiguration_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectLockConfiguration' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: GetObjectLockConfiguration
s@GetObjectLockConfiguration' {} Maybe Text
a -> GetObjectLockConfiguration
s {$sel:expectedBucketOwner:GetObjectLockConfiguration' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: GetObjectLockConfiguration)

-- | The bucket whose Object Lock configuration you want to retrieve.
--
-- When using this action with an access point, you must direct requests to
-- the access point hostname. The access point hostname takes the form
-- /AccessPointName/-/AccountId/.s3-accesspoint./Region/.amazonaws.com.
-- When using this action with an access point through the Amazon Web
-- Services SDKs, you provide the access point ARN in place of the bucket
-- name. For more information about access point ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-access-points.html Using access points>
-- in the /Amazon S3 User Guide/.
getObjectLockConfiguration_bucket :: Lens.Lens' GetObjectLockConfiguration BucketName
getObjectLockConfiguration_bucket :: Lens' GetObjectLockConfiguration BucketName
getObjectLockConfiguration_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectLockConfiguration' {BucketName
bucket :: BucketName
$sel:bucket:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> BucketName
bucket} -> BucketName
bucket) (\s :: GetObjectLockConfiguration
s@GetObjectLockConfiguration' {} BucketName
a -> GetObjectLockConfiguration
s {$sel:bucket:GetObjectLockConfiguration' :: BucketName
bucket = BucketName
a} :: GetObjectLockConfiguration)

instance Core.AWSRequest GetObjectLockConfiguration where
  type
    AWSResponse GetObjectLockConfiguration =
      GetObjectLockConfigurationResponse
  request :: (Service -> Service)
-> GetObjectLockConfiguration -> Request GetObjectLockConfiguration
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 => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetObjectLockConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetObjectLockConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ObjectLockConfiguration
-> Int -> GetObjectLockConfigurationResponse
GetObjectLockConfigurationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
            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 GetObjectLockConfiguration where
  hashWithSalt :: Int -> GetObjectLockConfiguration -> Int
hashWithSalt Int
_salt GetObjectLockConfiguration' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> BucketName
$sel:expectedBucketOwner:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedBucketOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket

instance Prelude.NFData GetObjectLockConfiguration where
  rnf :: GetObjectLockConfiguration -> ()
rnf GetObjectLockConfiguration' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> BucketName
$sel:expectedBucketOwner:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> Maybe Text
..} =
    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 BucketName
bucket

instance Data.ToHeaders GetObjectLockConfiguration where
  toHeaders :: GetObjectLockConfiguration -> ResponseHeaders
toHeaders GetObjectLockConfiguration' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> BucketName
$sel:expectedBucketOwner:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
expectedBucketOwner
      ]

instance Data.ToPath GetObjectLockConfiguration where
  toPath :: GetObjectLockConfiguration -> ByteString
toPath GetObjectLockConfiguration' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> BucketName
$sel:expectedBucketOwner:GetObjectLockConfiguration' :: GetObjectLockConfiguration -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS BucketName
bucket]

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

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

-- |
-- Create a value of 'GetObjectLockConfigurationResponse' 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:
--
-- 'objectLockConfiguration', 'getObjectLockConfigurationResponse_objectLockConfiguration' - The specified bucket\'s Object Lock configuration.
--
-- 'httpStatus', 'getObjectLockConfigurationResponse_httpStatus' - The response's http status code.
newGetObjectLockConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetObjectLockConfigurationResponse
newGetObjectLockConfigurationResponse :: Int -> GetObjectLockConfigurationResponse
newGetObjectLockConfigurationResponse Int
pHttpStatus_ =
  GetObjectLockConfigurationResponse'
    { $sel:objectLockConfiguration:GetObjectLockConfigurationResponse' :: Maybe ObjectLockConfiguration
objectLockConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetObjectLockConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The specified bucket\'s Object Lock configuration.
getObjectLockConfigurationResponse_objectLockConfiguration :: Lens.Lens' GetObjectLockConfigurationResponse (Prelude.Maybe ObjectLockConfiguration)
getObjectLockConfigurationResponse_objectLockConfiguration :: Lens'
  GetObjectLockConfigurationResponse (Maybe ObjectLockConfiguration)
getObjectLockConfigurationResponse_objectLockConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectLockConfigurationResponse' {Maybe ObjectLockConfiguration
objectLockConfiguration :: Maybe ObjectLockConfiguration
$sel:objectLockConfiguration:GetObjectLockConfigurationResponse' :: GetObjectLockConfigurationResponse -> Maybe ObjectLockConfiguration
objectLockConfiguration} -> Maybe ObjectLockConfiguration
objectLockConfiguration) (\s :: GetObjectLockConfigurationResponse
s@GetObjectLockConfigurationResponse' {} Maybe ObjectLockConfiguration
a -> GetObjectLockConfigurationResponse
s {$sel:objectLockConfiguration:GetObjectLockConfigurationResponse' :: Maybe ObjectLockConfiguration
objectLockConfiguration = Maybe ObjectLockConfiguration
a} :: GetObjectLockConfigurationResponse)

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

instance
  Prelude.NFData
    GetObjectLockConfigurationResponse
  where
  rnf :: GetObjectLockConfigurationResponse -> ()
rnf GetObjectLockConfigurationResponse' {Int
Maybe ObjectLockConfiguration
httpStatus :: Int
objectLockConfiguration :: Maybe ObjectLockConfiguration
$sel:httpStatus:GetObjectLockConfigurationResponse' :: GetObjectLockConfigurationResponse -> Int
$sel:objectLockConfiguration:GetObjectLockConfigurationResponse' :: GetObjectLockConfigurationResponse -> Maybe ObjectLockConfiguration
..} =
    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 Int
httpStatus