{-# 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.CreateLocationHdfs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an endpoint for a Hadoop Distributed File System (HDFS).
module Amazonka.DataSync.CreateLocationHdfs
  ( -- * Creating a Request
    CreateLocationHdfs (..),
    newCreateLocationHdfs,

    -- * Request Lenses
    createLocationHdfs_blockSize,
    createLocationHdfs_kerberosKeytab,
    createLocationHdfs_kerberosKrb5Conf,
    createLocationHdfs_kerberosPrincipal,
    createLocationHdfs_kmsKeyProviderUri,
    createLocationHdfs_qopConfiguration,
    createLocationHdfs_replicationFactor,
    createLocationHdfs_simpleUser,
    createLocationHdfs_subdirectory,
    createLocationHdfs_tags,
    createLocationHdfs_nameNodes,
    createLocationHdfs_authenticationType,
    createLocationHdfs_agentArns,

    -- * Destructuring the Response
    CreateLocationHdfsResponse (..),
    newCreateLocationHdfsResponse,

    -- * Response Lenses
    createLocationHdfsResponse_locationArn,
    createLocationHdfsResponse_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:/ 'newCreateLocationHdfs' smart constructor.
data CreateLocationHdfs = CreateLocationHdfs'
  { -- | The size of data blocks to write into the HDFS cluster. The block size
    -- must be a multiple of 512 bytes. The default block size is 128 mebibytes
    -- (MiB).
    CreateLocationHdfs -> Maybe Natural
blockSize :: Prelude.Maybe Prelude.Natural,
    -- | The Kerberos key table (keytab) that contains mappings between the
    -- defined Kerberos principal and the encrypted keys. You can load the
    -- keytab from a file by providing the file\'s address. If you\'re using
    -- the CLI, it performs base64 encoding for you. Otherwise, provide the
    -- base64-encoded text.
    --
    -- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
    -- required.
    CreateLocationHdfs -> Maybe Base64
kerberosKeytab :: Prelude.Maybe Data.Base64,
    -- | The @krb5.conf@ file that contains the Kerberos configuration
    -- information. You can load the @krb5.conf@ file by providing the file\'s
    -- address. If you\'re using the CLI, it performs the base64 encoding for
    -- you. Otherwise, provide the base64-encoded text.
    --
    -- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
    -- required.
    CreateLocationHdfs -> Maybe Base64
kerberosKrb5Conf :: Prelude.Maybe Data.Base64,
    -- | The Kerberos principal with access to the files and folders on the HDFS
    -- cluster.
    --
    -- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
    -- required.
    CreateLocationHdfs -> Maybe Text
kerberosPrincipal :: Prelude.Maybe Prelude.Text,
    -- | The URI of the HDFS cluster\'s Key Management Server (KMS).
    CreateLocationHdfs -> Maybe Text
kmsKeyProviderUri :: Prelude.Maybe Prelude.Text,
    -- | 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. If @QopConfiguration@
    -- isn\'t specified, @RpcProtection@ and @DataTransferProtection@ default
    -- to @PRIVACY@. If you set @RpcProtection@ or @DataTransferProtection@,
    -- the other parameter assumes the same value.
    CreateLocationHdfs -> Maybe QopConfiguration
qopConfiguration :: Prelude.Maybe QopConfiguration,
    -- | The number of DataNodes to replicate the data to when writing to the
    -- HDFS cluster. By default, data is replicated to three DataNodes.
    CreateLocationHdfs -> Maybe Natural
replicationFactor :: Prelude.Maybe Prelude.Natural,
    -- | The user name used to identify the client on the host operating system.
    --
    -- If @SIMPLE@ is specified for @AuthenticationType@, this parameter is
    -- required.
    CreateLocationHdfs -> Maybe Text
simpleUser :: Prelude.Maybe Prelude.Text,
    -- | A subdirectory in the HDFS cluster. This subdirectory is used to read
    -- data from or write data to the HDFS cluster. If the subdirectory isn\'t
    -- specified, it will default to @\/@.
    CreateLocationHdfs -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | The key-value pair that represents the tag that you want to add to the
    -- location. The value can be an empty string. We recommend using tags to
    -- name your resources.
    CreateLocationHdfs -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | The NameNode that manages the HDFS namespace. The NameNode performs
    -- operations such as opening, closing, and renaming files and directories.
    -- The NameNode contains the information to map blocks of data to the
    -- DataNodes. You can use only one NameNode.
    CreateLocationHdfs -> NonEmpty HdfsNameNode
nameNodes :: Prelude.NonEmpty HdfsNameNode,
    -- | The type of authentication used to determine the identity of the user.
    CreateLocationHdfs -> HdfsAuthenticationType
authenticationType :: HdfsAuthenticationType,
    -- | The Amazon Resource Names (ARNs) of the agents that are used to connect
    -- to the HDFS cluster.
    CreateLocationHdfs -> NonEmpty Text
agentArns :: Prelude.NonEmpty Prelude.Text
  }
  deriving (CreateLocationHdfs -> CreateLocationHdfs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationHdfs -> CreateLocationHdfs -> Bool
$c/= :: CreateLocationHdfs -> CreateLocationHdfs -> Bool
== :: CreateLocationHdfs -> CreateLocationHdfs -> Bool
$c== :: CreateLocationHdfs -> CreateLocationHdfs -> Bool
Prelude.Eq, ReadPrec [CreateLocationHdfs]
ReadPrec CreateLocationHdfs
Int -> ReadS CreateLocationHdfs
ReadS [CreateLocationHdfs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocationHdfs]
$creadListPrec :: ReadPrec [CreateLocationHdfs]
readPrec :: ReadPrec CreateLocationHdfs
$creadPrec :: ReadPrec CreateLocationHdfs
readList :: ReadS [CreateLocationHdfs]
$creadList :: ReadS [CreateLocationHdfs]
readsPrec :: Int -> ReadS CreateLocationHdfs
$creadsPrec :: Int -> ReadS CreateLocationHdfs
Prelude.Read, Int -> CreateLocationHdfs -> ShowS
[CreateLocationHdfs] -> ShowS
CreateLocationHdfs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationHdfs] -> ShowS
$cshowList :: [CreateLocationHdfs] -> ShowS
show :: CreateLocationHdfs -> String
$cshow :: CreateLocationHdfs -> String
showsPrec :: Int -> CreateLocationHdfs -> ShowS
$cshowsPrec :: Int -> CreateLocationHdfs -> ShowS
Prelude.Show, forall x. Rep CreateLocationHdfs x -> CreateLocationHdfs
forall x. CreateLocationHdfs -> Rep CreateLocationHdfs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLocationHdfs x -> CreateLocationHdfs
$cfrom :: forall x. CreateLocationHdfs -> Rep CreateLocationHdfs x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationHdfs' 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:
--
-- 'blockSize', 'createLocationHdfs_blockSize' - The size of data blocks to write into the HDFS cluster. The block size
-- must be a multiple of 512 bytes. The default block size is 128 mebibytes
-- (MiB).
--
-- 'kerberosKeytab', 'createLocationHdfs_kerberosKeytab' - The Kerberos key table (keytab) that contains mappings between the
-- defined Kerberos principal and the encrypted keys. You can load the
-- keytab from a file by providing the file\'s address. If you\'re using
-- the CLI, it performs base64 encoding for you. Otherwise, provide the
-- base64-encoded text.
--
-- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
-- required.--
-- -- /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.
--
-- 'kerberosKrb5Conf', 'createLocationHdfs_kerberosKrb5Conf' - The @krb5.conf@ file that contains the Kerberos configuration
-- information. You can load the @krb5.conf@ file by providing the file\'s
-- address. If you\'re using the CLI, it performs the base64 encoding for
-- you. Otherwise, provide the base64-encoded text.
--
-- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
-- required.--
-- -- /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.
--
-- 'kerberosPrincipal', 'createLocationHdfs_kerberosPrincipal' - The Kerberos principal with access to the files and folders on the HDFS
-- cluster.
--
-- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
-- required.
--
-- 'kmsKeyProviderUri', 'createLocationHdfs_kmsKeyProviderUri' - The URI of the HDFS cluster\'s Key Management Server (KMS).
--
-- 'qopConfiguration', 'createLocationHdfs_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. If @QopConfiguration@
-- isn\'t specified, @RpcProtection@ and @DataTransferProtection@ default
-- to @PRIVACY@. If you set @RpcProtection@ or @DataTransferProtection@,
-- the other parameter assumes the same value.
--
-- 'replicationFactor', 'createLocationHdfs_replicationFactor' - The number of DataNodes to replicate the data to when writing to the
-- HDFS cluster. By default, data is replicated to three DataNodes.
--
-- 'simpleUser', 'createLocationHdfs_simpleUser' - The user name used to identify the client on the host operating system.
--
-- If @SIMPLE@ is specified for @AuthenticationType@, this parameter is
-- required.
--
-- 'subdirectory', 'createLocationHdfs_subdirectory' - A subdirectory in the HDFS cluster. This subdirectory is used to read
-- data from or write data to the HDFS cluster. If the subdirectory isn\'t
-- specified, it will default to @\/@.
--
-- 'tags', 'createLocationHdfs_tags' - The key-value pair that represents the tag that you want to add to the
-- location. The value can be an empty string. We recommend using tags to
-- name your resources.
--
-- 'nameNodes', 'createLocationHdfs_nameNodes' - The NameNode that manages the HDFS namespace. The NameNode performs
-- operations such as opening, closing, and renaming files and directories.
-- The NameNode contains the information to map blocks of data to the
-- DataNodes. You can use only one NameNode.
--
-- 'authenticationType', 'createLocationHdfs_authenticationType' - The type of authentication used to determine the identity of the user.
--
-- 'agentArns', 'createLocationHdfs_agentArns' - The Amazon Resource Names (ARNs) of the agents that are used to connect
-- to the HDFS cluster.
newCreateLocationHdfs ::
  -- | 'nameNodes'
  Prelude.NonEmpty HdfsNameNode ->
  -- | 'authenticationType'
  HdfsAuthenticationType ->
  -- | 'agentArns'
  Prelude.NonEmpty Prelude.Text ->
  CreateLocationHdfs
newCreateLocationHdfs :: NonEmpty HdfsNameNode
-> HdfsAuthenticationType -> NonEmpty Text -> CreateLocationHdfs
newCreateLocationHdfs
  NonEmpty HdfsNameNode
pNameNodes_
  HdfsAuthenticationType
pAuthenticationType_
  NonEmpty Text
pAgentArns_ =
    CreateLocationHdfs'
      { $sel:blockSize:CreateLocationHdfs' :: Maybe Natural
blockSize = forall a. Maybe a
Prelude.Nothing,
        $sel:kerberosKeytab:CreateLocationHdfs' :: Maybe Base64
kerberosKeytab = forall a. Maybe a
Prelude.Nothing,
        $sel:kerberosKrb5Conf:CreateLocationHdfs' :: Maybe Base64
kerberosKrb5Conf = forall a. Maybe a
Prelude.Nothing,
        $sel:kerberosPrincipal:CreateLocationHdfs' :: Maybe Text
kerberosPrincipal = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyProviderUri:CreateLocationHdfs' :: Maybe Text
kmsKeyProviderUri = forall a. Maybe a
Prelude.Nothing,
        $sel:qopConfiguration:CreateLocationHdfs' :: Maybe QopConfiguration
qopConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:replicationFactor:CreateLocationHdfs' :: Maybe Natural
replicationFactor = forall a. Maybe a
Prelude.Nothing,
        $sel:simpleUser:CreateLocationHdfs' :: Maybe Text
simpleUser = forall a. Maybe a
Prelude.Nothing,
        $sel:subdirectory:CreateLocationHdfs' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLocationHdfs' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:nameNodes:CreateLocationHdfs' :: NonEmpty HdfsNameNode
nameNodes = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty HdfsNameNode
pNameNodes_,
        $sel:authenticationType:CreateLocationHdfs' :: HdfsAuthenticationType
authenticationType = HdfsAuthenticationType
pAuthenticationType_,
        $sel:agentArns:CreateLocationHdfs' :: NonEmpty Text
agentArns = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pAgentArns_
      }

-- | The size of data blocks to write into the HDFS cluster. The block size
-- must be a multiple of 512 bytes. The default block size is 128 mebibytes
-- (MiB).
createLocationHdfs_blockSize :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe Prelude.Natural)
createLocationHdfs_blockSize :: Lens' CreateLocationHdfs (Maybe Natural)
createLocationHdfs_blockSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe Natural
blockSize :: Maybe Natural
$sel:blockSize:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
blockSize} -> Maybe Natural
blockSize) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe Natural
a -> CreateLocationHdfs
s {$sel:blockSize:CreateLocationHdfs' :: Maybe Natural
blockSize = Maybe Natural
a} :: CreateLocationHdfs)

