{-# 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.CreateLocationEfs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an endpoint for an Amazon EFS file system that DataSync can
-- access for a transfer. For more information, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-efs-location.html Creating a location for Amazon EFS>.
module Amazonka.DataSync.CreateLocationEfs
  ( -- * Creating a Request
    CreateLocationEfs (..),
    newCreateLocationEfs,

    -- * Request Lenses
    createLocationEfs_accessPointArn,
    createLocationEfs_fileSystemAccessRoleArn,
    createLocationEfs_inTransitEncryption,
    createLocationEfs_subdirectory,
    createLocationEfs_tags,
    createLocationEfs_efsFilesystemArn,
    createLocationEfs_ec2Config,

    -- * Destructuring the Response
    CreateLocationEfsResponse (..),
    newCreateLocationEfsResponse,

    -- * Response Lenses
    createLocationEfsResponse_locationArn,
    createLocationEfsResponse_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

-- | CreateLocationEfsRequest
--
-- /See:/ 'newCreateLocationEfs' smart constructor.
data CreateLocationEfs = CreateLocationEfs'
  { -- | Specifies the Amazon Resource Name (ARN) of the access point that
    -- DataSync uses to access the Amazon EFS file system.
    CreateLocationEfs -> Maybe Text
accessPointArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies an Identity and Access Management (IAM) role that DataSync
    -- assumes when mounting the Amazon EFS file system.
    CreateLocationEfs -> Maybe Text
fileSystemAccessRoleArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether you want DataSync to use Transport Layer Security
    -- (TLS) 1.2 encryption when it copies data to or from the Amazon EFS file
    -- system.
    --
    -- If you specify an access point using @AccessPointArn@ or an IAM role
    -- using @FileSystemAccessRoleArn@, you must set this parameter to
    -- @TLS1_2@.
    CreateLocationEfs -> Maybe EfsInTransitEncryption
inTransitEncryption :: Prelude.Maybe EfsInTransitEncryption,
    -- | Specifies a mount path for your Amazon EFS file system. This is where
    -- DataSync reads or writes data (depending on if this is a source or
    -- destination location). By default, DataSync uses the root directory, but
    -- you can also include subdirectories.
    --
    -- You must specify a value with forward slashes (for example,
    -- @\/path\/to\/folder@).
    CreateLocationEfs -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | Specifies the key-value pair that represents a tag that you want to add
    -- to the resource. The value can be an empty string. This value helps you
    -- manage, filter, and search for your resources. We recommend that you
    -- create a name tag for your location.
    CreateLocationEfs -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | Specifies the ARN for the Amazon EFS file system.
    CreateLocationEfs -> Text
efsFilesystemArn :: Prelude.Text,
    -- | Specifies the subnet and security groups DataSync uses to access your
    -- Amazon EFS file system.
    CreateLocationEfs -> Ec2Config
ec2Config :: Ec2Config
  }
  deriving (CreateLocationEfs -> CreateLocationEfs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationEfs -> CreateLocationEfs -> Bool
$c/= :: CreateLocationEfs -> CreateLocationEfs -> Bool
== :: CreateLocationEfs -> CreateLocationEfs -> Bool
$c== :: CreateLocationEfs -> CreateLocationEfs -> Bool
Prelude.Eq, ReadPrec [CreateLocationEfs]
ReadPrec CreateLocationEfs
Int -> ReadS CreateLocationEfs
ReadS [CreateLocationEfs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocationEfs]
$creadListPrec :: ReadPrec [CreateLocationEfs]
readPrec :: ReadPrec CreateLocationEfs
$creadPrec :: ReadPrec CreateLocationEfs
readList :: ReadS [CreateLocationEfs]
$creadList :: ReadS [CreateLocationEfs]
readsPrec :: Int -> ReadS CreateLocationEfs
$creadsPrec :: Int -> ReadS CreateLocationEfs
Prelude.Read, Int -> CreateLocationEfs -> ShowS
[CreateLocationEfs] -> ShowS
CreateLocationEfs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationEfs] -> ShowS
$cshowList :: [CreateLocationEfs] -> ShowS
show :: CreateLocationEfs -> String
$cshow :: CreateLocationEfs -> String
showsPrec :: Int -> CreateLocationEfs -> ShowS
$cshowsPrec :: Int -> CreateLocationEfs -> ShowS
Prelude.Show, forall x. Rep CreateLocationEfs x -> CreateLocationEfs
forall x. CreateLocationEfs -> Rep CreateLocationEfs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLocationEfs x -> CreateLocationEfs
$cfrom :: forall x. CreateLocationEfs -> Rep CreateLocationEfs x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationEfs' 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:
--
-- 'accessPointArn', 'createLocationEfs_accessPointArn' - Specifies the Amazon Resource Name (ARN) of the access point that
-- DataSync uses to access the Amazon EFS file system.
--
-- 'fileSystemAccessRoleArn', 'createLocationEfs_fileSystemAccessRoleArn' - Specifies an Identity and Access Management (IAM) role that DataSync
-- assumes when mounting the Amazon EFS file system.
--
-- 'inTransitEncryption', 'createLocationEfs_inTransitEncryption' - Specifies whether you want DataSync to use Transport Layer Security
-- (TLS) 1.2 encryption when it copies data to or from the Amazon EFS file
-- system.
--
-- If you specify an access point using @AccessPointArn@ or an IAM role
-- using @FileSystemAccessRoleArn@, you must set this parameter to
-- @TLS1_2@.
--
-- 'subdirectory', 'createLocationEfs_subdirectory' - Specifies a mount path for your Amazon EFS file system. This is where
-- DataSync reads or writes data (depending on if this is a source or
-- destination location). By default, DataSync uses the root directory, but
-- you can also include subdirectories.
--
-- You must specify a value with forward slashes (for example,
-- @\/path\/to\/folder@).
--
-- 'tags', 'createLocationEfs_tags' - Specifies the key-value pair that represents a tag that you want to add
-- to the resource. The value can be an empty string. This value helps you
-- manage, filter, and search for your resources. We recommend that you
-- create a name tag for your location.
--
-- 'efsFilesystemArn', 'createLocationEfs_efsFilesystemArn' - Specifies the ARN for the Amazon EFS file system.
--
-- 'ec2Config', 'createLocationEfs_ec2Config' - Specifies the subnet and security groups DataSync uses to access your
-- Amazon EFS file system.
newCreateLocationEfs ::
  -- | 'efsFilesystemArn'
  Prelude.Text ->
  -- | 'ec2Config'
  Ec2Config ->
  CreateLocationEfs
newCreateLocationEfs :: Text -> Ec2Config -> CreateLocationEfs
newCreateLocationEfs Text
pEfsFilesystemArn_ Ec2Config
pEc2Config_ =
  CreateLocationEfs'
    { $sel:accessPointArn:CreateLocationEfs' :: Maybe Text
accessPointArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:fileSystemAccessRoleArn:CreateLocationEfs' :: Maybe Text
fileSystemAccessRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:inTransitEncryption:CreateLocationEfs' :: Maybe EfsInTransitEncryption
inTransitEncryption = forall a. Maybe a
Prelude.Nothing,
      $sel:subdirectory:CreateLocationEfs' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateLocationEfs' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:efsFilesystemArn:CreateLocationEfs' :: Text
efsFilesystemArn = Text
pEfsFilesystemArn_,
      $sel:ec2Config:CreateLocationEfs' :: Ec2Config
ec2Config = Ec2Config
pEc2Config_
    }

-- | Specifies the Amazon Resource Name (ARN) of the access point that
-- DataSync uses to access the Amazon EFS file system.
createLocationEfs_accessPointArn :: Lens.Lens' CreateLocationEfs (Prelude.Maybe Prelude.Text)
createLocationEfs_accessPointArn :: Lens' CreateLocationEfs (Maybe Text)
createLocationEfs_accessPointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfs' {Maybe Text
accessPointArn :: Maybe Text
$sel:accessPointArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
accessPointArn} -> Maybe Text
accessPointArn) (\s :: CreateLocationEfs
s@CreateLocationEfs' {} Maybe Text
a -> CreateLocationEfs
s {$sel:accessPointArn:CreateLocationEfs' :: Maybe Text
accessPointArn = Maybe Text
a} :: CreateLocationEfs)

