{-# 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.DescribeLocationObjectStorage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns metadata about your DataSync location for an object storage
-- system.
module Amazonka.DataSync.DescribeLocationObjectStorage
  ( -- * Creating a Request
    DescribeLocationObjectStorage (..),
    newDescribeLocationObjectStorage,

    -- * Request Lenses
    describeLocationObjectStorage_locationArn,

    -- * Destructuring the Response
    DescribeLocationObjectStorageResponse (..),
    newDescribeLocationObjectStorageResponse,

    -- * Response Lenses
    describeLocationObjectStorageResponse_accessKey,
    describeLocationObjectStorageResponse_agentArns,
    describeLocationObjectStorageResponse_creationTime,
    describeLocationObjectStorageResponse_locationArn,
    describeLocationObjectStorageResponse_locationUri,
    describeLocationObjectStorageResponse_serverCertificate,
    describeLocationObjectStorageResponse_serverPort,
    describeLocationObjectStorageResponse_serverProtocol,
    describeLocationObjectStorageResponse_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

-- | DescribeLocationObjectStorageRequest
--
-- /See:/ 'newDescribeLocationObjectStorage' smart constructor.
data DescribeLocationObjectStorage = DescribeLocationObjectStorage'
  { -- | The Amazon Resource Name (ARN) of the object storage system location
    -- that you want information about.
    DescribeLocationObjectStorage -> Text
locationArn :: Prelude.Text
  }
  deriving (DescribeLocationObjectStorage
-> DescribeLocationObjectStorage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLocationObjectStorage
-> DescribeLocationObjectStorage -> Bool
$c/= :: DescribeLocationObjectStorage
-> DescribeLocationObjectStorage -> Bool
== :: DescribeLocationObjectStorage
-> DescribeLocationObjectStorage -> Bool
$c== :: DescribeLocationObjectStorage
-> DescribeLocationObjectStorage -> Bool
Prelude.Eq, ReadPrec [DescribeLocationObjectStorage]
ReadPrec DescribeLocationObjectStorage
Int -> ReadS DescribeLocationObjectStorage
ReadS [DescribeLocationObjectStorage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLocationObjectStorage]
$creadListPrec :: ReadPrec [DescribeLocationObjectStorage]
readPrec :: ReadPrec DescribeLocationObjectStorage
$creadPrec :: ReadPrec DescribeLocationObjectStorage
readList :: ReadS [DescribeLocationObjectStorage]
$creadList :: ReadS [DescribeLocationObjectStorage]
readsPrec :: Int -> ReadS DescribeLocationObjectStorage
$creadsPrec :: Int -> ReadS DescribeLocationObjectStorage
Prelude.Read, Int -> DescribeLocationObjectStorage -> ShowS
[DescribeLocationObjectStorage] -> ShowS
DescribeLocationObjectStorage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLocationObjectStorage] -> ShowS
$cshowList :: [DescribeLocationObjectStorage] -> ShowS
show :: DescribeLocationObjectStorage -> String
$cshow :: DescribeLocationObjectStorage -> String
showsPrec :: Int -> DescribeLocationObjectStorage -> ShowS
$cshowsPrec :: Int -> DescribeLocationObjectStorage -> ShowS
Prelude.Show, forall x.
Rep DescribeLocationObjectStorage x
-> DescribeLocationObjectStorage
forall x.
DescribeLocationObjectStorage
-> Rep DescribeLocationObjectStorage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeLocationObjectStorage x
-> DescribeLocationObjectStorage
$cfrom :: forall x.
DescribeLocationObjectStorage
-> Rep DescribeLocationObjectStorage x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLocationObjectStorage' 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', 'describeLocationObjectStorage_locationArn' - The Amazon Resource Name (ARN) of the object storage system location
-- that you want information about.
newDescribeLocationObjectStorage ::
  -- | 'locationArn'
  Prelude.Text ->
  DescribeLocationObjectStorage
newDescribeLocationObjectStorage :: Text -> DescribeLocationObjectStorage
newDescribeLocationObjectStorage Text
pLocationArn_ =
  DescribeLocationObjectStorage'
    { $sel:locationArn:DescribeLocationObjectStorage' :: Text
locationArn =
        Text
pLocationArn_
    }

-- | The Amazon Resource Name (ARN) of the object storage system location
-- that you want information about.
describeLocationObjectStorage_locationArn :: Lens.Lens' DescribeLocationObjectStorage Prelude.Text
describeLocationObjectStorage_locationArn :: Lens' DescribeLocationObjectStorage Text
describeLocationObjectStorage_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorage' {Text
locationArn :: Text
$sel:locationArn:DescribeLocationObjectStorage' :: DescribeLocationObjectStorage -> Text
locationArn} -> Text
locationArn) (\s :: DescribeLocationObjectStorage
s@DescribeLocationObjectStorage' {} Text
a -> DescribeLocationObjectStorage
s {$sel:locationArn:DescribeLocationObjectStorage' :: Text
locationArn = Text
a} :: DescribeLocationObjectStorage)