-- | The Kerberos key table (keytab) that contains mappings between the
-- defined Kerberos principal and the encrypted keys. You can load the
-- keytab from a file by providing the file\'s address. If you\'re using
-- the CLI, it performs base64 encoding for you. Otherwise, provide the
-- base64-encoded text.
--
-- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
-- required.--
-- -- /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.
createLocationHdfs_kerberosKeytab :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe Prelude.ByteString)
createLocationHdfs_kerberosKeytab :: Lens' CreateLocationHdfs (Maybe ByteString)
createLocationHdfs_kerberosKeytab = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe Base64
kerberosKeytab :: Maybe Base64
$sel:kerberosKeytab:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
kerberosKeytab} -> Maybe Base64
kerberosKeytab) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe Base64
a -> CreateLocationHdfs
s {$sel:kerberosKeytab:CreateLocationHdfs' :: Maybe Base64
kerberosKeytab = Maybe Base64
a} :: CreateLocationHdfs) 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 @krb5.conf@ file that contains the Kerberos configuration
-- information. You can load the @krb5.conf@ file by providing the file\'s
-- address. If you\'re using the CLI, it performs the base64 encoding for
-- you. Otherwise, provide the base64-encoded text.
--
-- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
-- required.--
-- -- /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.
createLocationHdfs_kerberosKrb5Conf :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe Prelude.ByteString)
createLocationHdfs_kerberosKrb5Conf :: Lens' CreateLocationHdfs (Maybe ByteString)
createLocationHdfs_kerberosKrb5Conf = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe Base64
kerberosKrb5Conf :: Maybe Base64
$sel:kerberosKrb5Conf:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
kerberosKrb5Conf} -> Maybe Base64
kerberosKrb5Conf) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe Base64
a -> CreateLocationHdfs
s {$sel:kerberosKrb5Conf:CreateLocationHdfs' :: Maybe Base64
kerberosKrb5Conf = Maybe Base64
a} :: CreateLocationHdfs) 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 Kerberos principal with access to the files and folders on the HDFS
-- cluster.
--
-- If @KERBEROS@ is specified for @AuthenticationType@, this parameter is
-- required.
createLocationHdfs_kerberosPrincipal :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe Prelude.Text)
createLocationHdfs_kerberosPrincipal :: Lens' CreateLocationHdfs (Maybe Text)
createLocationHdfs_kerberosPrincipal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe Text
kerberosPrincipal :: Maybe Text
$sel:kerberosPrincipal:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
kerberosPrincipal} -> Maybe Text
kerberosPrincipal) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe Text
a -> CreateLocationHdfs
s {$sel:kerberosPrincipal:CreateLocationHdfs' :: Maybe Text
kerberosPrincipal = Maybe Text
a} :: CreateLocationHdfs)

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

