{-# 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.CreateLocationObjectStorage
-- 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 object storage system that DataSync can
-- access for a transfer. For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-object-location.html Creating a location for object storage>.
module Amazonka.DataSync.CreateLocationObjectStorage
  ( -- * Creating a Request
    CreateLocationObjectStorage (..),
    newCreateLocationObjectStorage,

    -- * Request Lenses
    createLocationObjectStorage_accessKey,
    createLocationObjectStorage_secretKey,
    createLocationObjectStorage_serverCertificate,
    createLocationObjectStorage_serverPort,
    createLocationObjectStorage_serverProtocol,
    createLocationObjectStorage_subdirectory,
    createLocationObjectStorage_tags,
    createLocationObjectStorage_serverHostname,
    createLocationObjectStorage_bucketName,
    createLocationObjectStorage_agentArns,

    -- * Destructuring the Response
    CreateLocationObjectStorageResponse (..),
    newCreateLocationObjectStorageResponse,

    -- * Response Lenses
    createLocationObjectStorageResponse_locationArn,
    createLocationObjectStorageResponse_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

-- | CreateLocationObjectStorageRequest
--
-- /See:/ 'newCreateLocationObjectStorage' smart constructor.
data CreateLocationObjectStorage = CreateLocationObjectStorage'
  { -- | Specifies the access key (for example, a user name) if credentials are
    -- required to authenticate with the object storage server.
    CreateLocationObjectStorage -> Maybe Text
accessKey :: Prelude.Maybe Prelude.Text,
    -- | Specifies the secret key (for example, a password) if credentials are
    -- required to authenticate with the object storage server.
    CreateLocationObjectStorage -> Maybe (Sensitive Text)
secretKey :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Specifies a certificate to authenticate with an object storage system
    -- that uses a private or self-signed certificate authority (CA). You must
    -- specify a Base64-encoded @.pem@ file (for example,
    -- @file:\/\/\/home\/user\/.ssh\/storage_sys_certificate.pem@). The
    -- certificate can be up to 32768 bytes (before Base64 encoding).
    --
    -- To use this parameter, configure @ServerProtocol@ to @HTTPS@.
    CreateLocationObjectStorage -> Maybe Base64
serverCertificate :: Prelude.Maybe Data.Base64,
    -- | Specifies the port that your object storage server accepts inbound
    -- network traffic on (for example, port 443).
    CreateLocationObjectStorage -> Maybe Natural
serverPort :: Prelude.Maybe Prelude.Natural,
    -- | Specifies the protocol that your object storage server uses to
    -- communicate.
    CreateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
serverProtocol :: Prelude.Maybe ObjectStorageServerProtocol,
    -- | Specifies the object prefix for your object storage server. If this is a
    -- source location, DataSync only copies objects with this prefix. If this
    -- is a destination location, DataSync writes all objects with this prefix.
    CreateLocationObjectStorage -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | Specifies the key-value pair that represents a tag that you want to add
    -- to the resource. Tags can help you manage, filter, and search for your
    -- resources. We recommend creating a name tag for your location.
    CreateLocationObjectStorage -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | Specifies the domain name or IP address of the object storage server. A
    -- DataSync agent uses this hostname to mount the object storage server in
    -- a network.
    CreateLocationObjectStorage -> Text
serverHostname :: Prelude.Text,
    -- | Specifies the name of the object storage bucket involved in the
    -- transfer.
    CreateLocationObjectStorage -> Text
bucketName :: Prelude.Text,
    -- | Specifies the Amazon Resource Names (ARNs) of the DataSync agents that
    -- can securely connect with your location.
    CreateLocationObjectStorage -> NonEmpty Text
agentArns :: Prelude.NonEmpty Prelude.Text
  }
  deriving (CreateLocationObjectStorage -> CreateLocationObjectStorage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationObjectStorage -> CreateLocationObjectStorage -> Bool
$c/= :: CreateLocationObjectStorage -> CreateLocationObjectStorage -> Bool
== :: CreateLocationObjectStorage -> CreateLocationObjectStorage -> Bool
$c== :: CreateLocationObjectStorage -> CreateLocationObjectStorage -> Bool
Prelude.Eq, Int -> CreateLocationObjectStorage -> ShowS
[CreateLocationObjectStorage] -> ShowS
CreateLocationObjectStorage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationObjectStorage] -> ShowS
$cshowList :: [CreateLocationObjectStorage] -> ShowS
show :: CreateLocationObjectStorage -> String
$cshow :: CreateLocationObjectStorage -> String
showsPrec :: Int -> CreateLocationObjectStorage -> ShowS
$cshowsPrec :: Int -> CreateLocationObjectStorage -> ShowS
Prelude.Show, forall x.
Rep CreateLocationObjectStorage x -> CreateLocationObjectStorage
forall x.
CreateLocationObjectStorage -> Rep CreateLocationObjectStorage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLocationObjectStorage x -> CreateLocationObjectStorage
$cfrom :: forall x.
CreateLocationObjectStorage -> Rep CreateLocationObjectStorage x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationObjectStorage' 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:
--
-- 'accessKey', 'createLocationObjectStorage_accessKey' - Specifies the access key (for example, a user name) if credentials are
-- required to authenticate with the object storage server.
--
-- 'secretKey', 'createLocationObjectStorage_secretKey' - Specifies the secret key (for example, a password) if credentials are
-- required to authenticate with the object storage server.
--
-- 'serverCertificate', 'createLocationObjectStorage_serverCertificate' - Specifies a certificate to authenticate with an object storage system
-- that uses a private or self-signed certificate authority (CA). You must
-- specify a Base64-encoded @.pem@ file (for example,
-- @file:\/\/\/home\/user\/.ssh\/storage_sys_certificate.pem@). The
-- certificate can be up to 32768 bytes (before Base64 encoding).
--
-- To use this parameter, configure @ServerProtocol@ to @HTTPS@.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'serverPort', 'createLocationObjectStorage_serverPort' - Specifies the port that your object storage server accepts inbound
-- network traffic on (for example, port 443).
--
-- 'serverProtocol', 'createLocationObjectStorage_serverProtocol' - Specifies the protocol that your object storage server uses to
-- communicate.
--
-- 'subdirectory', 'createLocationObjectStorage_subdirectory' - Specifies the object prefix for your object storage server. If this is a
-- source location, DataSync only copies objects with this prefix. If this
-- is a destination location, DataSync writes all objects with this prefix.
--
-- 'tags', 'createLocationObjectStorage_tags' - Specifies the key-value pair that represents a tag that you want to add
-- to the resource. Tags can help you manage, filter, and search for your
-- resources. We recommend creating a name tag for your location.
--
-- 'serverHostname', 'createLocationObjectStorage_serverHostname' - Specifies the domain name or IP address of the object storage server. A
-- DataSync agent uses this hostname to mount the object storage server in
-- a network.
--
-- 'bucketName', 'createLocationObjectStorage_bucketName' - Specifies the name of the object storage bucket involved in the
-- transfer.
--
-- 'agentArns', 'createLocationObjectStorage_agentArns' - Specifies the Amazon Resource Names (ARNs) of the DataSync agents that
-- can securely connect with your location.
newCreateLocationObjectStorage ::
  -- | 'serverHostname'
  Prelude.Text ->
  -- | 'bucketName'
  Prelude.Text ->
  -- | 'agentArns'
  Prelude.NonEmpty Prelude.Text ->
  CreateLocationObjectStorage
newCreateLocationObjectStorage :: Text -> Text -> NonEmpty Text -> CreateLocationObjectStorage
newCreateLocationObjectStorage
  Text
pServerHostname_
  Text
pBucketName_
  NonEmpty Text
pAgentArns_ =
    CreateLocationObjectStorage'
      { $sel:accessKey:CreateLocationObjectStorage' :: Maybe Text
accessKey =
          forall a. Maybe a
Prelude.Nothing,
        $sel:secretKey:CreateLocationObjectStorage' :: Maybe (Sensitive Text)
secretKey = forall a. Maybe a
Prelude.Nothing,
        $sel:serverCertificate:CreateLocationObjectStorage' :: Maybe Base64
serverCertificate = forall a. Maybe a
Prelude.Nothing,
        $sel:serverPort:CreateLocationObjectStorage' :: Maybe Natural
serverPort = forall a. Maybe a
Prelude.Nothing,
        $sel:serverProtocol:CreateLocationObjectStorage' :: Maybe ObjectStorageServerProtocol
serverProtocol = forall a. Maybe a
Prelude.Nothing,
        $sel:subdirectory:CreateLocationObjectStorage' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLocationObjectStorage' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:serverHostname:CreateLocationObjectStorage' :: Text
serverHostname = Text
pServerHostname_,
        $sel:bucketName:CreateLocationObjectStorage' :: Text
bucketName = Text
pBucketName_,
        $sel:agentArns:CreateLocationObjectStorage' :: NonEmpty Text
agentArns = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pAgentArns_
      }

-- | Specifies the access key (for example, a user name) if credentials are
-- required to authenticate with the object storage server.
createLocationObjectStorage_accessKey :: Lens.Lens' CreateLocationObjectStorage (Prelude.Maybe Prelude.Text)
createLocationObjectStorage_accessKey :: Lens' CreateLocationObjectStorage (Maybe Text)
createLocationObjectStorage_accessKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Maybe Text
accessKey :: Maybe Text
$sel:accessKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
accessKey} -> Maybe Text
accessKey) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Maybe Text
a -> CreateLocationObjectStorage
s {$sel:accessKey:CreateLocationObjectStorage' :: Maybe Text
accessKey = Maybe Text
a} :: CreateLocationObjectStorage)

