{-# 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.CreateLocationNfs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Defines a file system on a Network File System (NFS) server that can be
-- read from or written to.
module Amazonka.DataSync.CreateLocationNfs
  ( -- * Creating a Request
    CreateLocationNfs (..),
    newCreateLocationNfs,

    -- * Request Lenses
    createLocationNfs_mountOptions,
    createLocationNfs_tags,
    createLocationNfs_subdirectory,
    createLocationNfs_serverHostname,
    createLocationNfs_onPremConfig,

    -- * Destructuring the Response
    CreateLocationNfsResponse (..),
    newCreateLocationNfsResponse,

    -- * Response Lenses
    createLocationNfsResponse_locationArn,
    createLocationNfsResponse_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

-- | CreateLocationNfsRequest
--
-- /See:/ 'newCreateLocationNfs' smart constructor.
data CreateLocationNfs = CreateLocationNfs'
  { -- | The NFS mount options that DataSync can use to mount your NFS share.
    CreateLocationNfs -> Maybe NfsMountOptions
mountOptions :: Prelude.Maybe NfsMountOptions,
    -- | 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.
    CreateLocationNfs -> Maybe [TagListEntry]
tags :: Prelude.Maybe [TagListEntry],
    -- | The subdirectory in the NFS file system that is used to read data from
    -- the NFS source location or write data to the NFS destination. The NFS
    -- path should be a path that\'s exported by the NFS server, or a
    -- subdirectory of that path. The path should be such that it can be
    -- mounted by other NFS clients in your network.
    --
    -- To see all the paths exported by your NFS server, run
    -- \"@showmount -e nfs-server-name@\" from an NFS client that has access to
    -- your server. You can specify any directory that appears in the results,
    -- and any subdirectory of that directory. Ensure that the NFS export is
    -- accessible without Kerberos authentication.
    --
    -- To transfer all the data in the folder you specified, DataSync needs to
    -- have permissions to read all the data. To ensure this, either configure
    -- the NFS export with @no_root_squash,@ or ensure that the permissions for
    -- all of the files that you want DataSync allow read access for all users.
    -- Doing either enables the agent to read the files. For the agent to
    -- access directories, you must additionally enable all execute access.
    --
    -- If you are copying data to or from your Snowcone device, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
    -- for more information.
    --
    -- For information about NFS export configuration, see 18.7. The
    -- \/etc\/exports Configuration File in the Red Hat Enterprise Linux
    -- documentation.
    CreateLocationNfs -> Text
subdirectory :: Prelude.Text,
    -- | The name of the NFS server. This value is the IP address or Domain Name
    -- Service (DNS) name of the NFS server. An agent that is installed
    -- on-premises uses this hostname to mount the NFS server in a network.
    --
    -- If you are copying data to or from your Snowcone device, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
    -- for more information.
    --
    -- This name must either be DNS-compliant or must be an IP version 4 (IPv4)
    -- address.
    CreateLocationNfs -> Text
serverHostname :: Prelude.Text,
    -- | Contains a list of Amazon Resource Names (ARNs) of agents that are used
    -- to connect to an NFS server.
    --
    -- If you are copying data to or from your Snowcone device, see
    -- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
    -- for more information.
    CreateLocationNfs -> OnPremConfig
onPremConfig :: OnPremConfig
  }
  deriving (CreateLocationNfs -> CreateLocationNfs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLocationNfs -> CreateLocationNfs -> Bool
$c/= :: CreateLocationNfs -> CreateLocationNfs -> Bool
== :: CreateLocationNfs -> CreateLocationNfs -> Bool
$c== :: CreateLocationNfs -> CreateLocationNfs -> Bool
Prelude.Eq, ReadPrec [CreateLocationNfs]
ReadPrec CreateLocationNfs
Int -> ReadS CreateLocationNfs
ReadS [CreateLocationNfs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLocationNfs]
$creadListPrec :: ReadPrec [CreateLocationNfs]
readPrec :: ReadPrec CreateLocationNfs
$creadPrec :: ReadPrec CreateLocationNfs
readList :: ReadS [CreateLocationNfs]
$creadList :: ReadS [CreateLocationNfs]
readsPrec :: Int -> ReadS CreateLocationNfs
$creadsPrec :: Int -> ReadS CreateLocationNfs
Prelude.Read, Int -> CreateLocationNfs -> ShowS
[CreateLocationNfs] -> ShowS
CreateLocationNfs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLocationNfs] -> ShowS
$cshowList :: [CreateLocationNfs] -> ShowS
show :: CreateLocationNfs -> String
$cshow :: CreateLocationNfs -> String
showsPrec :: Int -> CreateLocationNfs -> ShowS
$cshowsPrec :: Int -> CreateLocationNfs -> ShowS
Prelude.Show, forall x. Rep CreateLocationNfs x -> CreateLocationNfs
forall x. CreateLocationNfs -> Rep CreateLocationNfs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLocationNfs x -> CreateLocationNfs
$cfrom :: forall x. CreateLocationNfs -> Rep CreateLocationNfs x
Prelude.Generic)

-- |
-- Create a value of 'CreateLocationNfs' 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:
--
-- 'mountOptions', 'createLocationNfs_mountOptions' - The NFS mount options that DataSync can use to mount your NFS share.
--
-- 'tags', 'createLocationNfs_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.
--
-- 'subdirectory', 'createLocationNfs_subdirectory' - The subdirectory in the NFS file system that is used to read data from
-- the NFS source location or write data to the NFS destination. The NFS
-- path should be a path that\'s exported by the NFS server, or a
-- subdirectory of that path. The path should be such that it can be
-- mounted by other NFS clients in your network.
--
-- To see all the paths exported by your NFS server, run
-- \"@showmount -e nfs-server-name@\" from an NFS client that has access to
-- your server. You can specify any directory that appears in the results,
-- and any subdirectory of that directory. Ensure that the NFS export is
-- accessible without Kerberos authentication.
--
-- To transfer all the data in the folder you specified, DataSync needs to
-- have permissions to read all the data. To ensure this, either configure
-- the NFS export with @no_root_squash,@ or ensure that the permissions for
-- all of the files that you want DataSync allow read access for all users.
-- Doing either enables the agent to read the files. For the agent to
-- access directories, you must additionally enable all execute access.
--
-- If you are copying data to or from your Snowcone device, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
-- for more information.
--
-- For information about NFS export configuration, see 18.7. The
-- \/etc\/exports Configuration File in the Red Hat Enterprise Linux
-- documentation.
--
-- 'serverHostname', 'createLocationNfs_serverHostname' - The name of the NFS server. This value is the IP address or Domain Name
-- Service (DNS) name of the NFS server. An agent that is installed
-- on-premises uses this hostname to mount the NFS server in a network.
--
-- If you are copying data to or from your Snowcone device, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
-- for more information.
--
-- This name must either be DNS-compliant or must be an IP version 4 (IPv4)
-- address.
--
-- 'onPremConfig', 'createLocationNfs_onPremConfig' - Contains a list of Amazon Resource Names (ARNs) of agents that are used
-- to connect to an NFS server.
--
-- If you are copying data to or from your Snowcone device, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
-- for more information.
newCreateLocationNfs ::
  -- | 'subdirectory'
  Prelude.Text ->
  -- | 'serverHostname'
  Prelude.Text ->
  -- | 'onPremConfig'
  OnPremConfig ->
  CreateLocationNfs
newCreateLocationNfs :: Text -> Text -> OnPremConfig -> CreateLocationNfs
newCreateLocationNfs
  Text
pSubdirectory_
  Text
pServerHostname_
  OnPremConfig
pOnPremConfig_ =
    CreateLocationNfs'
      { $sel:mountOptions:CreateLocationNfs' :: Maybe NfsMountOptions
mountOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLocationNfs' :: Maybe [TagListEntry]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:subdirectory:CreateLocationNfs' :: Text
subdirectory = Text
pSubdirectory_,
        $sel:serverHostname:CreateLocationNfs' :: Text
serverHostname = Text
pServerHostname_,
        $sel:onPremConfig:CreateLocationNfs' :: OnPremConfig
onPremConfig = OnPremConfig
pOnPremConfig_
      }

-- | The NFS mount options that DataSync can use to mount your NFS share.
createLocationNfs_mountOptions :: Lens.Lens' CreateLocationNfs (Prelude.Maybe NfsMountOptions)
createLocationNfs_mountOptions :: Lens' CreateLocationNfs (Maybe NfsMountOptions)
createLocationNfs_mountOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationNfs' {Maybe NfsMountOptions
mountOptions :: Maybe NfsMountOptions
$sel:mountOptions:CreateLocationNfs' :: CreateLocationNfs -> Maybe NfsMountOptions
mountOptions} -> Maybe NfsMountOptions
mountOptions) (\s :: CreateLocationNfs
s@CreateLocationNfs' {} Maybe NfsMountOptions
a -> CreateLocationNfs
s {$sel:mountOptions:CreateLocationNfs' :: Maybe NfsMountOptions
mountOptions = Maybe NfsMountOptions
a} :: CreateLocationNfs)