-- | 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. If @QopConfiguration@
-- isn\'t specified, @RpcProtection@ and @DataTransferProtection@ default
-- to @PRIVACY@. If you set @RpcProtection@ or @DataTransferProtection@,
-- the other parameter assumes the same value.
createLocationHdfs_qopConfiguration :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe QopConfiguration)
createLocationHdfs_qopConfiguration :: Lens' CreateLocationHdfs (Maybe QopConfiguration)
createLocationHdfs_qopConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe QopConfiguration
qopConfiguration :: Maybe QopConfiguration
$sel:qopConfiguration:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe QopConfiguration
qopConfiguration} -> Maybe QopConfiguration
qopConfiguration) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe QopConfiguration
a -> CreateLocationHdfs
s {$sel:qopConfiguration:CreateLocationHdfs' :: Maybe QopConfiguration
qopConfiguration = Maybe QopConfiguration
a} :: CreateLocationHdfs)

-- | The number of DataNodes to replicate the data to when writing to the
-- HDFS cluster. By default, data is replicated to three DataNodes.
createLocationHdfs_replicationFactor :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe Prelude.Natural)
createLocationHdfs_replicationFactor :: Lens' CreateLocationHdfs (Maybe Natural)
createLocationHdfs_replicationFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe Natural
replicationFactor :: Maybe Natural
$sel:replicationFactor:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
replicationFactor} -> Maybe Natural
replicationFactor) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe Natural
a -> CreateLocationHdfs
s {$sel:replicationFactor:CreateLocationHdfs' :: Maybe Natural
replicationFactor = Maybe Natural
a} :: CreateLocationHdfs)

