{-# 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.GetBucketReplication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the replication configuration of a bucket.
--
-- It can take a while to propagate the put or delete a replication
-- configuration to all Amazon S3 systems. Therefore, a get request soon
-- after put or delete can return a wrong result.
--
-- For information about replication configuration, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/replication.html Replication>
-- in the /Amazon S3 User Guide/.
--
-- This action requires permissions for the
-- @s3:GetReplicationConfiguration@ action. For more information about
-- permissions, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/using-iam-policies.html Using Bucket Policies and User Policies>.
--
-- If you include the @Filter@ element in a replication configuration, you
-- must also include the @DeleteMarkerReplication@ and @Priority@ elements.
-- The response also returns those elements.
--
-- For information about @GetBucketReplication@ errors, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html#ReplicationErrorCodeList List of replication-related error codes>
--
-- The following operations are related to @GetBucketReplication@:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_PutBucketReplication.html PutBucketReplication>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_DeleteBucketReplication.html DeleteBucketReplication>
module Amazonka.S3.GetBucketReplication
  ( -- * Creating a Request
    GetBucketReplication (..),
    newGetBucketReplication,

    -- * Request Lenses
    getBucketReplication_expectedBucketOwner,
    getBucketReplication_bucket,

    -- * Destructuring the Response
    GetBucketReplicationResponse (..),
    newGetBucketReplicationResponse,

    -- * Response Lenses
    getBucketReplicationResponse_replicationConfiguration,
    getBucketReplicationResponse_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:/ 'newGetBucketReplication' smart constructor.
data GetBucketReplication = GetBucketReplication'
  { -- | 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).
    GetBucketReplication -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | The bucket name for which to get the replication information.
    GetBucketReplication -> BucketName
bucket :: BucketName
  }
  deriving (GetBucketReplication -> GetBucketReplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketReplication -> GetBucketReplication -> Bool
$c/= :: GetBucketReplication -> GetBucketReplication -> Bool
== :: GetBucketReplication -> GetBucketReplication -> Bool
$c== :: GetBucketReplication -> GetBucketReplication -> Bool
Prelude.Eq, ReadPrec [GetBucketReplication]
ReadPrec GetBucketReplication
Int -> ReadS GetBucketReplication
ReadS [GetBucketReplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBucketReplication]
$creadListPrec :: ReadPrec [GetBucketReplication]
readPrec :: ReadPrec GetBucketReplication
$creadPrec :: ReadPrec GetBucketReplication
readList :: ReadS [GetBucketReplication]
$creadList :: ReadS [GetBucketReplication]
readsPrec :: Int -> ReadS GetBucketReplication
$creadsPrec :: Int -> ReadS GetBucketReplication
Prelude.Read, Int -> GetBucketReplication -> ShowS
[GetBucketReplication] -> ShowS
GetBucketReplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketReplication] -> ShowS
$cshowList :: [GetBucketReplication] -> ShowS
show :: GetBucketReplication -> String
$cshow :: GetBucketReplication -> String
showsPrec :: Int -> GetBucketReplication -> ShowS
$cshowsPrec :: Int -> GetBucketReplication -> ShowS
Prelude.Show, forall x. Rep GetBucketReplication x -> GetBucketReplication
forall x. GetBucketReplication -> Rep GetBucketReplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBucketReplication x -> GetBucketReplication
$cfrom :: forall x. GetBucketReplication -> Rep GetBucketReplication x
Prelude.Generic)

-- |
-- Create a value of 'GetBucketReplication' 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', 'getBucketReplication_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', 'getBucketReplication_bucket' - The bucket name for which to get the replication information.
newGetBucketReplication ::
  -- | 'bucket'
  BucketName ->
  GetBucketReplication
