{-# 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.GetBucketEncryption
-- 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 default encryption configuration for an Amazon S3 bucket. If
-- the bucket does not have a default encryption configuration,
-- GetBucketEncryption returns
-- @ServerSideEncryptionConfigurationNotFoundError@.
--
-- For information about the Amazon S3 default encryption feature, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/bucket-encryption.html Amazon S3 Default Bucket Encryption>.
--
-- To use this operation, you must have permission to perform the
-- @s3:GetEncryptionConfiguration@ action. The bucket owner has this
-- permission by default. The bucket owner can grant this permission to
-- others. For more information about permissions, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-with-s3-actions.html#using-with-s3-actions-related-to-bucket-subresources Permissions Related to Bucket Subresource Operations>
-- and
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/s3-access-control.html Managing Access Permissions to Your Amazon S3 Resources>.
--
-- The following operations are related to @GetBucketEncryption@:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_PutBucketEncryption.html PutBucketEncryption>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_DeleteBucketEncryption.html DeleteBucketEncryption>
module Amazonka.S3.GetBucketEncryption
  ( -- * Creating a Request
    GetBucketEncryption (..),
    newGetBucketEncryption,

    -- * Request Lenses
    getBucketEncryption_expectedBucketOwner,
    getBucketEncryption_bucket,

    -- * Destructuring the Response
    GetBucketEncryptionResponse (..),
    newGetBucketEncryptionResponse,

    -- * Response Lenses
    getBucketEncryptionResponse_serverSideEncryptionConfiguration,
    getBucketEncryptionResponse_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:/ 'newGetBucketEncryption' smart constructor.
data GetBucketEncryption = GetBucketEncryption'
  { -- | 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).
    GetBucketEncryption -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | The name of the bucket from which the server-side encryption
    -- configuration is retrieved.
    GetBucketEncryption -> BucketName
bucket :: BucketName
  }
  deriving (GetBucketEncryption -> GetBucketEncryption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketEncryption -> GetBucketEncryption -> Bool
$c/= :: GetBucketEncryption -> GetBucketEncryption -> Bool
== :: GetBucketEncryption -> GetBucketEncryption -> Bool
$c== :: GetBucketEncryption -> GetBucketEncryption -> Bool
Prelude.Eq, ReadPrec [GetBucketEncryption]
ReadPrec GetBucketEncryption
Int -> ReadS GetBucketEncryption
ReadS [GetBucketEncryption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBucketEncryption]
$creadListPrec :: ReadPrec [GetBucketEncryption]
readPrec :: ReadPrec GetBucketEncryption
$creadPrec :: ReadPrec GetBucketEncryption
readList :: ReadS [GetBucketEncryption]
$creadList :: ReadS [GetBucketEncryption]
readsPrec :: Int -> ReadS GetBucketEncryption
$creadsPrec :: Int -> ReadS GetBucketEncryption
Prelude.Read, Int -> GetBucketEncryption -> ShowS
[GetBucketEncryption] -> ShowS
GetBucketEncryption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketEncryption] -> ShowS
$cshowList :: [GetBucketEncryption] -> ShowS
show :: GetBucketEncryption -> String
$cshow :: GetBucketEncryption -> String
showsPrec :: Int -> GetBucketEncryption -> ShowS
$cshowsPrec :: Int -> GetBucketEncryption -> ShowS
Prelude.Show, forall x. Rep GetBucketEncryption x -> GetBucketEncryption
forall x. GetBucketEncryption -> Rep GetBucketEncryption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBucketEncryption x -> GetBucketEncryption
$cfrom :: forall x. GetBucketEncryption -> Rep GetBucketEncryption x
Prelude.Generic)

-- |
-- Create a value of 'GetBucketEncryption' 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', 'getBucketEncryption_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', 'getBucketEncryption_bucket' - The name of the bucket from which the server-side encryption
-- configuration is retrieved.
newGetBucketEncryption ::
  -- | 'bucket'
  BucketName ->
  GetBucketEncryption