-- | The user name used to identify the client on the host operating system.
--
-- If @SIMPLE@ is specified for @AuthenticationType@, this parameter is
-- required.
createLocationHdfs_simpleUser :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe Prelude.Text)
createLocationHdfs_simpleUser :: Lens' CreateLocationHdfs (Maybe Text)
createLocationHdfs_simpleUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe Text
simpleUser :: Maybe Text
$sel:simpleUser:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
simpleUser} -> Maybe Text
simpleUser) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe Text
a -> CreateLocationHdfs
s {$sel:simpleUser:CreateLocationHdfs' :: Maybe Text
simpleUser = Maybe Text
a} :: CreateLocationHdfs)

-- | A subdirectory in the HDFS cluster. This subdirectory is used to read
-- data from or write data to the HDFS cluster. If the subdirectory isn\'t
-- specified, it will default to @\/@.
createLocationHdfs_subdirectory :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe Prelude.Text)
createLocationHdfs_subdirectory :: Lens' CreateLocationHdfs (Maybe Text)
createLocationHdfs_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe Text
a -> CreateLocationHdfs
s {$sel:subdirectory:CreateLocationHdfs' :: Maybe Text
subdirectory = Maybe Text
a} :: CreateLocationHdfs)

-- | The key-value pair that represents the tag that you want to add to the
-- location. The value can be an empty string. We recommend using tags to
-- name your resources.
createLocationHdfs_tags :: Lens.Lens' CreateLocationHdfs (Prelude.Maybe [TagListEntry])
createLocationHdfs_tags :: Lens' CreateLocationHdfs (Maybe [TagListEntry])
createLocationHdfs_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} Maybe [TagListEntry]
a -> CreateLocationHdfs
s {$sel:tags:CreateLocationHdfs' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateLocationHdfs) 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 NameNode that manages the HDFS namespace. The NameNode performs
-- operations such as opening, closing, and renaming files and directories.
-- The NameNode contains the information to map blocks of data to the
-- DataNodes. You can use only one NameNode.
createLocationHdfs_nameNodes :: Lens.Lens' CreateLocationHdfs (Prelude.NonEmpty HdfsNameNode)
createLocationHdfs_nameNodes :: Lens' CreateLocationHdfs (NonEmpty HdfsNameNode)
createLocationHdfs_nameNodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {NonEmpty HdfsNameNode
nameNodes :: NonEmpty HdfsNameNode
$sel:nameNodes:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty HdfsNameNode
nameNodes} -> NonEmpty HdfsNameNode
nameNodes) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} NonEmpty HdfsNameNode
a -> CreateLocationHdfs
s {$sel:nameNodes:CreateLocationHdfs' :: NonEmpty HdfsNameNode
nameNodes = NonEmpty HdfsNameNode
a} :: CreateLocationHdfs) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The type of authentication used to determine the identity of the user.
createLocationHdfs_authenticationType :: Lens.Lens' CreateLocationHdfs HdfsAuthenticationType
createLocationHdfs_authenticationType :: Lens' CreateLocationHdfs HdfsAuthenticationType
createLocationHdfs_authenticationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {HdfsAuthenticationType
authenticationType :: HdfsAuthenticationType
$sel:authenticationType:CreateLocationHdfs' :: CreateLocationHdfs -> HdfsAuthenticationType
authenticationType} -> HdfsAuthenticationType
authenticationType) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} HdfsAuthenticationType
a -> CreateLocationHdfs
s {$sel:authenticationType:CreateLocationHdfs' :: HdfsAuthenticationType
authenticationType = HdfsAuthenticationType
a} :: CreateLocationHdfs)

-- | The Amazon Resource Names (ARNs) of the agents that are used to connect
-- to the HDFS cluster.
createLocationHdfs_agentArns :: Lens.Lens' CreateLocationHdfs (Prelude.NonEmpty Prelude.Text)
createLocationHdfs_agentArns :: Lens' CreateLocationHdfs (NonEmpty Text)
createLocationHdfs_agentArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationHdfs' {NonEmpty Text
agentArns :: NonEmpty Text
$sel:agentArns:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty Text
agentArns} -> NonEmpty Text
agentArns) (\s :: CreateLocationHdfs
s@CreateLocationHdfs' {} NonEmpty Text
a -> CreateLocationHdfs
s {$sel:agentArns:CreateLocationHdfs' :: NonEmpty Text
agentArns = NonEmpty Text
a} :: CreateLocationHdfs) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateLocationHdfs where
  type
    AWSResponse CreateLocationHdfs =
      CreateLocationHdfsResponse
  request :: (Service -> Service)
-> CreateLocationHdfs -> Request CreateLocationHdfs
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 CreateLocationHdfs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLocationHdfs)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateLocationHdfsResponse
CreateLocationHdfsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LocationArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateLocationHdfs where
  hashWithSalt :: Int -> CreateLocationHdfs -> Int
hashWithSalt Int
_salt CreateLocationHdfs' {Maybe Natural
Maybe [TagListEntry]
Maybe Text
Maybe Base64
Maybe QopConfiguration
NonEmpty Text
NonEmpty HdfsNameNode
HdfsAuthenticationType
agentArns :: NonEmpty Text
authenticationType :: HdfsAuthenticationType
nameNodes :: NonEmpty HdfsNameNode
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
simpleUser :: Maybe Text
replicationFactor :: Maybe Natural
qopConfiguration :: Maybe QopConfiguration
kmsKeyProviderUri :: Maybe Text
kerberosPrincipal :: Maybe Text
kerberosKrb5Conf :: Maybe Base64
kerberosKeytab :: Maybe Base64
blockSize :: Maybe Natural
$sel:agentArns:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty Text
$sel:authenticationType:CreateLocationHdfs' :: CreateLocationHdfs -> HdfsAuthenticationType
$sel:nameNodes:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty HdfsNameNode
$sel:tags:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:simpleUser:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:replicationFactor:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
$sel:qopConfiguration:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe QopConfiguration
$sel:kmsKeyProviderUri:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:kerberosPrincipal:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:kerberosKrb5Conf:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
$sel:kerberosKeytab:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
$sel:blockSize:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
blockSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
kerberosKeytab
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
kerberosKrb5Conf
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kerberosPrincipal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyProviderUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QopConfiguration
qopConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
replicationFactor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
simpleUser
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty HdfsNameNode
nameNodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HdfsAuthenticationType
authenticationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
agentArns

instance Prelude.NFData CreateLocationHdfs where
  rnf :: CreateLocationHdfs -> ()