newGetBucketReplication :: BucketName -> GetBucketReplication
newGetBucketReplication BucketName
pBucket_ =
  GetBucketReplication'
    { $sel:expectedBucketOwner:GetBucketReplication' :: Maybe Text
expectedBucketOwner =
        forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:GetBucketReplication' :: 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).
getBucketReplication_expectedBucketOwner :: Lens.Lens' GetBucketReplication (Prelude.Maybe Prelude.Text)
getBucketReplication_expectedBucketOwner :: Lens' GetBucketReplication (Maybe Text)
getBucketReplication_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketReplication' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:GetBucketReplication' :: GetBucketReplication -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: GetBucketReplication
s@GetBucketReplication' {} Maybe Text
a -> GetBucketReplication
s {$sel:expectedBucketOwner:GetBucketReplication' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: GetBucketReplication)

-- | The bucket name for which to get the replication information.
getBucketReplication_bucket :: Lens.Lens' GetBucketReplication BucketName
getBucketReplication_bucket :: Lens' GetBucketReplication BucketName
getBucketReplication_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketReplication' {BucketName
bucket :: BucketName
$sel:bucket:GetBucketReplication' :: GetBucketReplication -> BucketName
bucket} -> BucketName
bucket) (\s :: GetBucketReplication
s@GetBucketReplication' {} BucketName
a -> GetBucketReplication
s {$sel:bucket:GetBucketReplication' :: BucketName
bucket = BucketName
a} :: GetBucketReplication)

instance Core.AWSRequest GetBucketReplication where
  type
    AWSResponse GetBucketReplication =
      GetBucketReplicationResponse
  request :: (Service -> Service)
-> GetBucketReplication -> Request GetBucketReplication
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 GetBucketReplication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBucketReplication)))
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 ReplicationConfiguration
-> Int -> GetBucketReplicationResponse
GetBucketReplicationResponse'
            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 GetBucketReplication where
  hashWithSalt :: Int -> GetBucketReplication -> Int
hashWithSalt Int
_salt GetBucketReplication' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetBucketReplication' :: GetBucketReplication -> BucketName
$sel:expectedBucketOwner:GetBucketReplication' :: GetBucketReplication -> 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 GetBucketReplication where
  rnf :: GetBucketReplication -> ()
rnf GetBucketReplication' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetBucketReplication' :: GetBucketReplication -> BucketName
$sel:expectedBucketOwner:GetBucketReplication' :: GetBucketReplication -> 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 GetBucketReplication where
  toHeaders :: GetBucketReplication -> ResponseHeaders
toHeaders GetBucketReplication' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetBucketReplication' :: GetBucketReplication -> BucketName
$sel:expectedBucketOwner:GetBucketReplication' :: GetBucketReplication -> 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 GetBucketReplication where
  toPath :: GetBucketReplication -> ByteString
toPath GetBucketReplication' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:GetBucketReplication' :: GetBucketReplication -> BucketName
$sel:expectedBucketOwner:GetBucketReplication' :: GetBucketReplication -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS BucketName
bucket]

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

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

-- |
-- Create a value of 'GetBucketReplicationResponse' 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:
--
-- 'replicationConfiguration', 'getBucketReplicationResponse_replicationConfiguration' - Undocumented member.
--
-- 'httpStatus', 'getBucketReplicationResponse_httpStatus' - The response's http status code.
newGetBucketReplicationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBucketReplicationResponse
newGetBucketReplicationResponse :: Int -> GetBucketReplicationResponse
newGetBucketReplicationResponse Int
pHttpStatus_ =
  GetBucketReplicationResponse'
    { $sel:replicationConfiguration:GetBucketReplicationResponse' :: Maybe ReplicationConfiguration
replicationConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBucketReplicationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getBucketReplicationResponse_replicationConfiguration :: Lens.Lens' GetBucketReplicationResponse (Prelude.Maybe ReplicationConfiguration)
getBucketReplicationResponse_replicationConfiguration :: Lens' GetBucketReplicationResponse (Maybe ReplicationConfiguration)
getBucketReplicationResponse_replicationConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketReplicationResponse' {Maybe ReplicationConfiguration
replicationConfiguration :: Maybe ReplicationConfiguration
$sel:replicationConfiguration:GetBucketReplicationResponse' :: GetBucketReplicationResponse -> Maybe ReplicationConfiguration
replicationConfiguration} -> Maybe ReplicationConfiguration
replicationConfiguration) (\s :: GetBucketReplicationResponse
s@GetBucketReplicationResponse' {} Maybe ReplicationConfiguration
a -> GetBucketReplicationResponse
s {$sel:replicationConfiguration:GetBucketReplicationResponse' :: Maybe ReplicationConfiguration
replicationConfiguration = Maybe ReplicationConfiguration
a} :: GetBucketReplicationResponse)

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

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