{-# 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.UpdateLocationSmb
-- 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
-- Server Message Block (SMB) file system access. For information about
-- creating an SMB location, see
-- <https://docs.aws.amazon.com/datasync/latest/userguide/create-smb-location.html Creating a location for SMB>.
module Amazonka.DataSync.UpdateLocationSmb
  ( -- * Creating a Request
    UpdateLocationSmb (..),
    newUpdateLocationSmb,

    -- * Request Lenses
    updateLocationSmb_agentArns,
    updateLocationSmb_domain,
    updateLocationSmb_mountOptions,
    updateLocationSmb_password,
    updateLocationSmb_subdirectory,
    updateLocationSmb_user,
    updateLocationSmb_locationArn,

    -- * Destructuring the Response
    UpdateLocationSmbResponse (..),
    newUpdateLocationSmbResponse,

    -- * Response Lenses
    updateLocationSmbResponse_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:/ 'newUpdateLocationSmb' smart constructor.
data UpdateLocationSmb = UpdateLocationSmb'
  { -- | The Amazon Resource Names (ARNs) of agents to use for a Simple Message
    -- Block (SMB) location.
    UpdateLocationSmb -> Maybe (NonEmpty Text)
agentArns :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The name of the Windows domain that the SMB server belongs to.
    UpdateLocationSmb -> Maybe Text
domain :: Prelude.Maybe Prelude.Text,
    UpdateLocationSmb -> Maybe SmbMountOptions
mountOptions :: Prelude.Maybe SmbMountOptions,
    -- | The password of the user who can mount the share has the permissions to
    -- access files and folders in the SMB share.
    UpdateLocationSmb -> Maybe (Sensitive Text)
password :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The subdirectory in the SMB file system that is used to read data from
    -- the SMB source location or write data to the SMB destination. The SMB
    -- path should be a path that\'s exported by the SMB server, or a
    -- subdirectory of that path. The path should be such that it can be
    -- mounted by other SMB clients in your network.
    --
    -- @Subdirectory@ must be specified with forward slashes. For example,
    -- @\/path\/to\/folder@.
    --
    -- To transfer all the data in the folder that you specified, DataSync must
    -- have permissions to mount the SMB share and to access all the data in
    -- that share. To ensure this, do either of the following:
    --
    -- -   Ensure that the user\/password specified belongs to the user who can
    --     mount the share and who has the appropriate permissions for all of
    --     the files and directories that you want DataSync to access.
    --
    -- -   Use credentials of a member of the Backup Operators group to mount
    --     the share.
    --
    -- Doing either of these options enables the agent to access the data. For
    -- the agent to access directories, you must also enable all execute
    -- access.
    UpdateLocationSmb -> Maybe Text
subdirectory :: Prelude.Maybe Prelude.Text,
    -- | The user who can mount the share has the permissions to access files and
    -- folders in the SMB share.
    UpdateLocationSmb -> Maybe Text
user :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the SMB location to update.
    UpdateLocationSmb -> Text
locationArn :: Prelude.Text
  }
  deriving (UpdateLocationSmb -> UpdateLocationSmb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLocationSmb -> UpdateLocationSmb -> Bool
$c/= :: UpdateLocationSmb -> UpdateLocationSmb -> Bool
== :: UpdateLocationSmb -> UpdateLocationSmb -> Bool
$c== :: UpdateLocationSmb -> UpdateLocationSmb -> Bool
Prelude.Eq, Int -> UpdateLocationSmb -> ShowS
[UpdateLocationSmb] -> ShowS
UpdateLocationSmb -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLocationSmb] -> ShowS
$cshowList :: [UpdateLocationSmb] -> ShowS
show :: UpdateLocationSmb -> String
$cshow :: UpdateLocationSmb -> String
showsPrec :: Int -> UpdateLocationSmb -> ShowS
$cshowsPrec :: Int -> UpdateLocationSmb -> ShowS
Prelude.Show, forall x. Rep UpdateLocationSmb x -> UpdateLocationSmb
forall x. UpdateLocationSmb -> Rep UpdateLocationSmb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLocationSmb x -> UpdateLocationSmb
$cfrom :: forall x. UpdateLocationSmb -> Rep UpdateLocationSmb x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLocationSmb' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'agentArns', 'updateLocationSmb_agentArns' - The Amazon Resource Names (ARNs) of agents to use for a Simple Message
-- Block (SMB) location.
--
-- 'domain', 'updateLocationSmb_domain' - The name of the Windows domain that the SMB server belongs to.
--
-- 'mountOptions', 'updateLocationSmb_mountOptions' - Undocumented member.
--
-- 'password', 'updateLocationSmb_password' - The password of the user who can mount the share has the permissions to
-- access files and folders in the SMB share.
--
-- 'subdirectory', 'updateLocationSmb_subdirectory' - The subdirectory in the SMB file system that is used to read data from
-- the SMB source location or write data to the SMB destination. The SMB
-- path should be a path that\'s exported by the SMB server, or a
-- subdirectory of that path. The path should be such that it can be
-- mounted by other SMB clients in your network.
--
-- @Subdirectory@ must be specified with forward slashes. For example,
-- @\/path\/to\/folder@.
--
-- To transfer all the data in the folder that you specified, DataSync must
-- have permissions to mount the SMB share and to access all the data in
-- that share. To ensure this, do either of the following:
--
-- -   Ensure that the user\/password specified belongs to the user who can
--     mount the share and who has the appropriate permissions for all of
--     the files and directories that you want DataSync to access.
--
-- -   Use credentials of a member of the Backup Operators group to mount
--     the share.
--
-- Doing either of these options enables the agent to access the data. For
-- the agent to access directories, you must also enable all execute
-- access.
--
-- 'user', 'updateLocationSmb_user' - The user who can mount the share has the permissions to access files and
-- folders in the SMB share.
--
-- 'locationArn', 'updateLocationSmb_locationArn' - The Amazon Resource Name (ARN) of the SMB location to update.
newUpdateLocationSmb ::
  -- | 'locationArn'
  Prelude.Text ->
  UpdateLocationSmb
newUpdateLocationSmb :: Text -> UpdateLocationSmb
newUpdateLocationSmb Text
pLocationArn_ =
  UpdateLocationSmb'
    { $sel:agentArns:UpdateLocationSmb' :: Maybe (NonEmpty Text)
agentArns = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:UpdateLocationSmb' :: Maybe Text
domain = forall a. Maybe a
Prelude.Nothing,
      $sel:mountOptions:UpdateLocationSmb' :: Maybe SmbMountOptions
mountOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:password:UpdateLocationSmb' :: Maybe (Sensitive Text)
password = forall a. Maybe a
Prelude.Nothing,
      $sel:subdirectory:UpdateLocationSmb' :: Maybe Text
subdirectory = forall a. Maybe a
Prelude.Nothing,
      $sel:user:UpdateLocationSmb' :: Maybe Text
user = forall a. Maybe a
Prelude.Nothing,
      $sel:locationArn:UpdateLocationSmb' :: Text
locationArn = Text
pLocationArn_
    }

-- | The Amazon Resource Names (ARNs) of agents to use for a Simple Message
-- Block (SMB) location.
updateLocationSmb_agentArns :: Lens.Lens' UpdateLocationSmb (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
updateLocationSmb_agentArns :: Lens' UpdateLocationSmb (Maybe (NonEmpty Text))
updateLocationSmb_agentArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationSmb' {Maybe (NonEmpty Text)
agentArns :: Maybe (NonEmpty Text)
$sel:agentArns:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (NonEmpty Text)
agentArns} -> Maybe (NonEmpty Text)
agentArns) (\s :: UpdateLocationSmb
s@UpdateLocationSmb' {} Maybe (NonEmpty Text)
a -> UpdateLocationSmb
s {$sel:agentArns:UpdateLocationSmb' :: Maybe (NonEmpty Text)
agentArns = Maybe (NonEmpty Text)
a} :: UpdateLocationSmb) 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 name of the Windows domain that the SMB server belongs to.
updateLocationSmb_domain :: Lens.Lens' UpdateLocationSmb (Prelude.Maybe Prelude.Text)
updateLocationSmb_domain :: Lens' UpdateLocationSmb (Maybe Text)
updateLocationSmb_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationSmb' {Maybe Text
domain :: Maybe Text
$sel:domain:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
domain} -> Maybe Text
domain) (\s :: UpdateLocationSmb
s@UpdateLocationSmb' {} Maybe Text
a -> UpdateLocationSmb
s {$sel:domain:UpdateLocationSmb' :: Maybe Text
domain = Maybe Text
a} :: UpdateLocationSmb)

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