rnf CreateLocationHdfs' {Maybe Natural
Maybe [TagListEntry]
Maybe Text
Maybe Base64
Maybe QopConfiguration
NonEmpty Text
NonEmpty HdfsNameNode
HdfsAuthenticationType
agentArns :: NonEmpty Text
authenticationType :: HdfsAuthenticationType
nameNodes :: NonEmpty HdfsNameNode
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
simpleUser :: Maybe Text
replicationFactor :: Maybe Natural
qopConfiguration :: Maybe QopConfiguration
kmsKeyProviderUri :: Maybe Text
kerberosPrincipal :: Maybe Text
kerberosKrb5Conf :: Maybe Base64
kerberosKeytab :: Maybe Base64
blockSize :: Maybe Natural
$sel:agentArns:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty Text
$sel:authenticationType:CreateLocationHdfs' :: CreateLocationHdfs -> HdfsAuthenticationType
$sel:nameNodes:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty HdfsNameNode
$sel:tags:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:simpleUser:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:replicationFactor:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
$sel:qopConfiguration:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe QopConfiguration
$sel:kmsKeyProviderUri:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:kerberosPrincipal:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:kerberosKrb5Conf:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
$sel:kerberosKeytab:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
$sel:blockSize:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
..} =
    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 Base64
kerberosKeytab
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
kerberosKrb5Conf
      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 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 Maybe Text
subdirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagListEntry]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty HdfsNameNode
nameNodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HdfsAuthenticationType
authenticationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
agentArns

instance Data.ToHeaders CreateLocationHdfs where
  toHeaders :: CreateLocationHdfs -> 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.CreateLocationHdfs" ::
                          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 CreateLocationHdfs where
  toJSON :: CreateLocationHdfs -> Value
toJSON CreateLocationHdfs' {Maybe Natural
Maybe [TagListEntry]
Maybe Text
Maybe Base64
Maybe QopConfiguration
NonEmpty Text
NonEmpty HdfsNameNode
HdfsAuthenticationType
agentArns :: NonEmpty Text
authenticationType :: HdfsAuthenticationType
nameNodes :: NonEmpty HdfsNameNode
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
simpleUser :: Maybe Text
replicationFactor :: Maybe Natural
qopConfiguration :: Maybe QopConfiguration
kmsKeyProviderUri :: Maybe Text
kerberosPrincipal :: Maybe Text
kerberosKrb5Conf :: Maybe Base64
kerberosKeytab :: Maybe Base64
blockSize :: Maybe Natural
$sel:agentArns:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty Text
$sel:authenticationType:CreateLocationHdfs' :: CreateLocationHdfs -> HdfsAuthenticationType
$sel:nameNodes:CreateLocationHdfs' :: CreateLocationHdfs -> NonEmpty HdfsNameNode
$sel:tags:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:simpleUser:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:replicationFactor:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
$sel:qopConfiguration:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe QopConfiguration
$sel:kmsKeyProviderUri:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:kerberosPrincipal:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Text
$sel:kerberosKrb5Conf:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
$sel:kerberosKeytab:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Base64
$sel:blockSize:CreateLocationHdfs' :: CreateLocationHdfs -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BlockSize" 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
blockSize,
            (Key
"KerberosKeytab" 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
kerberosKeytab,
            (Key
"KerberosKrb5Conf" 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
kerberosKrb5Conf,
            (Key
"KerberosPrincipal" 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
kerberosPrincipal,
            (Key
"KmsKeyProviderUri" 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
kmsKeyProviderUri,
            (Key
"QopConfiguration" 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 QopConfiguration
qopConfiguration,
            (Key
"ReplicationFactor" 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
replicationFactor,
            (Key
"SimpleUser" 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
simpleUser,
            (Key
"Subdirectory" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
subdirectory,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagListEntry]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"NameNodes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty HdfsNameNode
nameNodes),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AuthenticationType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HdfsAuthenticationType
authenticationType),
            forall a. a -> Maybe a
Prelude.Just (Key
"AgentArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
agentArns)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateLocationHdfsResponse' 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', 'createLocationHdfsResponse_locationArn' - The ARN of the source HDFS cluster location that\'s created.
--
-- 'httpStatus', 'createLocationHdfsResponse_httpStatus' - The response's http status code.
newCreateLocationHdfsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationHdfsResponse
newCreateLocationHdfsResponse :: Int -> CreateLocationHdfsResponse
newCreateLocationHdfsResponse Int
pHttpStatus_ =
  CreateLocationHdfsResponse'
    { $sel:locationArn:CreateLocationHdfsResponse' :: Maybe Text
locationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationHdfsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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