newGetBucketEncryption :: BucketName -> GetBucketEncryption
newGetBucketEncryption BucketName
pBucket_ =
  GetBucketEncryption'
    { $sel:expectedBucketOwner:GetBucketEncryption' :: Maybe Text
expectedBucketOwner =
        forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:GetBucketEncryption' :: 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).
getBucketEncryption_expectedBucketOwner :: Lens.Lens' GetBucketEncryption (Prelude.Maybe Prelude.Text)
getBucketEncryption_expectedBucketOwner :: Lens' GetBucketEncryption (Maybe Text)
getBucketEncryption_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketEncryption' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:GetBucketEncryption' :: GetBucketEncryption -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: GetBucketEncryption
s@GetBucketEncryption' {} Maybe Text
a -> GetBucketEncryption
s {$sel:expectedBucketOwner:GetBucketEncryption' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: GetBucketEncryption)

-- | The name of the bucket from which the server-side encryption
-- configuration is retrieved.
getBucketEncryption_bucket :: Lens.Lens' GetBucketEncryption BucketName
getBucketEncryption_bucket :: Lens' GetBucketEncryption BucketName
getBucketEncryption_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketEncryption' {BucketName
bucket :: BucketName
$sel:bucket:GetBucketEncryption' :: GetBucketEncryption -> BucketName
bucket} -> BucketName
bucket) (\s :: GetBucketEncryption
s@GetBucketEncryption' {} BucketName
a -> GetBucketEncryption
s {$sel:bucket:GetBucketEncryption' :: BucketName
bucket = BucketName
a} :: GetBucketEncryption)

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

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

-- | /See:/ 'newGetBucketEncryptionResponse' smart constructor.
data GetBucketEncryptionResponse = GetBucketEncryptionResponse'
  { GetBucketEncryptionResponse
-> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: Prelude.Maybe ServerSideEncryptionConfiguration,
    -- | The response's http status code.
    GetBucketEncryptionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBucketEncryptionResponse -> GetBucketEncryptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketEncryptionResponse -> GetBucketEncryptionResponse -> Bool
$c/= :: GetBucketEncryptionResponse -> GetBucketEncryptionResponse -> Bool
== :: GetBucketEncryptionResponse -> GetBucketEncryptionResponse -> Bool
$c== :: GetBucketEncryptionResponse -> GetBucketEncryptionResponse -> Bool
Prelude.Eq, Int -> GetBucketEncryptionResponse -> ShowS
[GetBucketEncryptionResponse] -> ShowS
GetBucketEncryptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketEncryptionResponse] -> ShowS
$cshowList :: [GetBucketEncryptionResponse] -> ShowS
show :: GetBucketEncryptionResponse -> String
$cshow :: GetBucketEncryptionResponse -> String
showsPrec :: Int -> GetBucketEncryptionResponse -> ShowS
$cshowsPrec :: Int -> GetBucketEncryptionResponse -> ShowS
Prelude.Show, forall x.
Rep GetBucketEncryptionResponse x -> GetBucketEncryptionResponse
forall x.
GetBucketEncryptionResponse -> Rep GetBucketEncryptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBucketEncryptionResponse x -> GetBucketEncryptionResponse
$cfrom :: forall x.
GetBucketEncryptionResponse -> Rep GetBucketEncryptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBucketEncryptionResponse' 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:
--
-- 'serverSideEncryptionConfiguration', 'getBucketEncryptionResponse_serverSideEncryptionConfiguration' - Undocumented member.
--
-- 'httpStatus', 'getBucketEncryptionResponse_httpStatus' - The response's http status code.
newGetBucketEncryptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBucketEncryptionResponse
newGetBucketEncryptionResponse :: Int -> GetBucketEncryptionResponse
newGetBucketEncryptionResponse Int
pHttpStatus_ =
  GetBucketEncryptionResponse'
    { $sel:serverSideEncryptionConfiguration:GetBucketEncryptionResponse' :: Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBucketEncryptionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getBucketEncryptionResponse_serverSideEncryptionConfiguration :: Lens.Lens' GetBucketEncryptionResponse (Prelude.Maybe ServerSideEncryptionConfiguration)
getBucketEncryptionResponse_serverSideEncryptionConfiguration :: Lens'
  GetBucketEncryptionResponse
  (Maybe ServerSideEncryptionConfiguration)
getBucketEncryptionResponse_serverSideEncryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketEncryptionResponse' {Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
$sel:serverSideEncryptionConfiguration:GetBucketEncryptionResponse' :: GetBucketEncryptionResponse
-> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration} -> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration) (\s :: GetBucketEncryptionResponse
s@GetBucketEncryptionResponse' {} Maybe ServerSideEncryptionConfiguration
a -> GetBucketEncryptionResponse
s {$sel:serverSideEncryptionConfiguration:GetBucketEncryptionResponse' :: Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration = Maybe ServerSideEncryptionConfiguration
a} :: GetBucketEncryptionResponse)

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

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