{-# 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.PutBucketCors
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the @cors@ configuration for your bucket. If the configuration
-- exists, Amazon S3 replaces it.
--
-- To use this operation, you must be allowed to perform the
-- @s3:PutBucketCORS@ action. By default, the bucket owner has this
-- permission and can grant it to others.
--
-- You set this configuration on a bucket so that the bucket can service
-- cross-origin requests. For example, you might want to enable a request
-- whose origin is @http:\/\/www.example.com@ to access your Amazon S3
-- bucket at @my.example.bucket.com@ by using the browser\'s
-- @XMLHttpRequest@ capability.
--
-- To enable cross-origin resource sharing (CORS) on a bucket, you add the
-- @cors@ subresource to the bucket. The @cors@ subresource is an XML
-- document in which you configure rules that identify origins and the HTTP
-- methods that can be executed on your bucket. The document is limited to
-- 64 KB in size.
--
-- When Amazon S3 receives a cross-origin request (or a pre-flight OPTIONS
-- request) against a bucket, it evaluates the @cors@ configuration on the
-- bucket and uses the first @CORSRule@ rule that matches the incoming
-- browser request to enable a cross-origin request. For a rule to match,
-- the following conditions must be met:
--
-- -   The request\'s @Origin@ header must match @AllowedOrigin@ elements.
--
-- -   The request method (for example, GET, PUT, HEAD, and so on) or the
--     @Access-Control-Request-Method@ header in case of a pre-flight
--     @OPTIONS@ request must be one of the @AllowedMethod@ elements.
--
-- -   Every header specified in the @Access-Control-Request-Headers@
--     request header of a pre-flight request must match an @AllowedHeader@
--     element.
--
-- For more information about CORS, go to
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/cors.html Enabling Cross-Origin Resource Sharing>
-- in the /Amazon S3 User Guide/.
--
-- __Related Resources__
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetBucketCors.html GetBucketCors>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_DeleteBucketCors.html DeleteBucketCors>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTOPTIONSobject.html RESTOPTIONSobject>
module Amazonka.S3.PutBucketCors
  ( -- * Creating a Request
    PutBucketCors (..),
    newPutBucketCors,

    -- * Request Lenses
    putBucketCors_checksumAlgorithm,
    putBucketCors_contentMD5,
    putBucketCors_expectedBucketOwner,
    putBucketCors_bucket,
    putBucketCors_cORSConfiguration,

    -- * Destructuring the Response
    PutBucketCorsResponse (..),
    newPutBucketCorsResponse,
  )
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:/ 'newPutBucketCors' smart constructor.
data PutBucketCors = PutBucketCors'
  { -- | 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.
    PutBucketCors -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | The base64-encoded 128-bit MD5 digest of the data. This header must be
    -- used as a message integrity check to verify that the request body was
    -- not corrupted in transit. For more information, go to
    -- <http://www.ietf.org/rfc/rfc1864.txt RFC 1864.>
    --
    -- For requests made using the Amazon Web Services Command Line Interface
    -- (CLI) or Amazon Web Services SDKs, this field is calculated
    -- automatically.
    PutBucketCors -> 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).
    PutBucketCors -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | Specifies the bucket impacted by the @cors@configuration.
    PutBucketCors -> BucketName
bucket :: BucketName,
    -- | Describes the cross-origin access configuration for objects in an Amazon
    -- S3 bucket. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/cors.html Enabling Cross-Origin Resource Sharing>
    -- in the /Amazon S3 User Guide/.
    PutBucketCors -> CORSConfiguration
cORSConfiguration :: CORSConfiguration
  }
  deriving (PutBucketCors -> PutBucketCors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutBucketCors -> PutBucketCors -> Bool
$c/= :: PutBucketCors -> PutBucketCors -> Bool
== :: PutBucketCors -> PutBucketCors -> Bool
$c== :: PutBucketCors -> PutBucketCors -> Bool
Prelude.Eq, ReadPrec [PutBucketCors]
ReadPrec PutBucketCors
Int -> ReadS PutBucketCors
ReadS [PutBucketCors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutBucketCors]
$creadListPrec :: ReadPrec [PutBucketCors]
readPrec :: ReadPrec PutBucketCors
$creadPrec :: ReadPrec PutBucketCors
readList :: ReadS [PutBucketCors]
$creadList :: ReadS [PutBucketCors]
readsPrec :: Int -> ReadS PutBucketCors
$creadsPrec :: Int -> ReadS PutBucketCors
Prelude.Read, Int -> PutBucketCors -> ShowS
[PutBucketCors] -> ShowS
PutBucketCors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutBucketCors] -> ShowS
$cshowList :: [PutBucketCors] -> ShowS
show :: PutBucketCors -> String
$cshow :: PutBucketCors -> String
showsPrec :: Int -> PutBucketCors -> ShowS
$cshowsPrec :: Int -> PutBucketCors -> ShowS
Prelude.Show, forall x. Rep PutBucketCors x -> PutBucketCors
forall x. PutBucketCors -> Rep PutBucketCors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutBucketCors x -> PutBucketCors
$cfrom :: forall x. PutBucketCors -> Rep PutBucketCors x
Prelude.Generic)

-- |
-- Create a value of 'PutBucketCors' 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', 'putBucketCors_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', 'putBucketCors_contentMD5' - The base64-encoded 128-bit MD5 digest of the data. This header must be
-- used as a message integrity check to verify that the request body was
-- not corrupted in transit. For more information, go to
-- <http://www.ietf.org/rfc/rfc1864.txt RFC 1864.>
--
-- For requests made using the Amazon Web Services Command Line Interface
-- (CLI) or Amazon Web Services SDKs, this field is calculated
-- automatically.
--
-- 'expectedBucketOwner', 'putBucketCors_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', 'putBucketCors_bucket' - Specifies the bucket impacted by the @cors@configuration.
--
-- 'cORSConfiguration', 'putBucketCors_cORSConfiguration' - Describes the cross-origin access configuration for objects in an Amazon
-- S3 bucket. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/cors.html Enabling Cross-Origin Resource Sharing>
-- in the /Amazon S3 User Guide/.
newPutBucketCors ::
  -- | 'bucket'
  BucketName ->
  -- | 'cORSConfiguration'
  CORSConfiguration ->
  PutBucketCors
newPutBucketCors :: BucketName -> CORSConfiguration -> PutBucketCors
newPutBucketCors BucketName
pBucket_ CORSConfiguration
pCORSConfiguration_ =
  PutBucketCors'
    { $sel:checksumAlgorithm:PutBucketCors' :: Maybe ChecksumAlgorithm
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:contentMD5:PutBucketCors' :: Maybe Text
contentMD5 = forall a. Maybe a
Prelude.Nothing,
      $sel:expectedBucketOwner:PutBucketCors' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:PutBucketCors' :: BucketName
bucket = BucketName
pBucket_,
      $sel:cORSConfiguration:PutBucketCors' :: CORSConfiguration
cORSConfiguration = CORSConfiguration
pCORSConfiguration_
    }

-- | 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.
putBucketCors_checksumAlgorithm :: Lens.Lens' PutBucketCors (Prelude.Maybe ChecksumAlgorithm)
putBucketCors_checksumAlgorithm :: Lens' PutBucketCors (Maybe ChecksumAlgorithm)
putBucketCors_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketCors' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:PutBucketCors' :: PutBucketCors -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: PutBucketCors
s@PutBucketCors' {} Maybe ChecksumAlgorithm
a -> PutBucketCors
s {$sel:checksumAlgorithm:PutBucketCors' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: PutBucketCors)

-- | The base64-encoded 128-bit MD5 digest of the data. This header must be
-- used as a message integrity check to verify that the request body was
-- not corrupted in transit. For more information, go to
-- <http://www.ietf.org/rfc/rfc1864.txt RFC 1864.>
--
-- For requests made using the Amazon Web Services Command Line Interface
-- (CLI) or Amazon Web Services SDKs, this field is calculated
-- automatically.
putBucketCors_contentMD5 :: Lens.Lens' PutBucketCors (Prelude.Maybe Prelude.Text)
putBucketCors_contentMD5 :: Lens' PutBucketCors (Maybe Text)
putBucketCors_contentMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketCors' {Maybe Text
contentMD5 :: Maybe Text
$sel:contentMD5:PutBucketCors' :: PutBucketCors -> Maybe Text
contentMD5} -> Maybe Text
contentMD5) (\s :: PutBucketCors
s@PutBucketCors' {} Maybe Text
a -> PutBucketCors
s {$sel:contentMD5:PutBucketCors' :: Maybe Text
contentMD5 = Maybe Text
a} :: PutBucketCors)

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

-- | Specifies the bucket impacted by the @cors@configuration.
putBucketCors_bucket :: Lens.Lens' PutBucketCors BucketName
putBucketCors_bucket :: Lens' PutBucketCors BucketName
putBucketCors_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketCors' {BucketName
bucket :: BucketName
$sel:bucket:PutBucketCors' :: PutBucketCors -> BucketName
bucket} -> BucketName
bucket) (\s :: PutBucketCors
s@PutBucketCors' {} BucketName
a -> PutBucketCors
s {$sel:bucket:PutBucketCors' :: BucketName
bucket = BucketName
a} :: PutBucketCors)

-- | Describes the cross-origin access configuration for objects in an Amazon
-- S3 bucket. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/cors.html Enabling Cross-Origin Resource Sharing>
-- in the /Amazon S3 User Guide/.
putBucketCors_cORSConfiguration :: Lens.Lens' PutBucketCors CORSConfiguration
putBucketCors_cORSConfiguration :: Lens' PutBucketCors CORSConfiguration
putBucketCors_cORSConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBucketCors' {CORSConfiguration
cORSConfiguration :: CORSConfiguration
$sel:cORSConfiguration:PutBucketCors' :: PutBucketCors -> CORSConfiguration
cORSConfiguration} -> CORSConfiguration
cORSConfiguration) (\s :: PutBucketCors
s@PutBucketCors' {} CORSConfiguration
a -> PutBucketCors
s {$sel:cORSConfiguration:PutBucketCors' :: CORSConfiguration
cORSConfiguration = CORSConfiguration
a} :: PutBucketCors)

instance Core.AWSRequest PutBucketCors where
  type
    AWSResponse PutBucketCors =
      PutBucketCorsResponse
  request :: (Service -> Service) -> PutBucketCors -> Request PutBucketCors
request Service -> Service
overrides =
    forall a. Request a -> Request a
Request.contentMD5Header
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. 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 PutBucketCors
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutBucketCors)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutBucketCorsResponse
PutBucketCorsResponse'

instance Prelude.Hashable PutBucketCors where
  hashWithSalt :: Int -> PutBucketCors -> Int
hashWithSalt Int
_salt PutBucketCors' {Maybe Text
Maybe ChecksumAlgorithm
BucketName
CORSConfiguration
cORSConfiguration :: CORSConfiguration
bucket :: BucketName
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:cORSConfiguration:PutBucketCors' :: PutBucketCors -> CORSConfiguration
$sel:bucket:PutBucketCors' :: PutBucketCors -> BucketName
$sel:expectedBucketOwner:PutBucketCors' :: PutBucketCors -> Maybe Text
$sel:contentMD5:PutBucketCors' :: PutBucketCors -> Maybe Text
$sel:checksumAlgorithm:PutBucketCors' :: PutBucketCors -> 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` BucketName
bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CORSConfiguration
cORSConfiguration

instance Prelude.NFData PutBucketCors where
  rnf :: PutBucketCors -> ()
rnf PutBucketCors' {Maybe Text
Maybe ChecksumAlgorithm
BucketName
CORSConfiguration
cORSConfiguration :: CORSConfiguration
bucket :: BucketName
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:cORSConfiguration:PutBucketCors' :: PutBucketCors -> CORSConfiguration
$sel:bucket:PutBucketCors' :: PutBucketCors -> BucketName
$sel:expectedBucketOwner:PutBucketCors' :: PutBucketCors -> Maybe Text
$sel:contentMD5:PutBucketCors' :: PutBucketCors -> Maybe Text
$sel:checksumAlgorithm:PutBucketCors' :: PutBucketCors -> 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 BucketName
bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CORSConfiguration
cORSConfiguration

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

instance Data.ToHeaders PutBucketCors where
  toHeaders :: PutBucketCors -> [Header]
toHeaders PutBucketCors' {Maybe Text
Maybe ChecksumAlgorithm
BucketName
CORSConfiguration
cORSConfiguration :: CORSConfiguration
bucket :: BucketName
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:cORSConfiguration:PutBucketCors' :: PutBucketCors -> CORSConfiguration
$sel:bucket:PutBucketCors' :: PutBucketCors -> BucketName
$sel:expectedBucketOwner:PutBucketCors' :: PutBucketCors -> Maybe Text
$sel:contentMD5:PutBucketCors' :: PutBucketCors -> Maybe Text
$sel:checksumAlgorithm:PutBucketCors' :: PutBucketCors -> Maybe ChecksumAlgorithm
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-sdk-checksum-algorithm"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe ChecksumAlgorithm
checksumAlgorithm,
        HeaderName
"Content-MD5" forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
contentMD5,
        HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
expectedBucketOwner
      ]

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

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

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

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

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