-- | Specifies the secret key (for example, a password) if credentials are
-- required to authenticate with the object storage server.
createLocationObjectStorage_secretKey :: Lens.Lens' CreateLocationObjectStorage (Prelude.Maybe Prelude.Text)
createLocationObjectStorage_secretKey :: Lens' CreateLocationObjectStorage (Maybe Text)
createLocationObjectStorage_secretKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Maybe (Sensitive Text)
secretKey :: Maybe (Sensitive Text)
$sel:secretKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe (Sensitive Text)
secretKey} -> Maybe (Sensitive Text)
secretKey) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Maybe (Sensitive Text)
a -> CreateLocationObjectStorage
s {$sel:secretKey:CreateLocationObjectStorage' :: Maybe (Sensitive Text)
secretKey = Maybe (Sensitive Text)
a} :: CreateLocationObjectStorage) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | Specifies a certificate to authenticate with an object storage system
-- that uses a private or self-signed certificate authority (CA). You must
-- specify a Base64-encoded @.pem@ file (for example,
-- @file:\/\/\/home\/user\/.ssh\/storage_sys_certificate.pem@). The
-- certificate can be up to 32768 bytes (before Base64 encoding).
--
-- To use this parameter, configure @ServerProtocol@ to @HTTPS@.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
createLocationObjectStorage_serverCertificate :: Lens.Lens' CreateLocationObjectStorage (Prelude.Maybe Prelude.ByteString)
createLocationObjectStorage_serverCertificate :: Lens' CreateLocationObjectStorage (Maybe ByteString)
createLocationObjectStorage_serverCertificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Maybe Base64
serverCertificate :: Maybe Base64
$sel:serverCertificate:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Base64
serverCertificate} -> Maybe Base64
serverCertificate) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Maybe Base64
a -> CreateLocationObjectStorage
s {$sel:serverCertificate:CreateLocationObjectStorage' :: Maybe Base64
serverCertificate = Maybe Base64
a} :: CreateLocationObjectStorage) 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 Iso' Base64 ByteString
Data._Base64