-- | 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.
createLocationNfs_tags :: Lens.Lens' CreateLocationNfs (Prelude.Maybe [TagListEntry])
createLocationNfs_tags :: Lens' CreateLocationNfs (Maybe [TagListEntry])
createLocationNfs_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationNfs' {Maybe [TagListEntry]
tags :: Maybe [TagListEntry]
$sel:tags:CreateLocationNfs' :: CreateLocationNfs -> Maybe [TagListEntry]
tags} -> Maybe [TagListEntry]
tags) (\s :: CreateLocationNfs
s@CreateLocationNfs' {} Maybe [TagListEntry]
a -> CreateLocationNfs
s {$sel:tags:CreateLocationNfs' :: Maybe [TagListEntry]
tags = Maybe [TagListEntry]
a} :: CreateLocationNfs) 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 subdirectory in the NFS file system that is used to read data from
-- the NFS source location or write data to the NFS destination. The NFS
-- path should be a path that\'s exported by the NFS server, or a
-- subdirectory of that path. The path should be such that it can be
-- mounted by other NFS clients in your network.
--
-- To see all the paths exported by your NFS server, run
-- \"@showmount -e nfs-server-name@\" from an NFS client that has access to
-- your server. You can specify any directory that appears in the results,
-- and any subdirectory of that directory. Ensure that the NFS export is
-- accessible without Kerberos authentication.
--
-- To transfer all the data in the folder you specified, DataSync needs to
-- have permissions to read all the data. To ensure this, either configure
-- the NFS export with @no_root_squash,@ or ensure that the permissions for
-- all of the files that you want DataSync allow read access for all users.
-- Doing either enables the agent to read the files. For the agent to
-- access directories, you must additionally enable all execute access.
--
-- If you are copying data to or from your Snowcone device, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
-- for more information.
--
-- For information about NFS export configuration, see 18.7. The
-- \/etc\/exports Configuration File in the Red Hat Enterprise Linux
-- documentation.
createLocationNfs_subdirectory :: Lens.Lens' CreateLocationNfs Prelude.Text
createLocationNfs_subdirectory :: Lens' CreateLocationNfs Text
createLocationNfs_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationNfs' {Text
subdirectory :: Text
$sel:subdirectory:CreateLocationNfs' :: CreateLocationNfs -> Text
subdirectory} -> Text
subdirectory) (\s :: CreateLocationNfs
s@CreateLocationNfs' {} Text
a -> CreateLocationNfs
s {$sel:subdirectory:CreateLocationNfs' :: Text
subdirectory = Text
a} :: CreateLocationNfs)

-- | The name of the NFS server. This value is the IP address or Domain Name
-- Service (DNS) name of the NFS server. An agent that is installed
-- on-premises uses this hostname to mount the NFS server in a network.
--
-- If you are copying data to or from your Snowcone device, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
-- for more information.
--
-- This name must either be DNS-compliant or must be an IP version 4 (IPv4)
-- address.
createLocationNfs_serverHostname :: Lens.Lens' CreateLocationNfs Prelude.Text
createLocationNfs_serverHostname :: Lens' CreateLocationNfs Text
createLocationNfs_serverHostname = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationNfs' {Text
serverHostname :: Text
$sel:serverHostname:CreateLocationNfs' :: CreateLocationNfs -> Text
serverHostname} -> Text
serverHostname) (\s :: CreateLocationNfs
s@CreateLocationNfs' {} Text
a -> CreateLocationNfs
s {$sel:serverHostname:CreateLocationNfs' :: Text
serverHostname = Text
a} :: CreateLocationNfs)

-- | Contains a list of Amazon Resource Names (ARNs) of agents that are used
-- to connect to an NFS server.
--
-- If you are copying data to or from your Snowcone device, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html#nfs-on-snowcone NFS Server on Snowcone>
-- for more information.
createLocationNfs_onPremConfig :: Lens.Lens' CreateLocationNfs OnPremConfig
createLocationNfs_onPremConfig :: Lens' CreateLocationNfs OnPremConfig
createLocationNfs_onPremConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationNfs' {OnPremConfig
onPremConfig :: OnPremConfig
$sel:onPremConfig:CreateLocationNfs' :: CreateLocationNfs -> OnPremConfig
onPremConfig} -> OnPremConfig
onPremConfig) (\s :: CreateLocationNfs
s@CreateLocationNfs' {} OnPremConfig
a -> CreateLocationNfs
s {$sel:onPremConfig:CreateLocationNfs' :: OnPremConfig
onPremConfig = OnPremConfig
a} :: CreateLocationNfs)

instance Core.AWSRequest CreateLocationNfs where
  type
    AWSResponse CreateLocationNfs =
      CreateLocationNfsResponse
  request :: (Service -> Service)
-> CreateLocationNfs -> Request CreateLocationNfs
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 CreateLocationNfs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLocationNfs)))
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 -> CreateLocationNfsResponse
CreateLocationNfsResponse'
            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 CreateLocationNfs where
  hashWithSalt :: Int -> CreateLocationNfs -> Int
hashWithSalt Int
_salt CreateLocationNfs' {Maybe [TagListEntry]
Maybe NfsMountOptions
Text
OnPremConfig
onPremConfig :: OnPremConfig
serverHostname :: Text
subdirectory :: Text
tags :: Maybe [TagListEntry]
mountOptions :: Maybe NfsMountOptions
$sel:onPremConfig:CreateLocationNfs' :: CreateLocationNfs -> OnPremConfig
$sel:serverHostname:CreateLocationNfs' :: CreateLocationNfs -> Text
$sel:subdirectory:CreateLocationNfs' :: CreateLocationNfs -> Text
$sel:tags:CreateLocationNfs' :: CreateLocationNfs -> Maybe [TagListEntry]
$sel:mountOptions:CreateLocationNfs' :: CreateLocationNfs -> Maybe NfsMountOptions
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NfsMountOptions
mountOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagListEntry]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverHostname
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OnPremConfig
onPremConfig

instance Prelude.NFData CreateLocationNfs where
  rnf :: CreateLocationNfs -> ()
rnf CreateLocationNfs' {Maybe [TagListEntry]
Maybe NfsMountOptions
Text
OnPremConfig
onPremConfig :: OnPremConfig
serverHostname :: Text
subdirectory :: Text
tags :: Maybe [TagListEntry]
mountOptions :: Maybe NfsMountOptions
$sel:onPremConfig:CreateLocationNfs' :: CreateLocationNfs -> OnPremConfig
$sel:serverHostname:CreateLocationNfs' :: CreateLocationNfs -> Text
$sel:subdirectory:CreateLocationNfs' :: CreateLocationNfs -> Text
$sel:tags:CreateLocationNfs' :: CreateLocationNfs -> Maybe [TagListEntry]
$sel:mountOptions:CreateLocationNfs' :: CreateLocationNfs -> Maybe NfsMountOptions
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe NfsMountOptions
mountOptions
      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
subdirectory
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serverHostname
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OnPremConfig
onPremConfig

instance Data.ToHeaders CreateLocationNfs where
  toHeaders :: CreateLocationNfs -> 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.CreateLocationNfs" ::
                          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 CreateLocationNfs where
  toJSON :: CreateLocationNfs -> Value
toJSON CreateLocationNfs' {Maybe [TagListEntry]
Maybe NfsMountOptions
Text
OnPremConfig
onPremConfig :: OnPremConfig
serverHostname :: Text
subdirectory :: Text
tags :: Maybe [TagListEntry]
mountOptions :: Maybe NfsMountOptions
$sel:onPremConfig:CreateLocationNfs' :: CreateLocationNfs -> OnPremConfig
$sel:serverHostname:CreateLocationNfs' :: CreateLocationNfs -> Text
$sel:subdirectory:CreateLocationNfs' :: CreateLocationNfs -> Text
$sel:tags:CreateLocationNfs' :: CreateLocationNfs -> Maybe [TagListEntry]
$sel:mountOptions:CreateLocationNfs' :: CreateLocationNfs -> Maybe NfsMountOptions
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MountOptions" 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 NfsMountOptions
mountOptions,
            (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
"Subdirectory" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
subdirectory),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ServerHostname" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serverHostname),
            forall a. a -> Maybe a
Prelude.Just (Key
"OnPremConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OnPremConfig
onPremConfig)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateLocationNfsResponse' 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', 'createLocationNfsResponse_locationArn' - The Amazon Resource Name (ARN) of the source NFS file system location
-- that is created.
--
-- 'httpStatus', 'createLocationNfsResponse_httpStatus' - The response's http status code.
newCreateLocationNfsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLocationNfsResponse
newCreateLocationNfsResponse :: Int -> CreateLocationNfsResponse
newCreateLocationNfsResponse Int
pHttpStatus_ =
  CreateLocationNfsResponse'
    { $sel:locationArn:CreateLocationNfsResponse' :: Maybe Text
locationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLocationNfsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the source NFS file system location
-- that is created.
createLocationNfsResponse_locationArn :: Lens.Lens' CreateLocationNfsResponse (Prelude.Maybe Prelude.Text)
createLocationNfsResponse_locationArn :: Lens' CreateLocationNfsResponse (Maybe Text)
createLocationNfsResponse_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLocationNfsResponse' {Maybe Text
locationArn :: Maybe Text
$sel:locationArn:CreateLocationNfsResponse' :: CreateLocationNfsResponse -> Maybe Text
locationArn} -> Maybe Text
locationArn) (\s :: CreateLocationNfsResponse
s@CreateLocationNfsResponse' {} Maybe Text
a -> CreateLocationNfsResponse
s {$sel:locationArn:CreateLocationNfsResponse' :: Maybe Text
locationArn = Maybe Text
a} :: CreateLocationNfsResponse)

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

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