{-# 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.DataSync.CreateLocationS3
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an endpoint for an Amazon S3 bucket that DataSync can access for
-- a transfer.
--
-- For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-locations-cli.html#create-location-s3-cli Create an Amazon S3 location>
-- in the /DataSync User Guide/.
module Amazonka.DataSync.CreateLocationS3
  ( -- * Creating a Request
    CreateLocationS3 (..),
    newCreateLocationS3,

    -- * Request Lenses
    createLocationS3_agentArns,
    createLocationS3_s3StorageClass,
    createLocationS3_subdirectory,
    createLocationS3_tags,
    createLocationS3_s3BucketArn,
    createLocationS3_s3Config,

    -- * Destructuring the Response
    CreateLocationS3Response (..),
    newCreateLocationS3Response,

    -- * Response Lenses
    createLocationS3Response_locationArn,
    createLocationS3Response_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataSync.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | CreateLocationS3Request
--
-- /See:/ 'newCreateLocationS3' smart constructor.
data CreateLocationS3 = CreateLocationS3'
  { -- | If you\'re using DataSync on an Amazon Web Services Outpost, specify the
    -- Amazon Resource Names (ARNs) of the DataSync agents deployed on your
    -- Outpost. For more information about launching a DataSync agent on an
    -- Amazon Web Services Outpost, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/deploy-agents.html#outposts-agent Deploy your DataSync agent on Outposts>.
    CreateLocationS3 -> Maybe (NonEmpty Text)
agentArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The Amazon S3 storage class that you want to store your files in when
    -- this location is used as a task destination. For buckets in Amazon Web
    -- Services Regions, the storage class defaults to Standard. For buckets on
    -- Outposts, the storage class defaults to Amazon Web Services S3 Outposts.
    --
    -- For more information about S3 storage classes, see
    -- <http://aws.amazon.com/s3/storage-classes/ Amazon S3 Storage Classes>.
    -- Some storage classes have behaviors that can affect your S3 storage
    -- cost. For detailed information, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/create-s3-location.html#using-storage-classes Considerations when working with S3 storage classes in DataSync>.
    CreateLocationS3 -> Maybe S3StorageClass
s3StorageClass :: Prelude.Maybe S3StorageClass,
    -- | A subdirectory in the Amazon S3 bucket. This subdirectory in Amazon S3
    -- is used to read data from the S3 source location or write data to the S3
    -- destination.
    CreateLocationS3 -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | The key-value pair that represents the tag that you want to add to the
    -- location. The value can be an empty string. We recommend using tags to
    -- name your resources.
    CreateLocationS3 -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | The ARN of the Amazon S3 bucket. If the bucket is on an Amazon Web
    -- Services Outpost, this must be an access point ARN.
    CreateLocationS3 -> Text
s3BucketArn :: Prelude.Text,
    CreateLocationS3 -> S3Config
s3Config :: S3Config
  }
  deriving (CreateLocationS3 -> CreateLocationS3 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationS3 -> CreateLocationS3 -> Bool
$c/= :: CreateLocationS3 -> CreateLocationS3 -> Bool
== :: CreateLocationS3 -> CreateLocationS3 -> Bool
$c== :: CreateLocationS3 -> CreateLocationS3 -> Bool
Prelude.Eq, ReadPrec [CreateLocationS3]
ReadPrec CreateLocationS3
Int -> ReadS CreateLocationS3
ReadS [CreateLocationS3]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocationS3]
$creadListPrec :: ReadPrec [CreateLocationS3]
readPrec :: ReadPrec CreateLocationS3
$creadPrec :: ReadPrec CreateLocationS3
readList :: ReadS [CreateLocationS3]
$creadList :: ReadS [CreateLocationS3]
readsPrec :: Int -> ReadS CreateLocationS3
$creadsPrec :: Int -> ReadS CreateLocationS3
Prelude.Read, Int -> CreateLocationS3 -> ShowS
[CreateLocationS3] -> ShowS
CreateLocationS3 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationS3] -> ShowS
$cshowList :: [CreateLocationS3] -> ShowS
show :: CreateLocationS3 -> String
$cshow :: CreateLocationS3 -> String
showsPrec :: Int -> CreateLocationS3 -> ShowS
$cshowsPrec :: Int -> CreateLocationS3 -> ShowS
Prelude.Show, forall x. Rep CreateLocationS3 x -> CreateLocationS3
forall x. CreateLocationS3 -> Rep CreateLocationS3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLocationS3 x -> CreateLocationS3
$cfrom :: forall x. CreateLocationS3 -> Rep CreateLocationS3 x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationS3' 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:
--
-- 'agentArns', 'createLocationS3_agentArns' - If you\'re using DataSync on an Amazon Web Services Outpost, specify the
-- Amazon Resource Names (ARNs) of the DataSync agents deployed on your
-- Outpost. For more information about launching a DataSync agent on an
-- Amazon Web Services Outpost, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/deploy-agents.html#outposts-agent Deploy your DataSync agent on Outposts>.
--
-- 's3StorageClass', 'createLocationS3_s3StorageClass' - The Amazon S3 storage class that you want to store your files in when
-- this location is used as a task destination. For buckets in Amazon Web
-- Services Regions, the storage class defaults to Standard. For buckets on
-- Outposts, the storage class defaults to Amazon Web Services S3 Outposts.
--
-- For more information about S3 storage classes, see
-- <http://aws.amazon.com/s3/storage-classes/ Amazon S3 Storage Classes>.
-- Some storage classes have behaviors that can affect your S3 storage
-- cost. For detailed information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-s3-location.html#using-storage-classes Considerations when working with S3 storage classes in DataSync>.
--
-- 'subdirectory', 'createLocationS3_subdirectory' - A subdirectory in the Amazon S3 bucket. This subdirectory in Amazon S3
-- is used to read data from the S3 source location or write data to the S3
-- destination.
--
-- 'tags', 'createLocationS3_tags' - The key-value pair that represents the tag that you want to add to the
-- location. The value can be an empty string. We recommend using tags to
-- name your resources.
--
-- 's3BucketArn', 'createLocationS3_s3BucketArn' - The ARN of the Amazon S3 bucket. If the bucket is on an Amazon Web
-- Services Outpost, this must be an access point ARN.
--
-- 's3Config', 'createLocationS3_s3Config' - Undocumented member.
newCreateLocationS3 ::
  -- | 's3BucketArn'
  Prelude.Text ->
  -- | 's3Config'
  S3Config ->
  CreateLocationS3
newCreateLocationS3 :: Text -> S3Config -> CreateLocationS3
newCreateLocationS3 Text
pS3BucketArn_ S3Config
pS3Config_ =
  CreateLocationS3'
    { $sel:agentArns:CreateLocationS3' :: Maybe (NonEmpty Text)
agentArns = forall a. Maybe a
Prelude.Nothing,
      $sel:s3StorageClass:CreateLocationS3' :: Maybe S3StorageClass
s3StorageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:subdirectory:CreateLocationS3' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateLocationS3' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:s3BucketArn:CreateLocationS3' :: Text
s3BucketArn = Text
pS3BucketArn_,
      $sel:s3Config:CreateLocationS3' :: S3Config
s3Config = S3Config
pS3Config_
    }

-- | If you\'re using DataSync on an Amazon Web Services Outpost, specify the
-- Amazon Resource Names (ARNs) of the DataSync agents deployed on your
-- Outpost. For more information about launching a DataSync agent on an
-- Amazon Web Services Outpost, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/deploy-agents.html#outposts-agent Deploy your DataSync agent on Outposts>.
createLocationS3_agentArns :: Lens.Lens' CreateLocationS3 (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createLocationS3_agentArns :: Lens' CreateLocationS3 (Maybe (NonEmpty Text))
createLocationS3_agentArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationS3' {Maybe (NonEmpty Text)
agentArns :: Maybe (NonEmpty Text)
$sel:agentArns:CreateLocationS3' :: CreateLocationS3 -> Maybe (NonEmpty Text)
agentArns} -> Maybe (NonEmpty Text)
agentArns) (\s :: CreateLocationS3
s@CreateLocationS3' {} Maybe (NonEmpty Text)
a -> CreateLocationS3
s {$sel:agentArns:CreateLocationS3' :: Maybe (NonEmpty Text)
agentArns = Maybe (NonEmpty Text)
a} :: CreateLocationS3) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon S3 storage class that you want to store your files in when
-- this location is used as a task destination. For buckets in Amazon Web
-- Services Regions, the storage class defaults to Standard. For buckets on
-- Outposts, the storage class defaults to Amazon Web Services S3 Outposts.
--
-- For more information about S3 storage classes, see
-- <http://aws.amazon.com/s3/storage-classes/ Amazon S3 Storage Classes>.
-- Some storage classes have behaviors that can affect your S3 storage
-- cost. For detailed information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-s3-location.html#using-storage-classes Considerations when working with S3 storage classes in DataSync>.
createLocationS3_s3StorageClass :: Lens.Lens' CreateLocationS3 (Prelude.Maybe S3StorageClass)
createLocationS3_s3StorageClass :: Lens' CreateLocationS3 (Maybe S3StorageClass)
createLocationS3_s3StorageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationS3' {Maybe S3StorageClass
s3StorageClass :: Maybe S3StorageClass
$sel:s3StorageClass:CreateLocationS3' :: CreateLocationS3 -> Maybe S3StorageClass
s3StorageClass} -> Maybe S3StorageClass
s3StorageClass) (\s :: CreateLocationS3
s@CreateLocationS3' {} Maybe S3StorageClass
a -> CreateLocationS3
s {$sel:s3StorageClass:CreateLocationS3' :: Maybe S3StorageClass
s3StorageClass = Maybe S3StorageClass
a} :: CreateLocationS3)