-- | Specifies an Identity and Access Management (IAM) role that DataSync
-- assumes when mounting the Amazon EFS file system.
createLocationEfs_fileSystemAccessRoleArn :: Lens.Lens' CreateLocationEfs (Prelude.Maybe Prelude.Text)
createLocationEfs_fileSystemAccessRoleArn :: Lens' CreateLocationEfs (Maybe Text)
createLocationEfs_fileSystemAccessRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfs' {Maybe Text
fileSystemAccessRoleArn :: Maybe Text
$sel:fileSystemAccessRoleArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
fileSystemAccessRoleArn} -> Maybe Text
fileSystemAccessRoleArn) (\s :: CreateLocationEfs
s@CreateLocationEfs' {} Maybe Text
a -> CreateLocationEfs
s {$sel:fileSystemAccessRoleArn:CreateLocationEfs' :: Maybe Text
fileSystemAccessRoleArn = Maybe Text
a} :: CreateLocationEfs)

-- | Specifies whether you want DataSync to use Transport Layer Security
-- (TLS) 1.2 encryption when it copies data to or from the Amazon EFS file
-- system.
--
-- If you specify an access point using @AccessPointArn@ or an IAM role
-- using @FileSystemAccessRoleArn@, you must set this parameter to
-- @TLS1_2@.
createLocationEfs_inTransitEncryption :: Lens.Lens' CreateLocationEfs (Prelude.Maybe EfsInTransitEncryption)
createLocationEfs_inTransitEncryption :: Lens' CreateLocationEfs (Maybe EfsInTransitEncryption)
createLocationEfs_inTransitEncryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfs' {Maybe EfsInTransitEncryption
inTransitEncryption :: Maybe EfsInTransitEncryption
$sel:inTransitEncryption:CreateLocationEfs' :: CreateLocationEfs -> Maybe EfsInTransitEncryption
inTransitEncryption} -> Maybe EfsInTransitEncryption
inTransitEncryption) (\s :: CreateLocationEfs
s@CreateLocationEfs' {} Maybe EfsInTransitEncryption
a -> CreateLocationEfs
s {$sel:inTransitEncryption:CreateLocationEfs' :: Maybe EfsInTransitEncryption
inTransitEncryption = Maybe EfsInTransitEncryption
a} :: CreateLocationEfs)

-- | Specifies a mount path for your Amazon EFS file system. This is where
-- DataSync reads or writes data (depending on if this is a source or
-- destination location). By default, DataSync uses the root directory, but
-- you can also include subdirectories.
--
-- You must specify a value with forward slashes (for example,
-- @\/path\/to\/folder@).
createLocationEfs_subdirectory :: Lens.Lens' CreateLocationEfs (Prelude.Maybe Prelude.Text)
createLocationEfs_subdirectory :: Lens' CreateLocationEfs (Maybe Text)
createLocationEfs_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfs' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: CreateLocationEfs
s@CreateLocationEfs' {} Maybe Text
a -> CreateLocationEfs
s {$sel:subdirectory:CreateLocationEfs' :: Maybe Text
subdirectory = Maybe Text
a} :: CreateLocationEfs)

-- | Specifies the key-value pair that represents a tag that you want to add
-- to the resource. The value can be an empty string. This value helps you
-- manage, filter, and search for your resources. We recommend that you
-- create a name tag for your location.
createLocationEfs_tags :: Lens.Lens' CreateLocationEfs (Prelude.Maybe [TagListEntry])
createLocationEfs_tags :: Lens' CreateLocationEfs (Maybe [TagListEntry])
createLocationEfs_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfs' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateLocationEfs' :: CreateLocationEfs -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateLocationEfs
s@CreateLocationEfs' {} Maybe [TagListEntry]
a -> CreateLocationEfs
s {$sel:tags:CreateLocationEfs' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateLocationEfs) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies the ARN for the Amazon EFS file system.
createLocationEfs_efsFilesystemArn :: Lens.Lens' CreateLocationEfs Prelude.Text
createLocationEfs_efsFilesystemArn :: Lens' CreateLocationEfs Text
createLocationEfs_efsFilesystemArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfs' {Text
efsFilesystemArn :: Text
$sel:efsFilesystemArn:CreateLocationEfs' :: CreateLocationEfs -> Text
efsFilesystemArn} -> Text
efsFilesystemArn) (\s :: CreateLocationEfs
s@CreateLocationEfs' {} Text
a -> CreateLocationEfs
s {$sel:efsFilesystemArn:CreateLocationEfs' :: Text
efsFilesystemArn = Text
a} :: CreateLocationEfs)