instance
  Core.AWSRequest
    DescribeLocationObjectStorage
  where
  type
    AWSResponse DescribeLocationObjectStorage =
      DescribeLocationObjectStorageResponse
  request :: (Service -> Service)
-> DescribeLocationObjectStorage
-> Request DescribeLocationObjectStorage
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 DescribeLocationObjectStorage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeLocationObjectStorage)))
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
-> Maybe (NonEmpty Text)
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Base64
-> Maybe Natural
-> Maybe ObjectStorageServerProtocol
-> Int
-> DescribeLocationObjectStorageResponse
DescribeLocationObjectStorageResponse'
            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
"AccessKey")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AgentArns")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreationTime")
            forall (f :: * -> *) a b. Applicative f => 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LocationUri")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ServerCertificate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ServerPort")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ServerProtocol")
            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
    DescribeLocationObjectStorage
  where
  hashWithSalt :: Int -> DescribeLocationObjectStorage -> Int
hashWithSalt Int
_salt DescribeLocationObjectStorage' {Text
locationArn :: Text
$sel:locationArn:DescribeLocationObjectStorage' :: DescribeLocationObjectStorage -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
locationArn

instance Prelude.NFData DescribeLocationObjectStorage where
  rnf :: DescribeLocationObjectStorage -> ()
rnf DescribeLocationObjectStorage' {Text
locationArn :: Text
$sel:locationArn:DescribeLocationObjectStorage' :: DescribeLocationObjectStorage -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
locationArn

instance Data.ToHeaders DescribeLocationObjectStorage where
  toHeaders :: DescribeLocationObjectStorage -> 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.DescribeLocationObjectStorage" ::
                          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 DescribeLocationObjectStorage where
  toJSON :: DescribeLocationObjectStorage -> Value
toJSON DescribeLocationObjectStorage' {Text
locationArn :: Text
$sel:locationArn:DescribeLocationObjectStorage' :: DescribeLocationObjectStorage -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 DescribeLocationObjectStorage where
  toPath :: DescribeLocationObjectStorage -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | DescribeLocationObjectStorageResponse