-- | A subdirectory in the Amazon S3 bucket. This subdirectory in Amazon S3
-- is used to read data from the S3 source location or write data to the S3
-- destination.
createLocationS3_subdirectory :: Lens.Lens' CreateLocationS3 (Prelude.Maybe Prelude.Text)
createLocationS3_subdirectory :: Lens' CreateLocationS3 (Maybe Text)
createLocationS3_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationS3' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:CreateLocationS3' :: CreateLocationS3 -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: CreateLocationS3
s@CreateLocationS3' {} Maybe Text
a -> CreateLocationS3
s {$sel:subdirectory:CreateLocationS3' :: Maybe Text
subdirectory = Maybe Text
a} :: CreateLocationS3)

-- | The key-value pair that represents the tag that you want to add to the
-- location. The value can be an empty string. We recommend using tags to
-- name your resources.
createLocationS3_tags :: Lens.Lens' CreateLocationS3 (Prelude.Maybe [TagListEntry])
createLocationS3_tags :: Lens' CreateLocationS3 (Maybe [TagListEntry])
createLocationS3_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationS3' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateLocationS3' :: CreateLocationS3 -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateLocationS3
s@CreateLocationS3' {} Maybe [TagListEntry]
a -> CreateLocationS3
s {$sel:tags:CreateLocationS3' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateLocationS3) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ARN of the Amazon S3 bucket. If the bucket is on an Amazon Web
-- Services Outpost, this must be an access point ARN.
createLocationS3_s3BucketArn :: Lens.Lens' CreateLocationS3 Prelude.Text
createLocationS3_s3BucketArn :: Lens' CreateLocationS3 Text
createLocationS3_s3BucketArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationS3' {Text
s3BucketArn :: Text
$sel:s3BucketArn:CreateLocationS3' :: CreateLocationS3 -> Text
s3BucketArn} -> Text
s3BucketArn) (\s :: CreateLocationS3
s@CreateLocationS3' {} Text
a -> CreateLocationS3
s {$sel:s3BucketArn:CreateLocationS3' :: Text
s3BucketArn = Text
a} :: CreateLocationS3)

-- | Undocumented member.
createLocationS3_s3Config :: Lens.Lens' CreateLocationS3 S3Config
createLocationS3_s3Config :: Lens' CreateLocationS3 S3Config
createLocationS3_s3Config = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationS3' {S3Config
s3Config :: S3Config
$sel:s3Config:CreateLocationS3' :: CreateLocationS3 -> S3Config
s3Config} -> S3Config
s3Config) (\s :: CreateLocationS3
s@CreateLocationS3' {} S3Config
a -> CreateLocationS3
s {$sel:s3Config:CreateLocationS3' :: S3Config
s3Config = S3Config
a} :: CreateLocationS3)

instance Core.AWSRequest CreateLocationS3 where
  type
    AWSResponse CreateLocationS3 =
      CreateLocationS3Response
  request :: (Service -> Service)
-> CreateLocationS3 -> Request CreateLocationS3
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateLocationS3
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLocationS3)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateLocationS3Response
CreateLocationS3Response'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LocationArn")
            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 CreateLocationS3 where
  hashWithSalt :: Int -> CreateLocationS3 -> Int
hashWithSalt Int
_salt CreateLocationS3' {Maybe [TagListEntry]
Maybe (NonEmpty Text)
Maybe Text
Maybe S3StorageClass
Text
S3Config
s3Config :: S3Config
s3BucketArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
s3StorageClass :: Maybe S3StorageClass
agentArns :: Maybe (NonEmpty Text)
$sel:s3Config:CreateLocationS3' :: CreateLocationS3 -> S3Config
$sel:s3BucketArn:CreateLocationS3' :: CreateLocationS3 -> Text
$sel:tags:CreateLocationS3' :: CreateLocationS3 -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationS3' :: CreateLocationS3 -> Maybe Text
$sel:s3StorageClass:CreateLocationS3' :: CreateLocationS3 -> Maybe S3StorageClass
$sel:agentArns:CreateLocationS3' :: CreateLocationS3 -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
agentArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3StorageClass
s3StorageClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
s3BucketArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Config
s3Config

instance Prelude.NFData CreateLocationS3 where
  rnf :: CreateLocationS3 -> ()
rnf CreateLocationS3' {Maybe [TagListEntry]
Maybe (NonEmpty Text)
Maybe Text
Maybe S3StorageClass
Text
S3Config
s3Config :: S3Config
s3BucketArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
s3StorageClass :: Maybe S3StorageClass
agentArns :: Maybe (NonEmpty Text)
$sel:s3Config:CreateLocationS3' :: CreateLocationS3 -> S3Config
$sel:s3BucketArn:CreateLocationS3' :: CreateLocationS3 -> Text
$sel:tags:CreateLocationS3' :: CreateLocationS3 -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationS3' :: CreateLocationS3 -> Maybe Text
$sel:s3StorageClass:CreateLocationS3' :: CreateLocationS3 -> Maybe S3StorageClass
$sel:agentArns:CreateLocationS3' :: CreateLocationS3 -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
agentArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3StorageClass
s3StorageClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subdirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagListEntry]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
s3BucketArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3Config
s3Config

instance Data.ToHeaders CreateLocationS3 where
  toHeaders :: CreateLocationS3 -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"FmrsService.CreateLocationS3" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateLocationS3 where
  toJSON :: CreateLocationS3 -> Value
toJSON CreateLocationS3' {Maybe [TagListEntry]
Maybe (NonEmpty Text)
Maybe Text
Maybe S3StorageClass
Text
S3Config
s3Config :: S3Config
s3BucketArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
s3StorageClass :: Maybe S3StorageClass
agentArns :: Maybe (NonEmpty Text)
$sel:s3Config:CreateLocationS3' :: CreateLocationS3 -> S3Config
$sel:s3BucketArn:CreateLocationS3' :: CreateLocationS3 -> Text
$sel:tags:CreateLocationS3' :: CreateLocationS3 -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationS3' :: CreateLocationS3 -> Maybe Text
$sel:s3StorageClass:CreateLocationS3' :: CreateLocationS3 -> Maybe S3StorageClass
$sel:agentArns:CreateLocationS3' :: CreateLocationS3 -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AgentArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
agentArns,
            (Key
"S3StorageClass" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe S3StorageClass
s3StorageClass,
            (Key
"Subdirectory" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
subdirectory,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagListEntry]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"S3BucketArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
s3BucketArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"S3Config" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3Config
s3Config)
          ]
      )

instance Data.ToPath CreateLocationS3 where
  toPath :: CreateLocationS3 -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | CreateLocationS3Response
--
-- /See:/ 'newCreateLocationS3Response' smart constructor.
data CreateLocationS3Response = CreateLocationS3Response'
  { -- | The Amazon Resource Name (ARN) of the source Amazon S3 bucket location
    -- that is created.
    CreateLocationS3Response -> Maybe Text
locationArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateLocationS3Response -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLocationS3Response -> CreateLocationS3Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationS3Response -> CreateLocationS3Response -> Bool
$c/= :: CreateLocationS3Response -> CreateLocationS3Response -> Bool
== :: CreateLocationS3Response -> CreateLocationS3Response -> Bool
$c== :: CreateLocationS3Response -> CreateLocationS3Response -> Bool
Prelude.Eq, ReadPrec [CreateLocationS3Response]
ReadPrec CreateLocationS3Response
Int -> ReadS CreateLocationS3Response
ReadS [CreateLocationS3Response]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocationS3Response]
$creadListPrec :: ReadPrec [CreateLocationS3Response]
readPrec :: ReadPrec CreateLocationS3Response
$creadPrec :: ReadPrec CreateLocationS3Response
readList :: ReadS [CreateLocationS3Response]
$creadList :: ReadS [CreateLocationS3Response]
readsPrec :: Int -> ReadS CreateLocationS3Response
$creadsPrec :: Int -> ReadS CreateLocationS3Response
Prelude.Read, Int -> CreateLocationS3Response -> ShowS
[CreateLocationS3Response] -> ShowS
CreateLocationS3Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationS3Response] -> ShowS
$cshowList :: [CreateLocationS3Response] -> ShowS
show :: CreateLocationS3Response -> String
$cshow :: CreateLocationS3Response -> String
showsPrec :: Int -> CreateLocationS3Response -> ShowS
$cshowsPrec :: Int -> CreateLocationS3Response -> ShowS
Prelude.Show, forall x.
Rep CreateLocationS3Response x -> CreateLocationS3Response
forall x.
CreateLocationS3Response -> Rep CreateLocationS3Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLocationS3Response x -> CreateLocationS3Response
$cfrom :: forall x.
CreateLocationS3Response -> Rep CreateLocationS3Response x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationS3Response' 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:
--
-- 'locationArn', 'createLocationS3Response_locationArn' - The Amazon Resource Name (ARN) of the source Amazon S3 bucket location
-- that is created.
--
-- 'httpStatus', 'createLocationS3Response_httpStatus' - The response's http status code.
newCreateLocationS3Response ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationS3Response
newCreateLocationS3Response :: Int -> CreateLocationS3Response
newCreateLocationS3Response Int
pHttpStatus_ =
  CreateLocationS3Response'
    { $sel:locationArn:CreateLocationS3Response' :: Maybe Text
locationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationS3Response' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the source Amazon S3 bucket location
-- that is created.
createLocationS3Response_locationArn :: Lens.Lens' CreateLocationS3Response (Prelude.Maybe Prelude.Text)
createLocationS3Response_locationArn :: Lens' CreateLocationS3Response (Maybe Text)
createLocationS3Response_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationS3Response' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:CreateLocationS3Response' :: CreateLocationS3Response -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: CreateLocationS3Response
s@CreateLocationS3Response' {} Maybe Text
a -> CreateLocationS3Response
s {$sel:locationArn:CreateLocationS3Response' :: Maybe Text
locationArn = Maybe Text
a} :: CreateLocationS3Response)

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

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