-- | Specifies the subnet and security groups DataSync uses to access your
-- Amazon EFS file system.
createLocationEfs_ec2Config :: Lens.Lens' CreateLocationEfs Ec2Config
createLocationEfs_ec2Config :: Lens' CreateLocationEfs Ec2Config
createLocationEfs_ec2Config = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfs' {Ec2Config
ec2Config :: Ec2Config
$sel:ec2Config:CreateLocationEfs' :: CreateLocationEfs -> Ec2Config
ec2Config} -> Ec2Config
ec2Config) (\s :: CreateLocationEfs
s@CreateLocationEfs' {} Ec2Config
a -> CreateLocationEfs
s {$sel:ec2Config:CreateLocationEfs' :: Ec2Config
ec2Config = Ec2Config
a} :: CreateLocationEfs)

instance Core.AWSRequest CreateLocationEfs where
  type
    AWSResponse CreateLocationEfs =
      CreateLocationEfsResponse
  request :: (Service -> Service)
-> CreateLocationEfs -> Request CreateLocationEfs
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 CreateLocationEfs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLocationEfs)))
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 -> CreateLocationEfsResponse
CreateLocationEfsResponse'
            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 CreateLocationEfs where
  hashWithSalt :: Int -> CreateLocationEfs -> Int
hashWithSalt Int
_salt CreateLocationEfs' {Maybe [TagListEntry]
Maybe Text
Maybe EfsInTransitEncryption
Text
Ec2Config
ec2Config :: Ec2Config
efsFilesystemArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
inTransitEncryption :: Maybe EfsInTransitEncryption
fileSystemAccessRoleArn :: Maybe Text
accessPointArn :: Maybe Text
$sel:ec2Config:CreateLocationEfs' :: CreateLocationEfs -> Ec2Config
$sel:efsFilesystemArn:CreateLocationEfs' :: CreateLocationEfs -> Text
$sel:tags:CreateLocationEfs' :: CreateLocationEfs -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
$sel:inTransitEncryption:CreateLocationEfs' :: CreateLocationEfs -> Maybe EfsInTransitEncryption
$sel:fileSystemAccessRoleArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
$sel:accessPointArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accessPointArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
fileSystemAccessRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EfsInTransitEncryption
inTransitEncryption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
efsFilesystemArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Ec2Config
ec2Config

instance Prelude.NFData CreateLocationEfs where
  rnf :: CreateLocationEfs -> ()