-- | The password of the user who can mount the share has the permissions to
-- access files and folders in the SMB share.
updateLocationSmb_password :: Lens.Lens' UpdateLocationSmb (Prelude.Maybe Prelude.Text)
updateLocationSmb_password :: Lens' UpdateLocationSmb (Maybe Text)
updateLocationSmb_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationSmb' {Maybe (Sensitive Text)
password :: Maybe (Sensitive Text)
$sel:password:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (Sensitive Text)
password} -> Maybe (Sensitive Text)
password) (\s :: UpdateLocationSmb
s@UpdateLocationSmb' {} Maybe (Sensitive Text)
a -> UpdateLocationSmb
s {$sel:password:UpdateLocationSmb' :: Maybe (Sensitive Text)
password = Maybe (Sensitive Text)
a} :: UpdateLocationSmb) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The subdirectory in the SMB file system that is used to read data from
-- the SMB source location or write data to the SMB destination. The SMB
-- path should be a path that\'s exported by the SMB server, or a
-- subdirectory of that path. The path should be such that it can be
-- mounted by other SMB clients in your network.
--
-- @Subdirectory@ must be specified with forward slashes. For example,
-- @\/path\/to\/folder@.
--
-- To transfer all the data in the folder that you specified, DataSync must
-- have permissions to mount the SMB share and to access all the data in
-- that share. To ensure this, do either of the following:
--
-- -   Ensure that the user\/password specified belongs to the user who can
--     mount the share and who has the appropriate permissions for all of
--     the files and directories that you want DataSync to access.
--
-- -   Use credentials of a member of the Backup Operators group to mount
--     the share.
--
-- Doing either of these options enables the agent to access the data. For
-- the agent to access directories, you must also enable all execute
-- access.
updateLocationSmb_subdirectory :: Lens.Lens' UpdateLocationSmb (Prelude.Maybe Prelude.Text)
updateLocationSmb_subdirectory :: Lens' UpdateLocationSmb (Maybe Text)
updateLocationSmb_subdirectory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationSmb' {Maybe Text
subdirectory :: Maybe Text
$sel:subdirectory:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
subdirectory} -> Maybe Text
subdirectory) (\s :: UpdateLocationSmb
s@UpdateLocationSmb' {} Maybe Text
a -> UpdateLocationSmb
s {$sel:subdirectory:UpdateLocationSmb' :: Maybe Text
subdirectory = Maybe Text
a} :: UpdateLocationSmb)

-- | The user who can mount the share has the permissions to access files and
-- folders in the SMB share.
updateLocationSmb_user :: Lens.Lens' UpdateLocationSmb (Prelude.Maybe Prelude.Text)
updateLocationSmb_user :: Lens' UpdateLocationSmb (Maybe Text)
updateLocationSmb_user = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLocationSmb' {Maybe Text
user :: Maybe Text
$sel:user:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
user} -> Maybe Text
user) (\s :: UpdateLocationSmb
s@UpdateLocationSmb' {} Maybe Text
a -> UpdateLocationSmb
s {$sel:user:UpdateLocationSmb' :: Maybe Text
user = Maybe Text
a} :: UpdateLocationSmb)

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

instance Core.AWSRequest UpdateLocationSmb where
  type
    AWSResponse UpdateLocationSmb =
      UpdateLocationSmbResponse
  request :: (Service -> Service)
-> UpdateLocationSmb -> Request UpdateLocationSmb
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 UpdateLocationSmb
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateLocationSmb)))
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 -> UpdateLocationSmbResponse
UpdateLocationSmbResponse'
            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 UpdateLocationSmb where
  hashWithSalt :: Int -> UpdateLocationSmb -> Int
hashWithSalt Int
_salt UpdateLocationSmb' {Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe SmbMountOptions
Text
locationArn :: Text
user :: Maybe Text
subdirectory :: Maybe Text
password :: Maybe (Sensitive Text)
mountOptions :: Maybe SmbMountOptions
domain :: Maybe Text
agentArns :: Maybe (NonEmpty Text)
$sel:locationArn:UpdateLocationSmb' :: UpdateLocationSmb -> Text
$sel:user:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:subdirectory:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:password:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (Sensitive Text)
$sel:mountOptions:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe SmbMountOptions
$sel:domain:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:agentArns:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
agentArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SmbMountOptions
mountOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
password
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subdirectory
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
user
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
locationArn

instance Prelude.NFData UpdateLocationSmb where
  rnf :: UpdateLocationSmb -> ()
rnf UpdateLocationSmb' {Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe SmbMountOptions
Text
locationArn :: Text
user :: Maybe Text
subdirectory :: Maybe Text
password :: Maybe (Sensitive Text)
mountOptions :: Maybe SmbMountOptions
domain :: Maybe Text
agentArns :: Maybe (NonEmpty Text)
$sel:locationArn:UpdateLocationSmb' :: UpdateLocationSmb -> Text
$sel:user:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:subdirectory:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:password:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (Sensitive Text)
$sel:mountOptions:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe SmbMountOptions
$sel:domain:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:agentArns:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
agentArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SmbMountOptions
mountOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
password
      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 Text
user
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
locationArn

instance Data.ToHeaders UpdateLocationSmb where
  toHeaders :: UpdateLocationSmb -> 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.UpdateLocationSmb" ::
                          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 UpdateLocationSmb where
  toJSON :: UpdateLocationSmb -> Value
toJSON UpdateLocationSmb' {Maybe (NonEmpty Text)
Maybe Text
Maybe (Sensitive Text)
Maybe SmbMountOptions
Text
locationArn :: Text
user :: Maybe Text
subdirectory :: Maybe Text
password :: Maybe (Sensitive Text)
mountOptions :: Maybe SmbMountOptions
domain :: Maybe Text
agentArns :: Maybe (NonEmpty Text)
$sel:locationArn:UpdateLocationSmb' :: UpdateLocationSmb -> Text
$sel:user:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:subdirectory:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:password:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (Sensitive Text)
$sel:mountOptions:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe SmbMountOptions
$sel:domain:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe Text
$sel:agentArns:UpdateLocationSmb' :: UpdateLocationSmb -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AgentArns" 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 (NonEmpty Text)
agentArns,
            (Key
"Domain" 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
domain,
            (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 SmbMountOptions
mountOptions,
            (Key
"Password" 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 (Sensitive Text)
password,
            (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
"User" 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
user,
            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 UpdateLocationSmb where
  toPath :: UpdateLocationSmb -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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