-- | Specifies the port that your object storage server accepts inbound
-- network traffic on (for example, port 443).
createLocationObjectStorage_serverPort :: Lens.Lens' CreateLocationObjectStorage (Prelude.Maybe Prelude.Natural)
createLocationObjectStorage_serverPort :: Lens' CreateLocationObjectStorage (Maybe Natural)
createLocationObjectStorage_serverPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Maybe Natural
serverPort :: Maybe Natural
$sel:serverPort:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Natural
serverPort} -> Maybe Natural
serverPort) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Maybe Natural
a -> CreateLocationObjectStorage
s {$sel:serverPort:CreateLocationObjectStorage' :: Maybe Natural
serverPort = Maybe Natural
a} :: CreateLocationObjectStorage)

-- | Specifies the protocol that your object storage server uses to
-- communicate.
createLocationObjectStorage_serverProtocol :: Lens.Lens' CreateLocationObjectStorage (Prelude.Maybe ObjectStorageServerProtocol)
createLocationObjectStorage_serverProtocol :: Lens'
  CreateLocationObjectStorage (Maybe ObjectStorageServerProtocol)
createLocationObjectStorage_serverProtocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Maybe ObjectStorageServerProtocol
serverProtocol :: Maybe ObjectStorageServerProtocol
$sel:serverProtocol:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
serverProtocol} -> Maybe ObjectStorageServerProtocol
serverProtocol) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Maybe ObjectStorageServerProtocol
a -> CreateLocationObjectStorage
s {$sel:serverProtocol:CreateLocationObjectStorage' :: Maybe ObjectStorageServerProtocol
serverProtocol = Maybe ObjectStorageServerProtocol
a} :: CreateLocationObjectStorage)

-- | Specifies the object prefix for your object storage server. If this is a
-- source location, DataSync only copies objects with this prefix. If this
-- is a destination location, DataSync writes all objects with this prefix.
createLocationObjectStorage_subdirectory :: Lens.Lens' CreateLocationObjectStorage (Prelude.Maybe Prelude.Text)
createLocationObjectStorage_subdirectory :: Lens' CreateLocationObjectStorage (Maybe Text)
createLocationObjectStorage_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Maybe Text
a -> CreateLocationObjectStorage
s {$sel:subdirectory:CreateLocationObjectStorage' :: Maybe Text
subdirectory = Maybe Text
a} :: CreateLocationObjectStorage)

-- | Specifies the key-value pair that represents a tag that you want to add
-- to the resource. Tags can help you manage, filter, and search for your
-- resources. We recommend creating a name tag for your location.
createLocationObjectStorage_tags :: Lens.Lens' CreateLocationObjectStorage (Prelude.Maybe [TagListEntry])
createLocationObjectStorage_tags :: Lens' CreateLocationObjectStorage (Maybe [TagListEntry])
createLocationObjectStorage_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Maybe [TagListEntry]
a -> CreateLocationObjectStorage
s {$sel:tags:CreateLocationObjectStorage' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateLocationObjectStorage) 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

-- | Specifies the domain name or IP address of the object storage server. A
-- DataSync agent uses this hostname to mount the object storage server in
-- a network.
createLocationObjectStorage_serverHostname :: Lens.Lens' CreateLocationObjectStorage Prelude.Text
createLocationObjectStorage_serverHostname :: Lens' CreateLocationObjectStorage Text
createLocationObjectStorage_serverHostname = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Text
serverHostname :: Text
$sel:serverHostname:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
serverHostname} -> Text
serverHostname) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Text
a -> CreateLocationObjectStorage
s {$sel:serverHostname:CreateLocationObjectStorage' :: Text
serverHostname = Text
a} :: CreateLocationObjectStorage)

-- | Specifies the name of the object storage bucket involved in the
-- transfer.
createLocationObjectStorage_bucketName :: Lens.Lens' CreateLocationObjectStorage Prelude.Text
createLocationObjectStorage_bucketName :: Lens' CreateLocationObjectStorage Text
createLocationObjectStorage_bucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {Text
bucketName :: Text
$sel:bucketName:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
bucketName} -> Text
bucketName) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} Text
a -> CreateLocationObjectStorage
s {$sel:bucketName:CreateLocationObjectStorage' :: Text
bucketName = Text
a} :: CreateLocationObjectStorage)

-- | Specifies the Amazon Resource Names (ARNs) of the DataSync agents that
-- can securely connect with your location.
createLocationObjectStorage_agentArns :: Lens.Lens' CreateLocationObjectStorage (Prelude.NonEmpty Prelude.Text)
createLocationObjectStorage_agentArns :: Lens' CreateLocationObjectStorage (NonEmpty Text)
createLocationObjectStorage_agentArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorage' {NonEmpty Text
agentArns :: NonEmpty Text
$sel:agentArns:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> NonEmpty Text
agentArns} -> NonEmpty Text
agentArns) (\s :: CreateLocationObjectStorage
s@CreateLocationObjectStorage' {} NonEmpty Text
a -> CreateLocationObjectStorage
s {$sel:agentArns:CreateLocationObjectStorage' :: NonEmpty Text
agentArns = NonEmpty Text
a} :: CreateLocationObjectStorage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateLocationObjectStorage where
  type
    AWSResponse CreateLocationObjectStorage =
      CreateLocationObjectStorageResponse
  request :: (Service -> Service)
-> CreateLocationObjectStorage
-> Request CreateLocationObjectStorage
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 CreateLocationObjectStorage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLocationObjectStorage)))
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 -> CreateLocationObjectStorageResponse
CreateLocationObjectStorageResponse'
            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 CreateLocationObjectStorage where
  hashWithSalt :: Int -> CreateLocationObjectStorage -> Int
hashWithSalt Int
_salt CreateLocationObjectStorage' {Maybe Natural
Maybe [TagListEntry]
Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe ObjectStorageServerProtocol
NonEmpty Text
Text
agentArns :: NonEmpty Text
bucketName :: Text
serverHostname :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
serverProtocol :: Maybe ObjectStorageServerProtocol
serverPort :: Maybe Natural
serverCertificate :: Maybe Base64
secretKey :: Maybe (Sensitive Text)
accessKey :: Maybe Text
$sel:agentArns:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> NonEmpty Text
$sel:bucketName:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
$sel:serverHostname:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
$sel:tags:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
$sel:serverProtocol:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
$sel:serverPort:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Natural
$sel:serverCertificate:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Base64
$sel:secretKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe (Sensitive Text)
$sel:accessKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accessKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
secretKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
serverCertificate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
serverPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ObjectStorageServerProtocol
serverProtocol
      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
serverHostname
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
agentArns

instance Prelude.NFData CreateLocationObjectStorage where
  rnf :: CreateLocationObjectStorage -> ()
rnf CreateLocationObjectStorage' {Maybe Natural
Maybe [TagListEntry]
Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe ObjectStorageServerProtocol
NonEmpty Text
Text
agentArns :: NonEmpty Text
bucketName :: Text
serverHostname :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
serverProtocol :: Maybe ObjectStorageServerProtocol
serverPort :: Maybe Natural
serverCertificate :: Maybe Base64
secretKey :: Maybe (Sensitive Text)
accessKey :: Maybe Text
$sel:agentArns:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> NonEmpty Text
$sel:bucketName:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
$sel:serverHostname:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
$sel:tags:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
$sel:serverProtocol:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
$sel:serverPort:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Natural
$sel:serverCertificate:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Base64
$sel:secretKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe (Sensitive Text)
$sel:accessKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accessKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
secretKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
serverCertificate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
serverPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectStorageServerProtocol
serverProtocol
      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
serverHostname
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
agentArns

instance Data.ToHeaders CreateLocationObjectStorage where
  toHeaders :: CreateLocationObjectStorage -> 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.CreateLocationObjectStorage" ::
                          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 CreateLocationObjectStorage where
  toJSON :: CreateLocationObjectStorage -> Value