rnf CreateLocationEfs' {Maybe [TagListEntry]
Maybe Text
Maybe EfsInTransitEncryption
Text
Ec2Config
ec2Config :: Ec2Config
efsFilesystemArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
inTransitEncryption :: Maybe EfsInTransitEncryption
fileSystemAccessRoleArn :: Maybe Text
accessPointArn :: Maybe Text
$sel:ec2Config:CreateLocationEfs' :: CreateLocationEfs -> Ec2Config
$sel:efsFilesystemArn:CreateLocationEfs' :: CreateLocationEfs -> Text
$sel:tags:CreateLocationEfs' :: CreateLocationEfs -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
$sel:inTransitEncryption:CreateLocationEfs' :: CreateLocationEfs -> Maybe EfsInTransitEncryption
$sel:fileSystemAccessRoleArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
$sel:accessPointArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accessPointArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fileSystemAccessRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EfsInTransitEncryption
inTransitEncryption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subdirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagListEntry]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
efsFilesystemArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Ec2Config
ec2Config

instance Data.ToHeaders CreateLocationEfs where
  toHeaders :: CreateLocationEfs -> 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.CreateLocationEfs" ::
                          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 CreateLocationEfs where
  toJSON :: CreateLocationEfs -> Value
toJSON CreateLocationEfs' {Maybe [TagListEntry]
Maybe Text
Maybe EfsInTransitEncryption
Text
Ec2Config
ec2Config :: Ec2Config
efsFilesystemArn :: Text
tags :: Maybe [TagListEntry]
subdirectory :: Maybe Text
inTransitEncryption :: Maybe EfsInTransitEncryption
fileSystemAccessRoleArn :: Maybe Text
accessPointArn :: Maybe Text
$sel:ec2Config:CreateLocationEfs' :: CreateLocationEfs -> Ec2Config
$sel:efsFilesystemArn:CreateLocationEfs' :: CreateLocationEfs -> Text
$sel:tags:CreateLocationEfs' :: CreateLocationEfs -> Maybe [TagListEntry]
$sel:subdirectory:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
$sel:inTransitEncryption:CreateLocationEfs' :: CreateLocationEfs -> Maybe EfsInTransitEncryption
$sel:fileSystemAccessRoleArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
$sel:accessPointArn:CreateLocationEfs' :: CreateLocationEfs -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessPointArn" 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
accessPointArn,
            (Key
"FileSystemAccessRoleArn" 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
fileSystemAccessRoleArn,
            (Key
"InTransitEncryption" 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 EfsInTransitEncryption
inTransitEncryption,
            (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
"EfsFilesystemArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
efsFilesystemArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Ec2Config" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Ec2Config
ec2Config)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateLocationEfsResponse' 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', 'createLocationEfsResponse_locationArn' - The Amazon Resource Name (ARN) of the Amazon EFS file system location
-- that you create.
--
-- 'httpStatus', 'createLocationEfsResponse_httpStatus' - The response's http status code.
newCreateLocationEfsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationEfsResponse
newCreateLocationEfsResponse :: Int -> CreateLocationEfsResponse
newCreateLocationEfsResponse Int
pHttpStatus_ =
  CreateLocationEfsResponse'
    { $sel:locationArn:CreateLocationEfsResponse' :: Maybe Text
locationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationEfsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the Amazon EFS file system location
-- that you create.
createLocationEfsResponse_locationArn :: Lens.Lens' CreateLocationEfsResponse (Prelude.Maybe Prelude.Text)
createLocationEfsResponse_locationArn :: Lens' CreateLocationEfsResponse (Maybe Text)
createLocationEfsResponse_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationEfsResponse' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:CreateLocationEfsResponse' :: CreateLocationEfsResponse -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: CreateLocationEfsResponse
s@CreateLocationEfsResponse' {} Maybe Text
a -> CreateLocationEfsResponse
s {$sel:locationArn:CreateLocationEfsResponse' :: Maybe Text
locationArn = Maybe Text
a} :: CreateLocationEfsResponse)

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

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