{-# 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.DescribeLocationHdfs
-- 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, such as the authentication information about the
-- Hadoop Distributed File System (HDFS) location.
module Amazonka.DataSync.DescribeLocationHdfs
  ( -- * Creating a Request
    DescribeLocationHdfs (..),
    newDescribeLocationHdfs,

    -- * Request Lenses
    describeLocationHdfs_locationArn,

    -- * Destructuring the Response
    DescribeLocationHdfsResponse (..),
    newDescribeLocationHdfsResponse,

    -- * Response Lenses
    describeLocationHdfsResponse_agentArns,
    describeLocationHdfsResponse_authenticationType,
    describeLocationHdfsResponse_blockSize,
    describeLocationHdfsResponse_creationTime,
    describeLocationHdfsResponse_kerberosPrincipal,
    describeLocationHdfsResponse_kmsKeyProviderUri,
    describeLocationHdfsResponse_locationArn,
    describeLocationHdfsResponse_locationUri,
    describeLocationHdfsResponse_nameNodes,
    describeLocationHdfsResponse_qopConfiguration,
    describeLocationHdfsResponse_replicationFactor,
    describeLocationHdfsResponse_simpleUser,
    describeLocationHdfsResponse_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:/ 'newDescribeLocationHdfs' smart constructor.
data DescribeLocationHdfs = DescribeLocationHdfs'
  { -- | The Amazon Resource Name (ARN) of the HDFS cluster location to describe.
    DescribeLocationHdfs -> Text
locationArn :: Prelude.Text
  }
  deriving (DescribeLocationHdfs -> DescribeLocationHdfs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLocationHdfs -> DescribeLocationHdfs -> Bool
$c/= :: DescribeLocationHdfs -> DescribeLocationHdfs -> Bool
== :: DescribeLocationHdfs -> DescribeLocationHdfs -> Bool
$c== :: DescribeLocationHdfs -> DescribeLocationHdfs -> Bool
Prelude.Eq, ReadPrec [DescribeLocationHdfs]
ReadPrec DescribeLocationHdfs
Int -> ReadS DescribeLocationHdfs
ReadS [DescribeLocationHdfs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLocationHdfs]
$creadListPrec :: ReadPrec [DescribeLocationHdfs]
readPrec :: ReadPrec DescribeLocationHdfs
$creadPrec :: ReadPrec DescribeLocationHdfs
readList :: ReadS [DescribeLocationHdfs]
$creadList :: ReadS [DescribeLocationHdfs]
readsPrec :: Int -> ReadS DescribeLocationHdfs
$creadsPrec :: Int -> ReadS DescribeLocationHdfs
Prelude.Read, Int -> DescribeLocationHdfs -> ShowS
[DescribeLocationHdfs] -> ShowS
DescribeLocationHdfs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLocationHdfs] -> ShowS
$cshowList :: [DescribeLocationHdfs] -> ShowS
show :: DescribeLocationHdfs -> String
$cshow :: DescribeLocationHdfs -> String
showsPrec :: Int -> DescribeLocationHdfs -> ShowS
$cshowsPrec :: Int -> DescribeLocationHdfs -> ShowS
Prelude.Show, forall x. Rep DescribeLocationHdfs x -> DescribeLocationHdfs
forall x. DescribeLocationHdfs -> Rep DescribeLocationHdfs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeLocationHdfs x -> DescribeLocationHdfs
$cfrom :: forall x. DescribeLocationHdfs -> Rep DescribeLocationHdfs x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLocationHdfs' 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', 'describeLocationHdfs_locationArn' - The Amazon Resource Name (ARN) of the HDFS cluster location to describe.
newDescribeLocationHdfs ::
  -- | 'locationArn'
  Prelude.Text ->
  DescribeLocationHdfs
newDescribeLocationHdfs :: Text -> DescribeLocationHdfs
newDescribeLocationHdfs Text
pLocationArn_ =
  DescribeLocationHdfs' {$sel:locationArn:DescribeLocationHdfs' :: Text
locationArn = Text
pLocationArn_}

-- | The Amazon Resource Name (ARN) of the HDFS cluster location to describe.
describeLocationHdfs_locationArn :: Lens.Lens' DescribeLocationHdfs Prelude.Text
describeLocationHdfs_locationArn :: Lens' DescribeLocationHdfs Text
describeLocationHdfs_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfs' {Text
locationArn :: Text
$sel:locationArn:DescribeLocationHdfs' :: DescribeLocationHdfs -> Text
locationArn} -> Text
locationArn) (\s :: DescribeLocationHdfs
s@DescribeLocationHdfs' {} Text
a -> DescribeLocationHdfs
s {$sel:locationArn:DescribeLocationHdfs' :: Text
locationArn = Text
a} :: DescribeLocationHdfs)

instance Core.AWSRequest DescribeLocationHdfs where
  type
    AWSResponse DescribeLocationHdfs =
      DescribeLocationHdfsResponse
  request :: (Service -> Service)
-> DescribeLocationHdfs -> Request DescribeLocationHdfs
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 DescribeLocationHdfs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeLocationHdfs)))
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 (NonEmpty Text)
-> Maybe HdfsAuthenticationType
-> Maybe Natural
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (NonEmpty HdfsNameNode)
-> Maybe QopConfiguration
-> Maybe Natural
-> Maybe Text
-> Int
-> DescribeLocationHdfsResponse
DescribeLocationHdfsResponse'
            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
"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
"AuthenticationType")
            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
"BlockSize")
            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
"KerberosPrincipal")
            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
"KmsKeyProviderUri")
            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
"NameNodes")
            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
"QopConfiguration")
            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
"ReplicationFactor")
            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
"SimpleUser")
            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 DescribeLocationHdfs where
  hashWithSalt :: Int -> DescribeLocationHdfs -> Int
hashWithSalt Int
_salt DescribeLocationHdfs' {Text
locationArn :: Text
$sel:locationArn:DescribeLocationHdfs' :: DescribeLocationHdfs -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
locationArn

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

instance Data.ToHeaders DescribeLocationHdfs where
  toHeaders :: DescribeLocationHdfs -> 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.DescribeLocationHdfs" ::
                          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 DescribeLocationHdfs where
  toJSON :: DescribeLocationHdfs -> Value
toJSON DescribeLocationHdfs' {Text
locationArn :: Text
$sel:locationArn:DescribeLocationHdfs' :: DescribeLocationHdfs -> 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 DescribeLocationHdfs where
  toPath :: DescribeLocationHdfs -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeLocationHdfsResponse' smart constructor.