toJSON CreateLocationObjectStorage' {Maybe Natural
Maybe [TagListEntry]
Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe ObjectStorageServerProtocol
NonEmpty Text
Text
agentArns :: NonEmpty Text
bucketName :: Text
serverHostname :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
serverProtocol :: Maybe ObjectStorageServerProtocol
serverPort :: Maybe Natural
serverCertificate :: Maybe Base64
secretKey :: Maybe (Sensitive Text)
accessKey :: Maybe Text
$sel:agentArns:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> NonEmpty Text
$sel:bucketName:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
$sel:serverHostname:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Text
$sel:tags:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
$sel:serverProtocol:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
$sel:serverPort:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Natural
$sel:serverCertificate:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Base64
$sel:secretKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe (Sensitive Text)
$sel:accessKey:CreateLocationObjectStorage' :: CreateLocationObjectStorage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessKey" 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
accessKey,
            (Key
"SecretKey" 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 (Sensitive Text)
secretKey,
            (Key
"ServerCertificate" 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 Base64
serverCertificate,
            (Key
"ServerPort" 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 Natural
serverPort,
            (Key
"ServerProtocol" 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 ObjectStorageServerProtocol
serverProtocol,
            (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
"ServerHostname" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serverHostname),
            forall a. a -> Maybe a
Prelude.Just (Key
"BucketName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
bucketName),
            forall a. a -> Maybe a
Prelude.Just (Key
"AgentArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
agentArns)
          ]
      )

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

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

-- | CreateLocationObjectStorageResponse
--
-- /See:/ 'newCreateLocationObjectStorageResponse' smart constructor.
data CreateLocationObjectStorageResponse = CreateLocationObjectStorageResponse'
  { -- | Specifies the ARN of the object storage system location that you create.
    CreateLocationObjectStorageResponse -> Maybe Text
locationArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateLocationObjectStorageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLocationObjectStorageResponse
-> CreateLocationObjectStorageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationObjectStorageResponse
-> CreateLocationObjectStorageResponse -> Bool
$c/= :: CreateLocationObjectStorageResponse
-> CreateLocationObjectStorageResponse -> Bool
== :: CreateLocationObjectStorageResponse
-> CreateLocationObjectStorageResponse -> Bool
$c== :: CreateLocationObjectStorageResponse
-> CreateLocationObjectStorageResponse -> Bool
Prelude.Eq, ReadPrec [CreateLocationObjectStorageResponse]
ReadPrec CreateLocationObjectStorageResponse
Int -> ReadS CreateLocationObjectStorageResponse
ReadS [CreateLocationObjectStorageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocationObjectStorageResponse]
$creadListPrec :: ReadPrec [CreateLocationObjectStorageResponse]
readPrec :: ReadPrec CreateLocationObjectStorageResponse
$creadPrec :: ReadPrec CreateLocationObjectStorageResponse
readList :: ReadS [CreateLocationObjectStorageResponse]
$creadList :: ReadS [CreateLocationObjectStorageResponse]
readsPrec :: Int -> ReadS CreateLocationObjectStorageResponse
$creadsPrec :: Int -> ReadS CreateLocationObjectStorageResponse
Prelude.Read, Int -> CreateLocationObjectStorageResponse -> ShowS
[CreateLocationObjectStorageResponse] -> ShowS
CreateLocationObjectStorageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationObjectStorageResponse] -> ShowS
$cshowList :: [CreateLocationObjectStorageResponse] -> ShowS
show :: CreateLocationObjectStorageResponse -> String
$cshow :: CreateLocationObjectStorageResponse -> String
showsPrec :: Int -> CreateLocationObjectStorageResponse -> ShowS
$cshowsPrec :: Int -> CreateLocationObjectStorageResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLocationObjectStorageResponse x
-> CreateLocationObjectStorageResponse
forall x.
CreateLocationObjectStorageResponse
-> Rep CreateLocationObjectStorageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLocationObjectStorageResponse x
-> CreateLocationObjectStorageResponse
$cfrom :: forall x.
CreateLocationObjectStorageResponse
-> Rep CreateLocationObjectStorageResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationObjectStorageResponse' 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', 'createLocationObjectStorageResponse_locationArn' - Specifies the ARN of the object storage system location that you create.
--
-- 'httpStatus', 'createLocationObjectStorageResponse_httpStatus' - The response's http status code.
newCreateLocationObjectStorageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationObjectStorageResponse
newCreateLocationObjectStorageResponse :: Int -> CreateLocationObjectStorageResponse
newCreateLocationObjectStorageResponse Int
pHttpStatus_ =
  CreateLocationObjectStorageResponse'
    { $sel:locationArn:CreateLocationObjectStorageResponse' :: Maybe Text
locationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationObjectStorageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Specifies the ARN of the object storage system location that you create.
createLocationObjectStorageResponse_locationArn :: Lens.Lens' CreateLocationObjectStorageResponse (Prelude.Maybe Prelude.Text)
createLocationObjectStorageResponse_locationArn :: Lens' CreateLocationObjectStorageResponse (Maybe Text)
createLocationObjectStorageResponse_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationObjectStorageResponse' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:CreateLocationObjectStorageResponse' :: CreateLocationObjectStorageResponse -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: CreateLocationObjectStorageResponse
s@CreateLocationObjectStorageResponse' {} Maybe Text
a -> CreateLocationObjectStorageResponse
s {$sel:locationArn:CreateLocationObjectStorageResponse' :: Maybe Text
locationArn = Maybe Text
a} :: CreateLocationObjectStorageResponse)

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

instance
  Prelude.NFData
    CreateLocationObjectStorageResponse
  where
  rnf :: CreateLocationObjectStorageResponse -> ()
rnf CreateLocationObjectStorageResponse' {Int
Maybe Text
httpStatus :: Int
locationArn :: Maybe Text
$sel:httpStatus:CreateLocationObjectStorageResponse' :: CreateLocationObjectStorageResponse -> Int
$sel:locationArn:CreateLocationObjectStorageResponse' :: CreateLocationObjectStorageResponse -> 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