--
-- /See:/ 'newDescribeLocationObjectStorageResponse' smart constructor.
data DescribeLocationObjectStorageResponse = DescribeLocationObjectStorageResponse'
  { -- | The access key (for example, a user name) required to authenticate with
    -- the object storage system.
    DescribeLocationObjectStorageResponse -> Maybe Text
accessKey :: Prelude.Maybe Prelude.Text,
    -- | The ARNs of the DataSync agents that can securely connect with your
    -- location.
    DescribeLocationObjectStorageResponse -> Maybe (NonEmpty Text)
agentArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The time that the location was created.
    DescribeLocationObjectStorageResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The ARN of the object storage system location.
    DescribeLocationObjectStorageResponse -> Maybe Text
locationArn :: Prelude.Maybe Prelude.Text,
    -- | The URL of the object storage system location.
    DescribeLocationObjectStorageResponse -> Maybe Text
locationUri :: Prelude.Maybe Prelude.Text,
    -- | The self-signed certificate that DataSync uses to securely authenticate
    -- with your object storage system.
    DescribeLocationObjectStorageResponse -> Maybe Base64
serverCertificate :: Prelude.Maybe Data.Base64,
    -- | The port that your object storage server accepts inbound network traffic
    -- on (for example, port 443).
    DescribeLocationObjectStorageResponse -> Maybe Natural
serverPort :: Prelude.Maybe Prelude.Natural,
    -- | The protocol that your object storage system uses to communicate.
    DescribeLocationObjectStorageResponse
-> Maybe ObjectStorageServerProtocol
serverProtocol :: Prelude.Maybe ObjectStorageServerProtocol,
    -- | The response's http status code.
    DescribeLocationObjectStorageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeLocationObjectStorageResponse
-> DescribeLocationObjectStorageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLocationObjectStorageResponse
-> DescribeLocationObjectStorageResponse -> Bool
$c/= :: DescribeLocationObjectStorageResponse
-> DescribeLocationObjectStorageResponse -> Bool
== :: DescribeLocationObjectStorageResponse
-> DescribeLocationObjectStorageResponse -> Bool
$c== :: DescribeLocationObjectStorageResponse
-> DescribeLocationObjectStorageResponse -> Bool
Prelude.Eq, ReadPrec [DescribeLocationObjectStorageResponse]
ReadPrec DescribeLocationObjectStorageResponse
Int -> ReadS DescribeLocationObjectStorageResponse
ReadS [DescribeLocationObjectStorageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLocationObjectStorageResponse]
$creadListPrec :: ReadPrec [DescribeLocationObjectStorageResponse]
readPrec :: ReadPrec DescribeLocationObjectStorageResponse
$creadPrec :: ReadPrec DescribeLocationObjectStorageResponse
readList :: ReadS [DescribeLocationObjectStorageResponse]
$creadList :: ReadS [DescribeLocationObjectStorageResponse]
readsPrec :: Int -> ReadS DescribeLocationObjectStorageResponse
$creadsPrec :: Int -> ReadS DescribeLocationObjectStorageResponse
Prelude.Read, Int -> DescribeLocationObjectStorageResponse -> ShowS
[DescribeLocationObjectStorageResponse] -> ShowS
DescribeLocationObjectStorageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLocationObjectStorageResponse] -> ShowS
$cshowList :: [DescribeLocationObjectStorageResponse] -> ShowS
show :: DescribeLocationObjectStorageResponse -> String
$cshow :: DescribeLocationObjectStorageResponse -> String
showsPrec :: Int -> DescribeLocationObjectStorageResponse -> ShowS
$cshowsPrec :: Int -> DescribeLocationObjectStorageResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeLocationObjectStorageResponse x
-> DescribeLocationObjectStorageResponse
forall x.
DescribeLocationObjectStorageResponse
-> Rep DescribeLocationObjectStorageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeLocationObjectStorageResponse x
-> DescribeLocationObjectStorageResponse
$cfrom :: forall x.
DescribeLocationObjectStorageResponse
-> Rep DescribeLocationObjectStorageResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLocationObjectStorageResponse' 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', 'describeLocationObjectStorageResponse_accessKey' - The access key (for example, a user name) required to authenticate with
-- the object storage system.
--
-- 'agentArns', 'describeLocationObjectStorageResponse_agentArns' - The ARNs of the DataSync agents that can securely connect with your
-- location.
--
-- 'creationTime', 'describeLocationObjectStorageResponse_creationTime' - The time that the location was created.
--
-- 'locationArn', 'describeLocationObjectStorageResponse_locationArn' - The ARN of the object storage system location.
--
-- 'locationUri', 'describeLocationObjectStorageResponse_locationUri' - The URL of the object storage system location.
--
-- 'serverCertificate', 'describeLocationObjectStorageResponse_serverCertificate' - The self-signed certificate that DataSync uses to securely authenticate
-- with your object storage system.--
-- -- /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', 'describeLocationObjectStorageResponse_serverPort' - The port that your object storage server accepts inbound network traffic
-- on (for example, port 443).
--
-- 'serverProtocol', 'describeLocationObjectStorageResponse_serverProtocol' - The protocol that your object storage system uses to communicate.
--
-- 'httpStatus', 'describeLocationObjectStorageResponse_httpStatus' - The response's http status code.
newDescribeLocationObjectStorageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeLocationObjectStorageResponse
newDescribeLocationObjectStorageResponse :: Int -> DescribeLocationObjectStorageResponse
newDescribeLocationObjectStorageResponse Int
pHttpStatus_ =
  DescribeLocationObjectStorageResponse'
    { $sel:accessKey:DescribeLocationObjectStorageResponse' :: Maybe Text
accessKey =
        forall a. Maybe a
Prelude.Nothing,
      $sel:agentArns:DescribeLocationObjectStorageResponse' :: Maybe (NonEmpty Text)
agentArns = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:DescribeLocationObjectStorageResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:locationArn:DescribeLocationObjectStorageResponse' :: Maybe Text
locationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:locationUri:DescribeLocationObjectStorageResponse' :: Maybe Text
locationUri = forall a. Maybe a
Prelude.Nothing,
      $sel:serverCertificate:DescribeLocationObjectStorageResponse' :: Maybe Base64
serverCertificate = forall a. Maybe a
Prelude.Nothing,
      $sel:serverPort:DescribeLocationObjectStorageResponse' :: Maybe Natural
serverPort = forall a. Maybe a
Prelude.Nothing,
      $sel:serverProtocol:DescribeLocationObjectStorageResponse' :: Maybe ObjectStorageServerProtocol
serverProtocol = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeLocationObjectStorageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The access key (for example, a user name) required to authenticate with
-- the object storage system.
describeLocationObjectStorageResponse_accessKey :: Lens.Lens' DescribeLocationObjectStorageResponse (Prelude.Maybe Prelude.Text)
describeLocationObjectStorageResponse_accessKey :: Lens' DescribeLocationObjectStorageResponse (Maybe Text)
describeLocationObjectStorageResponse_accessKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorageResponse' {Maybe Text
accessKey :: Maybe Text
$sel:accessKey:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Text
accessKey} -> Maybe Text
accessKey) (\s :: DescribeLocationObjectStorageResponse
s@DescribeLocationObjectStorageResponse' {} Maybe Text
a -> DescribeLocationObjectStorageResponse
s {$sel:accessKey:DescribeLocationObjectStorageResponse' :: Maybe Text
accessKey = Maybe Text
a} :: DescribeLocationObjectStorageResponse)

-- | The ARNs of the DataSync agents that can securely connect with your
-- location.
describeLocationObjectStorageResponse_agentArns :: Lens.Lens' DescribeLocationObjectStorageResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
describeLocationObjectStorageResponse_agentArns :: Lens' DescribeLocationObjectStorageResponse (Maybe (NonEmpty Text))
describeLocationObjectStorageResponse_agentArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorageResponse' {Maybe (NonEmpty Text)
agentArns :: Maybe (NonEmpty Text)
$sel:agentArns:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe (NonEmpty Text)
agentArns} -> Maybe (NonEmpty Text)
agentArns) (\s :: DescribeLocationObjectStorageResponse
s@DescribeLocationObjectStorageResponse' {} Maybe (NonEmpty Text)
a -> DescribeLocationObjectStorageResponse
s {$sel:agentArns:DescribeLocationObjectStorageResponse' :: Maybe (NonEmpty Text)
agentArns = Maybe (NonEmpty Text)
a} :: DescribeLocationObjectStorageResponse) 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 time that the location was created.
describeLocationObjectStorageResponse_creationTime :: Lens.Lens' DescribeLocationObjectStorageResponse (Prelude.Maybe Prelude.UTCTime)
describeLocationObjectStorageResponse_creationTime :: Lens' DescribeLocationObjectStorageResponse (Maybe UTCTime)
describeLocationObjectStorageResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorageResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: DescribeLocationObjectStorageResponse
s@DescribeLocationObjectStorageResponse' {} Maybe POSIX
a -> DescribeLocationObjectStorageResponse
s {$sel:creationTime:DescribeLocationObjectStorageResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: DescribeLocationObjectStorageResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The ARN of the object storage system location.
describeLocationObjectStorageResponse_locationArn :: Lens.Lens' DescribeLocationObjectStorageResponse (Prelude.Maybe Prelude.Text)
describeLocationObjectStorageResponse_locationArn :: Lens' DescribeLocationObjectStorageResponse (Maybe Text)
describeLocationObjectStorageResponse_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorageResponse' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: DescribeLocationObjectStorageResponse
s@DescribeLocationObjectStorageResponse' {} Maybe Text
a -> DescribeLocationObjectStorageResponse
s {$sel:locationArn:DescribeLocationObjectStorageResponse' :: Maybe Text
locationArn = Maybe Text
a} :: DescribeLocationObjectStorageResponse)