data DescribeLocationHdfsResponse = DescribeLocationHdfsResponse'
  { -- | The ARNs of the agents that are used to connect to the HDFS cluster.
    DescribeLocationHdfsResponse -> Maybe (NonEmpty Text)
agentArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The type of authentication used to determine the identity of the user.
    DescribeLocationHdfsResponse -> Maybe HdfsAuthenticationType
authenticationType :: Prelude.Maybe HdfsAuthenticationType,
    -- | The size of the data blocks to write into the HDFS cluster.
    DescribeLocationHdfsResponse -> Maybe Natural
blockSize :: Prelude.Maybe Prelude.Natural,
    -- | The time that the HDFS location was created.
    DescribeLocationHdfsResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The Kerberos principal with access to the files and folders on the HDFS
    -- cluster. This parameter is used if the @AuthenticationType@ is defined
    -- as @KERBEROS@.
    DescribeLocationHdfsResponse -> Maybe Text
kerberosPrincipal :: Prelude.Maybe Prelude.Text,
    -- | The URI of the HDFS cluster\'s Key Management Server (KMS).
    DescribeLocationHdfsResponse -> Maybe Text
kmsKeyProviderUri :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the HDFS cluster location.
    DescribeLocationHdfsResponse -> Maybe Text
locationArn :: Prelude.Maybe Prelude.Text,
    -- | The URI of the HDFS cluster location.
    DescribeLocationHdfsResponse -> Maybe Text
locationUri :: Prelude.Maybe Prelude.Text,
    -- | The NameNode that manage the HDFS namespace.
    DescribeLocationHdfsResponse -> Maybe (NonEmpty HdfsNameNode)
nameNodes :: Prelude.Maybe (Prelude.NonEmpty HdfsNameNode),
    -- | The Quality of Protection (QOP) configuration specifies the Remote
    -- Procedure Call (RPC) and data transfer protection settings configured on
    -- the Hadoop Distributed File System (HDFS) cluster.
    DescribeLocationHdfsResponse -> Maybe QopConfiguration
qopConfiguration :: Prelude.Maybe QopConfiguration,
    -- | The number of DataNodes to replicate the data to when writing to the
    -- HDFS cluster.
    DescribeLocationHdfsResponse -> Maybe Natural
replicationFactor :: Prelude.Maybe Prelude.Natural,
    -- | The user name used to identify the client on the host operating system.
    -- This parameter is used if the @AuthenticationType@ is defined as
    -- @SIMPLE@.
    DescribeLocationHdfsResponse -> Maybe Text
simpleUser :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeLocationHdfsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeLocationHdfsResponse
-> DescribeLocationHdfsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLocationHdfsResponse
-> DescribeLocationHdfsResponse -> Bool
$c/= :: DescribeLocationHdfsResponse
-> DescribeLocationHdfsResponse -> Bool
== :: DescribeLocationHdfsResponse
-> DescribeLocationHdfsResponse -> Bool
$c== :: DescribeLocationHdfsResponse
-> DescribeLocationHdfsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeLocationHdfsResponse]
ReadPrec DescribeLocationHdfsResponse
Int -> ReadS DescribeLocationHdfsResponse
ReadS [DescribeLocationHdfsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLocationHdfsResponse]
$creadListPrec :: ReadPrec [DescribeLocationHdfsResponse]
readPrec :: ReadPrec DescribeLocationHdfsResponse
$creadPrec :: ReadPrec DescribeLocationHdfsResponse
readList :: ReadS [DescribeLocationHdfsResponse]
$creadList :: ReadS [DescribeLocationHdfsResponse]
readsPrec :: Int -> ReadS DescribeLocationHdfsResponse
$creadsPrec :: Int -> ReadS DescribeLocationHdfsResponse
Prelude.Read, Int -> DescribeLocationHdfsResponse -> ShowS
[DescribeLocationHdfsResponse] -> ShowS
DescribeLocationHdfsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLocationHdfsResponse] -> ShowS
$cshowList :: [DescribeLocationHdfsResponse] -> ShowS
show :: DescribeLocationHdfsResponse -> String
$cshow :: DescribeLocationHdfsResponse -> String
showsPrec :: Int -> DescribeLocationHdfsResponse -> ShowS
$cshowsPrec :: Int -> DescribeLocationHdfsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeLocationHdfsResponse x -> DescribeLocationHdfsResponse
forall x.
DescribeLocationHdfsResponse -> Rep DescribeLocationHdfsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeLocationHdfsResponse x -> DescribeLocationHdfsResponse
$cfrom :: forall x.
DescribeLocationHdfsResponse -> Rep DescribeLocationHdfsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLocationHdfsResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'agentArns', 'describeLocationHdfsResponse_agentArns' - The ARNs of the agents that are used to connect to the HDFS cluster.
--
-- 'authenticationType', 'describeLocationHdfsResponse_authenticationType' - The type of authentication used to determine the identity of the user.
--
-- 'blockSize', 'describeLocationHdfsResponse_blockSize' - The size of the data blocks to write into the HDFS cluster.
--
-- 'creationTime', 'describeLocationHdfsResponse_creationTime' - The time that the HDFS location was created.
--
-- 'kerberosPrincipal', 'describeLocationHdfsResponse_kerberosPrincipal' - The Kerberos principal with access to the files and folders on the HDFS
-- cluster. This parameter is used if the @AuthenticationType@ is defined
-- as @KERBEROS@.
--
-- 'kmsKeyProviderUri', 'describeLocationHdfsResponse_kmsKeyProviderUri' - The URI of the HDFS cluster\'s Key Management Server (KMS).
--
-- 'locationArn', 'describeLocationHdfsResponse_locationArn' - The ARN of the HDFS cluster location.
--
-- 'locationUri', 'describeLocationHdfsResponse_locationUri' - The URI of the HDFS cluster location.
--
-- 'nameNodes', 'describeLocationHdfsResponse_nameNodes' - The NameNode that manage the HDFS namespace.
--
-- 'qopConfiguration', 'describeLocationHdfsResponse_qopConfiguration' - The Quality of Protection (QOP) configuration specifies the Remote
-- Procedure Call (RPC) and data transfer protection settings configured on
-- the Hadoop Distributed File System (HDFS) cluster.
--
-- 'replicationFactor', 'describeLocationHdfsResponse_replicationFactor' - The number of DataNodes to replicate the data to when writing to the
-- HDFS cluster.
--
-- 'simpleUser', 'describeLocationHdfsResponse_simpleUser' - The user name used to identify the client on the host operating system.
-- This parameter is used if the @AuthenticationType@ is defined as
-- @SIMPLE@.
--
-- 'httpStatus', 'describeLocationHdfsResponse_httpStatus' - The response's http status code.
newDescribeLocationHdfsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeLocationHdfsResponse
newDescribeLocationHdfsResponse :: Int -> DescribeLocationHdfsResponse
newDescribeLocationHdfsResponse Int
pHttpStatus_ =
  DescribeLocationHdfsResponse'
    { $sel:agentArns:DescribeLocationHdfsResponse' :: Maybe (NonEmpty Text)
agentArns =
        forall a. Maybe a
Prelude.Nothing,
      $sel:authenticationType:DescribeLocationHdfsResponse' :: Maybe HdfsAuthenticationType
authenticationType = forall a. Maybe a
Prelude.Nothing,
      $sel:blockSize:DescribeLocationHdfsResponse' :: Maybe Natural
blockSize = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:DescribeLocationHdfsResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:kerberosPrincipal:DescribeLocationHdfsResponse' :: Maybe Text
kerberosPrincipal = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyProviderUri:DescribeLocationHdfsResponse' :: Maybe Text
kmsKeyProviderUri = forall a. Maybe a
Prelude.Nothing,
      $sel:locationArn:DescribeLocationHdfsResponse' :: Maybe Text
locationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:locationUri:DescribeLocationHdfsResponse' :: Maybe Text
locationUri = forall a. Maybe a
Prelude.Nothing,
      $sel:nameNodes:DescribeLocationHdfsResponse' :: Maybe (NonEmpty HdfsNameNode)
nameNodes = forall a. Maybe a
Prelude.Nothing,
      $sel:qopConfiguration:DescribeLocationHdfsResponse' :: Maybe QopConfiguration
qopConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationFactor:DescribeLocationHdfsResponse' :: Maybe Natural
replicationFactor = forall a. Maybe a
Prelude.Nothing,
      $sel:simpleUser:DescribeLocationHdfsResponse' :: Maybe Text
simpleUser = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeLocationHdfsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARNs of the agents that are used to connect to the HDFS cluster.
describeLocationHdfsResponse_agentArns :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
describeLocationHdfsResponse_agentArns :: Lens' DescribeLocationHdfsResponse (Maybe (NonEmpty Text))
describeLocationHdfsResponse_agentArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe (NonEmpty Text)
agentArns :: Maybe (NonEmpty Text)
$sel:agentArns:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe (NonEmpty Text)
agentArns} -> Maybe (NonEmpty Text)
agentArns) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe (NonEmpty Text)
a -> DescribeLocationHdfsResponse
s {$sel:agentArns:DescribeLocationHdfsResponse' :: Maybe (NonEmpty Text)
agentArns = Maybe (NonEmpty Text)
a} :: DescribeLocationHdfsResponse) 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 type of authentication used to determine the identity of the user.
describeLocationHdfsResponse_authenticationType :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe HdfsAuthenticationType)
describeLocationHdfsResponse_authenticationType :: Lens' DescribeLocationHdfsResponse (Maybe HdfsAuthenticationType)
describeLocationHdfsResponse_authenticationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe HdfsAuthenticationType
authenticationType :: Maybe HdfsAuthenticationType
$sel:authenticationType:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe HdfsAuthenticationType
authenticationType} -> Maybe HdfsAuthenticationType
authenticationType) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe HdfsAuthenticationType
a -> DescribeLocationHdfsResponse
s {$sel:authenticationType:DescribeLocationHdfsResponse' :: Maybe HdfsAuthenticationType
authenticationType = Maybe HdfsAuthenticationType
a} :: DescribeLocationHdfsResponse)

