{-# 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.HeadBucket
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This action is useful to determine if a bucket exists and you have
-- permission to access it. The action returns a @200 OK@ if the bucket
-- exists and you have permission to access it.
--
-- If the bucket does not exist or you do not have permission to access it,
-- the @HEAD@ request returns a generic @404 Not Found@ or @403 Forbidden@
-- code. A message body is not included, so you cannot determine the
-- exception beyond these error codes.
--
-- To use this operation, you must have permissions to perform the
-- @s3:ListBucket@ action. The bucket owner has this permission by default
-- and 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>.
--
-- To use this API against an access point, you must provide the alias of
-- the access point in place of the bucket name or specify the access point
-- ARN. When using the access point ARN, 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 the Amazon Web Services SDKs, you provide the ARN in place of the
-- bucket name. For more information see,
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-access-points.html Using access points>.
module Amazonka.S3.HeadBucket
  ( -- * Creating a Request
    HeadBucket (..),
    newHeadBucket,

    -- * Request Lenses
    headBucket_expectedBucketOwner,
    headBucket_bucket,

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

-- |
-- Create a value of 'HeadBucket' 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', 'headBucket_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', 'headBucket_bucket' - The bucket name.
--
-- 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/.
--
-- When using this action with Amazon S3 on Outposts, you must direct
-- requests to the S3 on Outposts hostname. The S3 on Outposts hostname
-- takes the form
-- @ @/@AccessPointName@/@-@/@AccountId@/@.@/@outpostID@/@.s3-outposts.@/@Region@/@.amazonaws.com@.
-- When using this action with S3 on Outposts through the Amazon Web
-- Services SDKs, you provide the Outposts bucket ARN in place of the
-- bucket name. For more information about S3 on Outposts ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/S3onOutposts.html Using Amazon S3 on Outposts>
-- in the /Amazon S3 User Guide/.
newHeadBucket ::
  -- | 'bucket'
  BucketName ->
  HeadBucket
newHeadBucket :: BucketName -> HeadBucket
newHeadBucket BucketName
pBucket_ =
  HeadBucket'
    { $sel:expectedBucketOwner:HeadBucket' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:HeadBucket' :: 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).
headBucket_expectedBucketOwner :: Lens.Lens' HeadBucket (Prelude.Maybe Prelude.Text)
headBucket_expectedBucketOwner :: Lens' HeadBucket (Maybe Text)
headBucket_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeadBucket' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:HeadBucket' :: HeadBucket -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: HeadBucket
s@HeadBucket' {} Maybe Text
a -> HeadBucket
s {$sel:expectedBucketOwner:HeadBucket' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: HeadBucket)

-- | The bucket name.
--
-- 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/.
--
-- When using this action with Amazon S3 on Outposts, you must direct
-- requests to the S3 on Outposts hostname. The S3 on Outposts hostname
-- takes the form
-- @ @/@AccessPointName@/@-@/@AccountId@/@.@/@outpostID@/@.s3-outposts.@/@Region@/@.amazonaws.com@.
-- When using this action with S3 on Outposts through the Amazon Web
-- Services SDKs, you provide the Outposts bucket ARN in place of the
-- bucket name. For more information about S3 on Outposts ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/S3onOutposts.html Using Amazon S3 on Outposts>
-- in the /Amazon S3 User Guide/.
headBucket_bucket :: Lens.Lens' HeadBucket BucketName
headBucket_bucket :: Lens' HeadBucket BucketName
headBucket_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HeadBucket' {BucketName
bucket :: BucketName
$sel:bucket:HeadBucket' :: HeadBucket -> BucketName
bucket} -> BucketName
bucket) (\s :: HeadBucket
s@HeadBucket' {} BucketName
a -> HeadBucket
s {$sel:bucket:HeadBucket' :: BucketName
bucket = BucketName
a} :: HeadBucket)

instance Core.AWSRequest HeadBucket where
  type AWSResponse HeadBucket = HeadBucketResponse
  request :: (Service -> Service) -> HeadBucket -> Request HeadBucket
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.head' (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy HeadBucket
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse HeadBucket)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull HeadBucketResponse
HeadBucketResponse'

instance Prelude.Hashable HeadBucket where
  hashWithSalt :: Int -> HeadBucket -> Int
hashWithSalt Int
_salt HeadBucket' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:HeadBucket' :: HeadBucket -> BucketName
$sel:expectedBucketOwner:HeadBucket' :: HeadBucket -> 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 HeadBucket where
  rnf :: HeadBucket -> ()
rnf HeadBucket' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:HeadBucket' :: HeadBucket -> BucketName
$sel:expectedBucketOwner:HeadBucket' :: HeadBucket -> 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 HeadBucket where
  toHeaders :: HeadBucket -> [Header]
toHeaders HeadBucket' {Maybe Text
BucketName
bucket :: BucketName
expectedBucketOwner :: Maybe Text
$sel:bucket:HeadBucket' :: HeadBucket -> BucketName
$sel:expectedBucketOwner:HeadBucket' :: HeadBucket -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
expectedBucketOwner
      ]

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

instance Data.ToQuery HeadBucket where
  toQuery :: HeadBucket -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newHeadBucketResponse' smart constructor.
data HeadBucketResponse = HeadBucketResponse'
  {
  }
  deriving (HeadBucketResponse -> HeadBucketResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeadBucketResponse -> HeadBucketResponse -> Bool
$c/= :: HeadBucketResponse -> HeadBucketResponse -> Bool
== :: HeadBucketResponse -> HeadBucketResponse -> Bool
$c== :: HeadBucketResponse -> HeadBucketResponse -> Bool
Prelude.Eq, ReadPrec [HeadBucketResponse]
ReadPrec HeadBucketResponse
Int -> ReadS HeadBucketResponse
ReadS [HeadBucketResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeadBucketResponse]
$creadListPrec :: ReadPrec [HeadBucketResponse]
readPrec :: ReadPrec HeadBucketResponse
$creadPrec :: ReadPrec HeadBucketResponse
readList :: ReadS [HeadBucketResponse]
$creadList :: ReadS [HeadBucketResponse]
readsPrec :: Int -> ReadS HeadBucketResponse
$creadsPrec :: Int -> ReadS HeadBucketResponse
Prelude.Read, Int -> HeadBucketResponse -> ShowS
[HeadBucketResponse] -> ShowS
HeadBucketResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeadBucketResponse] -> ShowS
$cshowList :: [HeadBucketResponse] -> ShowS
show :: HeadBucketResponse -> String
$cshow :: HeadBucketResponse -> String
showsPrec :: Int -> HeadBucketResponse -> ShowS
$cshowsPrec :: Int -> HeadBucketResponse -> ShowS
Prelude.Show, forall x. Rep HeadBucketResponse x -> HeadBucketResponse
forall x. HeadBucketResponse -> Rep HeadBucketResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HeadBucketResponse x -> HeadBucketResponse
$cfrom :: forall x. HeadBucketResponse -> Rep HeadBucketResponse x
Prelude.Generic)

-- |
-- Create a value of 'HeadBucketResponse' 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.
newHeadBucketResponse ::
  HeadBucketResponse
newHeadBucketResponse :: HeadBucketResponse
newHeadBucketResponse = HeadBucketResponse
HeadBucketResponse'

instance Prelude.NFData HeadBucketResponse where
  rnf :: HeadBucketResponse -> ()
rnf HeadBucketResponse
_ = ()