-- | The URL of the object storage system location.
describeLocationObjectStorageResponse_locationUri :: Lens.Lens' DescribeLocationObjectStorageResponse (Prelude.Maybe Prelude.Text)
describeLocationObjectStorageResponse_locationUri :: Lens' DescribeLocationObjectStorageResponse (Maybe Text)
describeLocationObjectStorageResponse_locationUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorageResponse' {Maybe Text
locationUri :: Maybe Text
$sel:locationUri:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Text
locationUri} -> Maybe Text
locationUri) (\s :: DescribeLocationObjectStorageResponse
s@DescribeLocationObjectStorageResponse' {} Maybe Text
a -> DescribeLocationObjectStorageResponse
s {$sel:locationUri:DescribeLocationObjectStorageResponse' :: Maybe Text
locationUri = Maybe Text
a} :: DescribeLocationObjectStorageResponse)

-- | The self-signed certificate that DataSync uses to securely authenticate
-- with your object storage system.--
-- -- /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.
describeLocationObjectStorageResponse_serverCertificate :: Lens.Lens' DescribeLocationObjectStorageResponse (Prelude.Maybe Prelude.ByteString)
describeLocationObjectStorageResponse_serverCertificate :: Lens' DescribeLocationObjectStorageResponse (Maybe ByteString)
describeLocationObjectStorageResponse_serverCertificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorageResponse' {Maybe Base64
serverCertificate :: Maybe Base64
$sel:serverCertificate:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Base64
serverCertificate} -> Maybe Base64
serverCertificate) (\s :: DescribeLocationObjectStorageResponse
s@DescribeLocationObjectStorageResponse' {} Maybe Base64
a -> DescribeLocationObjectStorageResponse
s {$sel:serverCertificate:DescribeLocationObjectStorageResponse' :: Maybe Base64
serverCertificate = Maybe Base64
a} :: DescribeLocationObjectStorageResponse) 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

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

-- | The protocol that your object storage system uses to communicate.
describeLocationObjectStorageResponse_serverProtocol :: Lens.Lens' DescribeLocationObjectStorageResponse (Prelude.Maybe ObjectStorageServerProtocol)
describeLocationObjectStorageResponse_serverProtocol :: Lens'
  DescribeLocationObjectStorageResponse
  (Maybe ObjectStorageServerProtocol)
describeLocationObjectStorageResponse_serverProtocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationObjectStorageResponse' {Maybe ObjectStorageServerProtocol
serverProtocol :: Maybe ObjectStorageServerProtocol
$sel:serverProtocol:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse
-> Maybe ObjectStorageServerProtocol
serverProtocol} -> Maybe ObjectStorageServerProtocol
serverProtocol) (\s :: DescribeLocationObjectStorageResponse
s@DescribeLocationObjectStorageResponse' {} Maybe ObjectStorageServerProtocol
a -> DescribeLocationObjectStorageResponse
s {$sel:serverProtocol:DescribeLocationObjectStorageResponse' :: Maybe ObjectStorageServerProtocol
serverProtocol = Maybe ObjectStorageServerProtocol
a} :: DescribeLocationObjectStorageResponse)

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

instance
  Prelude.NFData
    DescribeLocationObjectStorageResponse
  where
  rnf :: DescribeLocationObjectStorageResponse -> ()
rnf DescribeLocationObjectStorageResponse' {Int
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Maybe Base64
Maybe POSIX
Maybe ObjectStorageServerProtocol
httpStatus :: Int
serverProtocol :: Maybe ObjectStorageServerProtocol
serverPort :: Maybe Natural
serverCertificate :: Maybe Base64
locationUri :: Maybe Text
locationArn :: Maybe Text
creationTime :: Maybe POSIX
agentArns :: Maybe (NonEmpty Text)
accessKey :: Maybe Text
$sel:httpStatus:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Int
$sel:serverProtocol:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse
-> Maybe ObjectStorageServerProtocol
$sel:serverPort:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Natural
$sel:serverCertificate:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Base64
$sel:locationUri:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Text
$sel:locationArn:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe Text
$sel:creationTime:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe POSIX
$sel:agentArns:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> Maybe (NonEmpty Text)
$sel:accessKey:DescribeLocationObjectStorageResponse' :: DescribeLocationObjectStorageResponse -> 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 POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Text
locationUri
      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 Int
httpStatus