-- | The size of the data blocks to write into the HDFS cluster.
describeLocationHdfsResponse_blockSize :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.Natural)
describeLocationHdfsResponse_blockSize :: Lens' DescribeLocationHdfsResponse (Maybe Natural)
describeLocationHdfsResponse_blockSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe Natural
blockSize :: Maybe Natural
$sel:blockSize:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Natural
blockSize} -> Maybe Natural
blockSize) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe Natural
a -> DescribeLocationHdfsResponse
s {$sel:blockSize:DescribeLocationHdfsResponse' :: Maybe Natural
blockSize = Maybe Natural
a} :: DescribeLocationHdfsResponse)

-- | The time that the HDFS location was created.
describeLocationHdfsResponse_creationTime :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.UTCTime)
describeLocationHdfsResponse_creationTime :: Lens' DescribeLocationHdfsResponse (Maybe UTCTime)
describeLocationHdfsResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe POSIX
a -> DescribeLocationHdfsResponse
s {$sel:creationTime:DescribeLocationHdfsResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: DescribeLocationHdfsResponse) 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 Kerberos principal with access to the files and folders on the HDFS
-- cluster. This parameter is used if the @AuthenticationType@ is defined
-- as @KERBEROS@.
describeLocationHdfsResponse_kerberosPrincipal :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.Text)
describeLocationHdfsResponse_kerberosPrincipal :: Lens' DescribeLocationHdfsResponse (Maybe Text)
describeLocationHdfsResponse_kerberosPrincipal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe Text
kerberosPrincipal :: Maybe Text
$sel:kerberosPrincipal:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
kerberosPrincipal} -> Maybe Text
kerberosPrincipal) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe Text
a -> DescribeLocationHdfsResponse
s {$sel:kerberosPrincipal:DescribeLocationHdfsResponse' :: Maybe Text
kerberosPrincipal = Maybe Text
a} :: DescribeLocationHdfsResponse)

-- | The URI of the HDFS cluster\'s Key Management Server (KMS).
describeLocationHdfsResponse_kmsKeyProviderUri :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.Text)
describeLocationHdfsResponse_kmsKeyProviderUri :: Lens' DescribeLocationHdfsResponse (Maybe Text)
describeLocationHdfsResponse_kmsKeyProviderUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe Text
kmsKeyProviderUri :: Maybe Text
$sel:kmsKeyProviderUri:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
kmsKeyProviderUri} -> Maybe Text
kmsKeyProviderUri) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe Text
a -> DescribeLocationHdfsResponse
s {$sel:kmsKeyProviderUri:DescribeLocationHdfsResponse' :: Maybe Text
kmsKeyProviderUri = Maybe Text
a} :: DescribeLocationHdfsResponse)

-- | The ARN of the HDFS cluster location.
describeLocationHdfsResponse_locationArn :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.Text)
describeLocationHdfsResponse_locationArn :: Lens' DescribeLocationHdfsResponse (Maybe Text)
describeLocationHdfsResponse_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe Text
a -> DescribeLocationHdfsResponse
s {$sel:locationArn:DescribeLocationHdfsResponse' :: Maybe Text
locationArn = Maybe Text
a} :: DescribeLocationHdfsResponse)

-- | The URI of the HDFS cluster location.
describeLocationHdfsResponse_locationUri :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.Text)
describeLocationHdfsResponse_locationUri :: Lens' DescribeLocationHdfsResponse (Maybe Text)
describeLocationHdfsResponse_locationUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe Text
locationUri :: Maybe Text
$sel:locationUri:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
locationUri} -> Maybe Text
locationUri) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe Text
a -> DescribeLocationHdfsResponse
s {$sel:locationUri:DescribeLocationHdfsResponse' :: Maybe Text
locationUri = Maybe Text
a} :: DescribeLocationHdfsResponse)

-- | The NameNode that manage the HDFS namespace.
describeLocationHdfsResponse_nameNodes :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe (Prelude.NonEmpty HdfsNameNode))
describeLocationHdfsResponse_nameNodes :: Lens' DescribeLocationHdfsResponse (Maybe (NonEmpty HdfsNameNode))
describeLocationHdfsResponse_nameNodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe (NonEmpty HdfsNameNode)
nameNodes :: Maybe (NonEmpty HdfsNameNode)
$sel:nameNodes:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe (NonEmpty HdfsNameNode)
nameNodes} -> Maybe (NonEmpty HdfsNameNode)
nameNodes) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe (NonEmpty HdfsNameNode)
a -> DescribeLocationHdfsResponse
s {$sel:nameNodes:DescribeLocationHdfsResponse' :: Maybe (NonEmpty HdfsNameNode)
nameNodes = Maybe (NonEmpty HdfsNameNode)
a} :: DescribeLocationHdfsResponse) 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 Quality of Protection (QOP) configuration specifies the Remote
-- Procedure Call (RPC) and data transfer protection settings configured on
-- the Hadoop Distributed File System (HDFS) cluster.
describeLocationHdfsResponse_qopConfiguration :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe QopConfiguration)
describeLocationHdfsResponse_qopConfiguration :: Lens' DescribeLocationHdfsResponse (Maybe QopConfiguration)
describeLocationHdfsResponse_qopConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe QopConfiguration
qopConfiguration :: Maybe QopConfiguration
$sel:qopConfiguration:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe QopConfiguration
qopConfiguration} -> Maybe QopConfiguration
qopConfiguration) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe QopConfiguration
a -> DescribeLocationHdfsResponse
s {$sel:qopConfiguration:DescribeLocationHdfsResponse' :: Maybe QopConfiguration
qopConfiguration = Maybe QopConfiguration
a} :: DescribeLocationHdfsResponse)

-- | The number of DataNodes to replicate the data to when writing to the
-- HDFS cluster.
describeLocationHdfsResponse_replicationFactor :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.Natural)
describeLocationHdfsResponse_replicationFactor :: Lens' DescribeLocationHdfsResponse (Maybe Natural)
describeLocationHdfsResponse_replicationFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe Natural
replicationFactor :: Maybe Natural
$sel:replicationFactor:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Natural
replicationFactor} -> Maybe Natural
replicationFactor) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe Natural
a -> DescribeLocationHdfsResponse
s {$sel:replicationFactor:DescribeLocationHdfsResponse' :: Maybe Natural
replicationFactor = Maybe Natural
a} :: DescribeLocationHdfsResponse)

-- | The user name used to identify the client on the host operating system.
-- This parameter is used if the @AuthenticationType@ is defined as
-- @SIMPLE@.
describeLocationHdfsResponse_simpleUser :: Lens.Lens' DescribeLocationHdfsResponse (Prelude.Maybe Prelude.Text)
describeLocationHdfsResponse_simpleUser :: Lens' DescribeLocationHdfsResponse (Maybe Text)
describeLocationHdfsResponse_simpleUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLocationHdfsResponse' {Maybe Text
simpleUser :: Maybe Text
$sel:simpleUser:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
simpleUser} -> Maybe Text
simpleUser) (\s :: DescribeLocationHdfsResponse
s@DescribeLocationHdfsResponse' {} Maybe Text
a -> DescribeLocationHdfsResponse
s {$sel:simpleUser:DescribeLocationHdfsResponse' :: Maybe Text
simpleUser = Maybe Text
a} :: DescribeLocationHdfsResponse)

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

instance Prelude.NFData DescribeLocationHdfsResponse where
  rnf :: DescribeLocationHdfsResponse -> ()
rnf DescribeLocationHdfsResponse' {Int
Maybe Natural
Maybe (NonEmpty Text)
Maybe (NonEmpty HdfsNameNode)
Maybe Text
Maybe POSIX
Maybe HdfsAuthenticationType
Maybe QopConfiguration
httpStatus :: Int
simpleUser :: Maybe Text
replicationFactor :: Maybe Natural
qopConfiguration :: Maybe QopConfiguration
nameNodes :: Maybe (NonEmpty HdfsNameNode)
locationUri :: Maybe Text
locationArn :: Maybe Text
kmsKeyProviderUri :: Maybe Text
kerberosPrincipal :: Maybe Text
creationTime :: Maybe POSIX
blockSize :: Maybe Natural
authenticationType :: Maybe HdfsAuthenticationType
agentArns :: Maybe (NonEmpty Text)
$sel:httpStatus:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Int
$sel:simpleUser:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
$sel:replicationFactor:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Natural
$sel:qopConfiguration:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe QopConfiguration
$sel:nameNodes:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe (NonEmpty HdfsNameNode)
$sel:locationUri:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
$sel:locationArn:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
$sel:kmsKeyProviderUri:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
$sel:kerberosPrincipal:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Text
$sel:creationTime:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe POSIX
$sel:blockSize:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe Natural
$sel:authenticationType:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe HdfsAuthenticationType
$sel:agentArns:DescribeLocationHdfsResponse' :: DescribeLocationHdfsResponse -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
agentArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HdfsAuthenticationType
authenticationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
blockSize
      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
kerberosPrincipal
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyProviderUri
      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 (NonEmpty HdfsNameNode)
nameNodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QopConfiguration
qopConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
replicationFactor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
simpleUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus