{-# 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.UpdateLocationObjectStorage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates some parameters of an existing object storage location that
-- DataSync accesses for a transfer. For information about creating a
-- self-managed object storage location, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-object-location.html Creating a location for object storage>.
module Amazonka.DataSync.UpdateLocationObjectStorage
  ( -- * Creating a Request
    UpdateLocationObjectStorage (..),
    newUpdateLocationObjectStorage,

    -- * Request Lenses
    updateLocationObjectStorage_accessKey,
    updateLocationObjectStorage_agentArns,
    updateLocationObjectStorage_secretKey,
    updateLocationObjectStorage_serverCertificate,
    updateLocationObjectStorage_serverPort,
    updateLocationObjectStorage_serverProtocol,
    updateLocationObjectStorage_subdirectory,
    updateLocationObjectStorage_locationArn,

    -- * Destructuring the Response
    UpdateLocationObjectStorageResponse (..),
    newUpdateLocationObjectStorageResponse,

    -- * Response Lenses
    updateLocationObjectStorageResponse_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

-- | /See:/ 'newUpdateLocationObjectStorage' smart constructor.
data UpdateLocationObjectStorage = UpdateLocationObjectStorage'
  { -- | Specifies the access key (for example, a user name) if credentials are
    -- required to authenticate with the object storage server.
    UpdateLocationObjectStorage -> Maybe Text
accessKey :: Prelude.Maybe Prelude.Text,
    -- | Specifies the Amazon Resource Names (ARNs) of the DataSync agents that
    -- can securely connect with your location.
    UpdateLocationObjectStorage -> Maybe (NonEmpty Text)
agentArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | Specifies the secret key (for example, a password) if credentials are
    -- required to authenticate with the object storage server.
    UpdateLocationObjectStorage -> 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@.
    --
    -- Updating the certificate doesn\'t interfere with tasks that you have in
    -- progress.
    UpdateLocationObjectStorage -> Maybe Base64
serverCertificate :: Prelude.Maybe Data.Base64,
    -- | Specifies the port that your object storage server accepts inbound
    -- network traffic on (for example, port 443).
    UpdateLocationObjectStorage -> Maybe Natural
serverPort :: Prelude.Maybe Prelude.Natural,
    -- | Specifies the protocol that your object storage server uses to
    -- communicate.
    UpdateLocationObjectStorage -> 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.
    UpdateLocationObjectStorage -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | Specifies the ARN of the object storage system location that you\'re
    -- updating.
    UpdateLocationObjectStorage -> Text
locationArn :: Prelude.Text
  }
  deriving (UpdateLocationObjectStorage -> UpdateLocationObjectStorage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLocationObjectStorage -> UpdateLocationObjectStorage -> Bool
$c/= :: UpdateLocationObjectStorage -> UpdateLocationObjectStorage -> Bool
== :: UpdateLocationObjectStorage -> UpdateLocationObjectStorage -> Bool
$c== :: UpdateLocationObjectStorage -> UpdateLocationObjectStorage -> Bool
Prelude.Eq, Int -> UpdateLocationObjectStorage -> ShowS
[UpdateLocationObjectStorage] -> ShowS
UpdateLocationObjectStorage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLocationObjectStorage] -> ShowS
$cshowList :: [UpdateLocationObjectStorage] -> ShowS
show :: UpdateLocationObjectStorage -> String
$cshow :: UpdateLocationObjectStorage -> String
showsPrec :: Int -> UpdateLocationObjectStorage -> ShowS
$cshowsPrec :: Int -> UpdateLocationObjectStorage -> ShowS
Prelude.Show, forall x.
Rep UpdateLocationObjectStorage x -> UpdateLocationObjectStorage
forall x.
UpdateLocationObjectStorage -> Rep UpdateLocationObjectStorage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateLocationObjectStorage x -> UpdateLocationObjectStorage
$cfrom :: forall x.
UpdateLocationObjectStorage -> Rep UpdateLocationObjectStorage x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLocationObjectStorage' 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', 'updateLocationObjectStorage_accessKey' - Specifies the access key (for example, a user name) if credentials are
-- required to authenticate with the object storage server.
--
-- 'agentArns', 'updateLocationObjectStorage_agentArns' - Specifies the Amazon Resource Names (ARNs) of the DataSync agents that
-- can securely connect with your location.
--
-- 'secretKey', 'updateLocationObjectStorage_secretKey' - Specifies the secret key (for example, a password) if credentials are
-- required to authenticate with the object storage server.
--
-- 'serverCertificate', 'updateLocationObjectStorage_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@.
--
-- Updating the certificate doesn\'t interfere with tasks that you have in
-- progress.--
-- -- /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', 'updateLocationObjectStorage_serverPort' - Specifies the port that your object storage server accepts inbound
-- network traffic on (for example, port 443).
--
-- 'serverProtocol', 'updateLocationObjectStorage_serverProtocol' - Specifies the protocol that your object storage server uses to
-- communicate.
--
-- 'subdirectory', 'updateLocationObjectStorage_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.
--
-- 'locationArn', 'updateLocationObjectStorage_locationArn' - Specifies the ARN of the object storage system location that you\'re
-- updating.
newUpdateLocationObjectStorage ::
  -- | 'locationArn'
  Prelude.Text ->
  UpdateLocationObjectStorage
newUpdateLocationObjectStorage :: Text -> UpdateLocationObjectStorage
newUpdateLocationObjectStorage Text
pLocationArn_ =
  UpdateLocationObjectStorage'
    { $sel:accessKey:UpdateLocationObjectStorage' :: Maybe Text
accessKey =
        forall a. Maybe a
Prelude.Nothing,
      $sel:agentArns:UpdateLocationObjectStorage' :: Maybe (NonEmpty Text)
agentArns = forall a. Maybe a
Prelude.Nothing,
      $sel:secretKey:UpdateLocationObjectStorage' :: Maybe (Sensitive Text)
secretKey = forall a. Maybe a
Prelude.Nothing,
      $sel:serverCertificate:UpdateLocationObjectStorage' :: Maybe Base64
serverCertificate = forall a. Maybe a
Prelude.Nothing,
      $sel:serverPort:UpdateLocationObjectStorage' :: Maybe Natural
serverPort = forall a. Maybe a
Prelude.Nothing,
      $sel:serverProtocol:UpdateLocationObjectStorage' :: Maybe ObjectStorageServerProtocol
serverProtocol = forall a. Maybe a
Prelude.Nothing,
      $sel:subdirectory:UpdateLocationObjectStorage' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
      $sel:locationArn:UpdateLocationObjectStorage' :: Text
locationArn = Text
pLocationArn_
    }

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

-- | Specifies the Amazon Resource Names (ARNs) of the DataSync agents that
-- can securely connect with your location.
updateLocationObjectStorage_agentArns :: Lens.Lens' UpdateLocationObjectStorage (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
updateLocationObjectStorage_agentArns :: Lens' UpdateLocationObjectStorage (Maybe (NonEmpty Text))
updateLocationObjectStorage_agentArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationObjectStorage' {Maybe (NonEmpty Text)
agentArns :: Maybe (NonEmpty Text)
$sel:agentArns:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (NonEmpty Text)
agentArns} -> Maybe (NonEmpty Text)
agentArns) (\s :: UpdateLocationObjectStorage
s@UpdateLocationObjectStorage' {} Maybe (NonEmpty Text)
a -> UpdateLocationObjectStorage
s {$sel:agentArns:UpdateLocationObjectStorage' :: Maybe (NonEmpty Text)
agentArns = Maybe (NonEmpty Text)
a} :: UpdateLocationObjectStorage) 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 secret key (for example, a password) if credentials are
-- required to authenticate with the object storage server.
updateLocationObjectStorage_secretKey :: Lens.Lens' UpdateLocationObjectStorage (Prelude.Maybe Prelude.Text)
updateLocationObjectStorage_secretKey :: Lens' UpdateLocationObjectStorage (Maybe Text)
updateLocationObjectStorage_secretKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationObjectStorage' {Maybe (Sensitive Text)
secretKey :: Maybe (Sensitive Text)
$sel:secretKey:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (Sensitive Text)
secretKey} -> Maybe (Sensitive Text)
secretKey) (\s :: UpdateLocationObjectStorage
s@UpdateLocationObjectStorage' {} Maybe (Sensitive Text)
a -> UpdateLocationObjectStorage
s {$sel:secretKey:UpdateLocationObjectStorage' :: Maybe (Sensitive Text)
secretKey = Maybe (Sensitive Text)
a} :: UpdateLocationObjectStorage) 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@.
--
-- Updating the certificate doesn\'t interfere with tasks that you have in
-- progress.--
-- -- /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.
updateLocationObjectStorage_serverCertificate :: Lens.Lens' UpdateLocationObjectStorage (Prelude.Maybe Prelude.ByteString)
updateLocationObjectStorage_serverCertificate :: Lens' UpdateLocationObjectStorage (Maybe ByteString)
updateLocationObjectStorage_serverCertificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationObjectStorage' {Maybe Base64
serverCertificate :: Maybe Base64
$sel:serverCertificate:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Base64
serverCertificate} -> Maybe Base64
serverCertificate) (\s :: UpdateLocationObjectStorage
s@UpdateLocationObjectStorage' {} Maybe Base64
a -> UpdateLocationObjectStorage
s {$sel:serverCertificate:UpdateLocationObjectStorage' :: Maybe Base64
serverCertificate = Maybe Base64
a} :: UpdateLocationObjectStorage) 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).
updateLocationObjectStorage_serverPort :: Lens.Lens' UpdateLocationObjectStorage (Prelude.Maybe Prelude.Natural)
updateLocationObjectStorage_serverPort :: Lens' UpdateLocationObjectStorage (Maybe Natural)
updateLocationObjectStorage_serverPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationObjectStorage' {Maybe Natural
serverPort :: Maybe Natural
$sel:serverPort:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Natural
serverPort} -> Maybe Natural
serverPort) (\s :: UpdateLocationObjectStorage
s@UpdateLocationObjectStorage' {} Maybe Natural
a -> UpdateLocationObjectStorage
s {$sel:serverPort:UpdateLocationObjectStorage' :: Maybe Natural
serverPort = Maybe Natural
a} :: UpdateLocationObjectStorage)

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

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

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

instance Core.AWSRequest UpdateLocationObjectStorage where
  type
    AWSResponse UpdateLocationObjectStorage =
      UpdateLocationObjectStorageResponse
  request :: (Service -> Service)
-> UpdateLocationObjectStorage
-> Request UpdateLocationObjectStorage
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 UpdateLocationObjectStorage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateLocationObjectStorage)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateLocationObjectStorageResponse
UpdateLocationObjectStorageResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateLocationObjectStorage where
  hashWithSalt :: Int -> UpdateLocationObjectStorage -> Int
hashWithSalt Int
_salt UpdateLocationObjectStorage' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe ObjectStorageServerProtocol
Text
locationArn :: Text
subdirectory :: Maybe Text
serverProtocol :: Maybe ObjectStorageServerProtocol
serverPort :: Maybe Natural
serverCertificate :: Maybe Base64
secretKey :: Maybe (Sensitive Text)
agentArns :: Maybe (NonEmpty Text)
accessKey :: Maybe Text
$sel:locationArn:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Text
$sel:subdirectory:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Text
$sel:serverProtocol:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
$sel:serverPort:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Natural
$sel:serverCertificate:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Base64
$sel:secretKey:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (Sensitive Text)
$sel:agentArns:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (NonEmpty Text)
$sel:accessKey:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> 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 (NonEmpty Text)
agentArns
      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` Text
locationArn

instance Prelude.NFData UpdateLocationObjectStorage where
  rnf :: UpdateLocationObjectStorage -> ()
rnf UpdateLocationObjectStorage' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe ObjectStorageServerProtocol
Text
locationArn :: Text
subdirectory :: Maybe Text
serverProtocol :: Maybe ObjectStorageServerProtocol
serverPort :: Maybe Natural
serverCertificate :: Maybe Base64
secretKey :: Maybe (Sensitive Text)
agentArns :: Maybe (NonEmpty Text)
accessKey :: Maybe Text
$sel:locationArn:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Text
$sel:subdirectory:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Text
$sel:serverProtocol:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
$sel:serverPort:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Natural
$sel:serverCertificate:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Base64
$sel:secretKey:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (Sensitive Text)
$sel:agentArns:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (NonEmpty Text)
$sel:accessKey:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> 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 (NonEmpty Text)
agentArns
      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 Text
locationArn

instance Data.ToHeaders UpdateLocationObjectStorage where
  toHeaders :: UpdateLocationObjectStorage -> 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.UpdateLocationObjectStorage" ::
                          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 UpdateLocationObjectStorage where
  toJSON :: UpdateLocationObjectStorage -> Value
toJSON UpdateLocationObjectStorage' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe Base64
Maybe (Sensitive Text)
Maybe ObjectStorageServerProtocol
Text
locationArn :: Text
subdirectory :: Maybe Text
serverProtocol :: Maybe ObjectStorageServerProtocol
serverPort :: Maybe Natural
serverCertificate :: Maybe Base64
secretKey :: Maybe (Sensitive Text)
agentArns :: Maybe (NonEmpty Text)
accessKey :: Maybe Text
$sel:locationArn:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Text
$sel:subdirectory:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Text
$sel:serverProtocol:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe ObjectStorageServerProtocol
$sel:serverPort:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Natural
$sel:serverCertificate:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe Base64
$sel:secretKey:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (Sensitive Text)
$sel:agentArns:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> Maybe (NonEmpty Text)
$sel:accessKey:UpdateLocationObjectStorage' :: UpdateLocationObjectStorage -> 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
"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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"LocationArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
locationArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateLocationObjectStorageResponse' 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:
--
-- 'httpStatus', 'updateLocationObjectStorageResponse_httpStatus' - The response's http status code.
newUpdateLocationObjectStorageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateLocationObjectStorageResponse
newUpdateLocationObjectStorageResponse :: Int -> UpdateLocationObjectStorageResponse
newUpdateLocationObjectStorageResponse Int
pHttpStatus_ =
  UpdateLocationObjectStorageResponse'
    { $sel:httpStatus:UpdateLocationObjectStorageResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    UpdateLocationObjectStorageResponse
  where
  rnf :: UpdateLocationObjectStorageResponse -> ()
rnf UpdateLocationObjectStorageResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateLocationObjectStorageResponse' :: UpdateLocationObjectStorageResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus