{-# 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.UpdateLocationNfs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates some of the parameters of a previously created location for
-- Network File System (NFS) access. For information about creating an NFS
-- location, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-nfs-location.html Creating a location for NFS>.
module Amazonka.DataSync.UpdateLocationNfs
  ( -- * Creating a Request
    UpdateLocationNfs (..),
    newUpdateLocationNfs,

    -- * Request Lenses
    updateLocationNfs_mountOptions,
    updateLocationNfs_onPremConfig,
    updateLocationNfs_subdirectory,
    updateLocationNfs_locationArn,

    -- * Destructuring the Response
    UpdateLocationNfsResponse (..),
    newUpdateLocationNfsResponse,

    -- * Response Lenses
    updateLocationNfsResponse_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:/ 'newUpdateLocationNfs' smart constructor.
data UpdateLocationNfs = UpdateLocationNfs'
  { UpdateLocationNfs -> Maybe NfsMountOptions
mountOptions :: Prelude.Maybe NfsMountOptions,
    UpdateLocationNfs -> Maybe OnPremConfig
onPremConfig :: Prelude.Maybe OnPremConfig,
    -- | 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 that you specified, DataSync must
    -- have permissions to read all the data. To ensure this, either configure
    -- the NFS export with @no_root_squash@, or ensure that the files you want
    -- DataSync to access have permissions that allow read access for all
    -- users. Doing either option 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.
    UpdateLocationNfs -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the NFS location to update.
    UpdateLocationNfs -> Text
locationArn :: Prelude.Text
  }
  deriving (UpdateLocationNfs -> UpdateLocationNfs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLocationNfs -> UpdateLocationNfs -> Bool
$c/= :: UpdateLocationNfs -> UpdateLocationNfs -> Bool
== :: UpdateLocationNfs -> UpdateLocationNfs -> Bool
$c== :: UpdateLocationNfs -> UpdateLocationNfs -> Bool
Prelude.Eq, ReadPrec [UpdateLocationNfs]
ReadPrec UpdateLocationNfs
Int -> ReadS UpdateLocationNfs
ReadS [UpdateLocationNfs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLocationNfs]
$creadListPrec :: ReadPrec [UpdateLocationNfs]
readPrec :: ReadPrec UpdateLocationNfs
$creadPrec :: ReadPrec UpdateLocationNfs
readList :: ReadS [UpdateLocationNfs]
$creadList :: ReadS [UpdateLocationNfs]
readsPrec :: Int -> ReadS UpdateLocationNfs
$creadsPrec :: Int -> ReadS UpdateLocationNfs
Prelude.Read, Int -> UpdateLocationNfs -> ShowS
[UpdateLocationNfs] -> ShowS
UpdateLocationNfs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLocationNfs] -> ShowS
$cshowList :: [UpdateLocationNfs] -> ShowS
show :: UpdateLocationNfs -> String
$cshow :: UpdateLocationNfs -> String
showsPrec :: Int -> UpdateLocationNfs -> ShowS
$cshowsPrec :: Int -> UpdateLocationNfs -> ShowS
Prelude.Show, forall x. Rep UpdateLocationNfs x -> UpdateLocationNfs
forall x. UpdateLocationNfs -> Rep UpdateLocationNfs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLocationNfs x -> UpdateLocationNfs
$cfrom :: forall x. UpdateLocationNfs -> Rep UpdateLocationNfs x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLocationNfs' 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', 'updateLocationNfs_mountOptions' - Undocumented member.
--
-- 'onPremConfig', 'updateLocationNfs_onPremConfig' - Undocumented member.
--
-- 'subdirectory', 'updateLocationNfs_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 that you specified, DataSync must
-- have permissions to read all the data. To ensure this, either configure
-- the NFS export with @no_root_squash@, or ensure that the files you want
-- DataSync to access have permissions that allow read access for all
-- users. Doing either option 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.
--
-- 'locationArn', 'updateLocationNfs_locationArn' - The Amazon Resource Name (ARN) of the NFS location to update.
newUpdateLocationNfs ::
  -- | 'locationArn'
  Prelude.Text ->
  UpdateLocationNfs
newUpdateLocationNfs :: Text -> UpdateLocationNfs
newUpdateLocationNfs Text
pLocationArn_ =
  UpdateLocationNfs'
    { $sel:mountOptions:UpdateLocationNfs' :: Maybe NfsMountOptions
mountOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:onPremConfig:UpdateLocationNfs' :: Maybe OnPremConfig
onPremConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:subdirectory:UpdateLocationNfs' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
      $sel:locationArn:UpdateLocationNfs' :: Text
locationArn = Text
pLocationArn_
    }

-- | Undocumented member.
updateLocationNfs_mountOptions :: Lens.Lens' UpdateLocationNfs (Prelude.Maybe NfsMountOptions)
updateLocationNfs_mountOptions :: Lens' UpdateLocationNfs (Maybe NfsMountOptions)
updateLocationNfs_mountOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationNfs' {Maybe NfsMountOptions
mountOptions :: Maybe NfsMountOptions
$sel:mountOptions:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe NfsMountOptions
mountOptions} -> Maybe NfsMountOptions
mountOptions) (\s :: UpdateLocationNfs
s@UpdateLocationNfs' {} Maybe NfsMountOptions
a -> UpdateLocationNfs
s {$sel:mountOptions:UpdateLocationNfs' :: Maybe NfsMountOptions
mountOptions = Maybe NfsMountOptions
a} :: UpdateLocationNfs)

-- | Undocumented member.
updateLocationNfs_onPremConfig :: Lens.Lens' UpdateLocationNfs (Prelude.Maybe OnPremConfig)
updateLocationNfs_onPremConfig :: Lens' UpdateLocationNfs (Maybe OnPremConfig)
updateLocationNfs_onPremConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationNfs' {Maybe OnPremConfig
onPremConfig :: Maybe OnPremConfig
$sel:onPremConfig:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe OnPremConfig
onPremConfig} -> Maybe OnPremConfig
onPremConfig) (\s :: UpdateLocationNfs
s@UpdateLocationNfs' {} Maybe OnPremConfig
a -> UpdateLocationNfs
s {$sel:onPremConfig:UpdateLocationNfs' :: Maybe OnPremConfig
onPremConfig = Maybe OnPremConfig
a} :: UpdateLocationNfs)

-- | 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 that you specified, DataSync must
-- have permissions to read all the data. To ensure this, either configure
-- the NFS export with @no_root_squash@, or ensure that the files you want
-- DataSync to access have permissions that allow read access for all
-- users. Doing either option 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.
updateLocationNfs_subdirectory :: Lens.Lens' UpdateLocationNfs (Prelude.Maybe Prelude.Text)
updateLocationNfs_subdirectory :: Lens' UpdateLocationNfs (Maybe Text)
updateLocationNfs_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationNfs' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: UpdateLocationNfs
s@UpdateLocationNfs' {} Maybe Text
a -> UpdateLocationNfs
s {$sel:subdirectory:UpdateLocationNfs' :: Maybe Text
subdirectory = Maybe Text
a} :: UpdateLocationNfs)

-- | The Amazon Resource Name (ARN) of the NFS location to update.
updateLocationNfs_locationArn :: Lens.Lens' UpdateLocationNfs Prelude.Text
updateLocationNfs_locationArn :: Lens' UpdateLocationNfs Text
updateLocationNfs_locationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationNfs' {Text
locationArn :: Text
$sel:locationArn:UpdateLocationNfs' :: UpdateLocationNfs -> Text
locationArn} -> Text
locationArn) (\s :: UpdateLocationNfs
s@UpdateLocationNfs' {} Text
a -> UpdateLocationNfs
s {$sel:locationArn:UpdateLocationNfs' :: Text
locationArn = Text
a} :: UpdateLocationNfs)

instance Core.AWSRequest UpdateLocationNfs where
  type
    AWSResponse UpdateLocationNfs =
      UpdateLocationNfsResponse
  request :: (Service -> Service)
-> UpdateLocationNfs -> Request UpdateLocationNfs
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 UpdateLocationNfs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateLocationNfs)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateLocationNfsResponse
UpdateLocationNfsResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateLocationNfs where
  hashWithSalt :: Int -> UpdateLocationNfs -> Int
hashWithSalt Int
_salt UpdateLocationNfs' {Maybe Text
Maybe NfsMountOptions
Maybe OnPremConfig
Text
locationArn :: Text
subdirectory :: Maybe Text
onPremConfig :: Maybe OnPremConfig
mountOptions :: Maybe NfsMountOptions
$sel:locationArn:UpdateLocationNfs' :: UpdateLocationNfs -> Text
$sel:subdirectory:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe Text
$sel:onPremConfig:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe OnPremConfig
$sel:mountOptions:UpdateLocationNfs' :: UpdateLocationNfs -> 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 OnPremConfig
onPremConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
locationArn

instance Prelude.NFData UpdateLocationNfs where
  rnf :: UpdateLocationNfs -> ()
rnf UpdateLocationNfs' {Maybe Text
Maybe NfsMountOptions
Maybe OnPremConfig
Text
locationArn :: Text
subdirectory :: Maybe Text
onPremConfig :: Maybe OnPremConfig
mountOptions :: Maybe NfsMountOptions
$sel:locationArn:UpdateLocationNfs' :: UpdateLocationNfs -> Text
$sel:subdirectory:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe Text
$sel:onPremConfig:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe OnPremConfig
$sel:mountOptions:UpdateLocationNfs' :: UpdateLocationNfs -> 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 OnPremConfig
onPremConfig
      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 Text
locationArn

instance Data.ToHeaders UpdateLocationNfs where
  toHeaders :: UpdateLocationNfs -> 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.UpdateLocationNfs" ::
                          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 UpdateLocationNfs where
  toJSON :: UpdateLocationNfs -> Value
toJSON UpdateLocationNfs' {Maybe Text
Maybe NfsMountOptions
Maybe OnPremConfig
Text
locationArn :: Text
subdirectory :: Maybe Text
onPremConfig :: Maybe OnPremConfig
mountOptions :: Maybe NfsMountOptions
$sel:locationArn:UpdateLocationNfs' :: UpdateLocationNfs -> Text
$sel:subdirectory:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe Text
$sel:onPremConfig:UpdateLocationNfs' :: UpdateLocationNfs -> Maybe OnPremConfig
$sel:mountOptions:UpdateLocationNfs' :: UpdateLocationNfs -> 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
"OnPremConfig" 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 OnPremConfig
onPremConfig,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"LocationArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
locationArn)
          ]
      )

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

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

-- | /See:/ 'newUpdateLocationNfsResponse' smart constructor.
data UpdateLocationNfsResponse = UpdateLocationNfsResponse'
  { -- | The response's http status code.
    UpdateLocationNfsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateLocationNfsResponse -> UpdateLocationNfsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLocationNfsResponse -> UpdateLocationNfsResponse -> Bool
$c/= :: UpdateLocationNfsResponse -> UpdateLocationNfsResponse -> Bool
== :: UpdateLocationNfsResponse -> UpdateLocationNfsResponse -> Bool
$c== :: UpdateLocationNfsResponse -> UpdateLocationNfsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateLocationNfsResponse]
ReadPrec UpdateLocationNfsResponse
Int -> ReadS UpdateLocationNfsResponse
ReadS [UpdateLocationNfsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLocationNfsResponse]
$creadListPrec :: ReadPrec [UpdateLocationNfsResponse]
readPrec :: ReadPrec UpdateLocationNfsResponse
$creadPrec :: ReadPrec UpdateLocationNfsResponse
readList :: ReadS [UpdateLocationNfsResponse]
$creadList :: ReadS [UpdateLocationNfsResponse]
readsPrec :: Int -> ReadS UpdateLocationNfsResponse
$creadsPrec :: Int -> ReadS UpdateLocationNfsResponse
Prelude.Read, Int -> UpdateLocationNfsResponse -> ShowS
[UpdateLocationNfsResponse] -> ShowS
UpdateLocationNfsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLocationNfsResponse] -> ShowS
$cshowList :: [UpdateLocationNfsResponse] -> ShowS
show :: UpdateLocationNfsResponse -> String
$cshow :: UpdateLocationNfsResponse -> String
showsPrec :: Int -> UpdateLocationNfsResponse -> ShowS
$cshowsPrec :: Int -> UpdateLocationNfsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateLocationNfsResponse x -> UpdateLocationNfsResponse
forall x.
UpdateLocationNfsResponse -> Rep UpdateLocationNfsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateLocationNfsResponse x -> UpdateLocationNfsResponse
$cfrom :: forall x.
UpdateLocationNfsResponse -> Rep UpdateLocationNfsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLocationNfsResponse' 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:
--
-- 'httpStatus', 'updateLocationNfsResponse_httpStatus' - The response's http status code.
newUpdateLocationNfsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateLocationNfsResponse
newUpdateLocationNfsResponse :: Int -> UpdateLocationNfsResponse
newUpdateLocationNfsResponse Int
pHttpStatus_ =
  UpdateLocationNfsResponse'
    { $sel:httpStatus:UpdateLocationNfsResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateLocationNfsResponse where
  rnf :: UpdateLocationNfsResponse -> ()
rnf UpdateLocationNfsResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateLocationNfsResponse' :: UpdateLocationNfsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus