{-# 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.StorageGateway.SetSMBGuestPassword
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the password for the guest user @smbguest@. The @smbguest@ user is
-- the user when the authentication method for the file share is set to
-- @GuestAccess@. This operation only supported for S3 File Gateways
module Amazonka.StorageGateway.SetSMBGuestPassword
  ( -- * Creating a Request
    SetSMBGuestPassword (..),
    newSetSMBGuestPassword,

    -- * Request Lenses
    setSMBGuestPassword_gatewayARN,
    setSMBGuestPassword_password,

    -- * Destructuring the Response
    SetSMBGuestPasswordResponse (..),
    newSetSMBGuestPasswordResponse,

    -- * Response Lenses
    setSMBGuestPasswordResponse_gatewayARN,
    setSMBGuestPasswordResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.StorageGateway.Types

-- | SetSMBGuestPasswordInput
--
-- /See:/ 'newSetSMBGuestPassword' smart constructor.
data SetSMBGuestPassword = SetSMBGuestPassword'
  { -- | The Amazon Resource Name (ARN) of the S3 File Gateway the SMB file share
    -- is associated with.
    SetSMBGuestPassword -> Text
gatewayARN :: Prelude.Text,
    -- | The password that you want to set for your SMB server.
    SetSMBGuestPassword -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  deriving (SetSMBGuestPassword -> SetSMBGuestPassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetSMBGuestPassword -> SetSMBGuestPassword -> Bool
$c/= :: SetSMBGuestPassword -> SetSMBGuestPassword -> Bool
== :: SetSMBGuestPassword -> SetSMBGuestPassword -> Bool
$c== :: SetSMBGuestPassword -> SetSMBGuestPassword -> Bool
Prelude.Eq, Int -> SetSMBGuestPassword -> ShowS
[SetSMBGuestPassword] -> ShowS
SetSMBGuestPassword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetSMBGuestPassword] -> ShowS
$cshowList :: [SetSMBGuestPassword] -> ShowS
show :: SetSMBGuestPassword -> String
$cshow :: SetSMBGuestPassword -> String
showsPrec :: Int -> SetSMBGuestPassword -> ShowS
$cshowsPrec :: Int -> SetSMBGuestPassword -> ShowS
Prelude.Show, forall x. Rep SetSMBGuestPassword x -> SetSMBGuestPassword
forall x. SetSMBGuestPassword -> Rep SetSMBGuestPassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetSMBGuestPassword x -> SetSMBGuestPassword
$cfrom :: forall x. SetSMBGuestPassword -> Rep SetSMBGuestPassword x
Prelude.Generic)

-- |
-- Create a value of 'SetSMBGuestPassword' 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:
--
-- 'gatewayARN', 'setSMBGuestPassword_gatewayARN' - The Amazon Resource Name (ARN) of the S3 File Gateway the SMB file share
-- is associated with.
--
-- 'password', 'setSMBGuestPassword_password' - The password that you want to set for your SMB server.
newSetSMBGuestPassword ::
  -- | 'gatewayARN'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  SetSMBGuestPassword
newSetSMBGuestPassword :: Text -> Text -> SetSMBGuestPassword
newSetSMBGuestPassword Text
pGatewayARN_ Text
pPassword_ =
  SetSMBGuestPassword'
    { $sel:gatewayARN:SetSMBGuestPassword' :: Text
gatewayARN = Text
pGatewayARN_,
      $sel:password:SetSMBGuestPassword' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
    }

-- | The Amazon Resource Name (ARN) of the S3 File Gateway the SMB file share
-- is associated with.
setSMBGuestPassword_gatewayARN :: Lens.Lens' SetSMBGuestPassword Prelude.Text
setSMBGuestPassword_gatewayARN :: Lens' SetSMBGuestPassword Text
setSMBGuestPassword_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetSMBGuestPassword' {Text
gatewayARN :: Text
$sel:gatewayARN:SetSMBGuestPassword' :: SetSMBGuestPassword -> Text
gatewayARN} -> Text
gatewayARN) (\s :: SetSMBGuestPassword
s@SetSMBGuestPassword' {} Text
a -> SetSMBGuestPassword
s {$sel:gatewayARN:SetSMBGuestPassword' :: Text
gatewayARN = Text
a} :: SetSMBGuestPassword)

-- | The password that you want to set for your SMB server.
setSMBGuestPassword_password :: Lens.Lens' SetSMBGuestPassword Prelude.Text
setSMBGuestPassword_password :: Lens' SetSMBGuestPassword Text
setSMBGuestPassword_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetSMBGuestPassword' {Sensitive Text
password :: Sensitive Text
$sel:password:SetSMBGuestPassword' :: SetSMBGuestPassword -> Sensitive Text
password} -> Sensitive Text
password) (\s :: SetSMBGuestPassword
s@SetSMBGuestPassword' {} Sensitive Text
a -> SetSMBGuestPassword
s {$sel:password:SetSMBGuestPassword' :: Sensitive Text
password = Sensitive Text
a} :: SetSMBGuestPassword) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest SetSMBGuestPassword where
  type
    AWSResponse SetSMBGuestPassword =
      SetSMBGuestPasswordResponse
  request :: (Service -> Service)
-> SetSMBGuestPassword -> Request SetSMBGuestPassword
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 SetSMBGuestPassword
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetSMBGuestPassword)))
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 -> SetSMBGuestPasswordResponse
SetSMBGuestPasswordResponse'
            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
"GatewayARN")
            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 SetSMBGuestPassword where
  hashWithSalt :: Int -> SetSMBGuestPassword -> Int
hashWithSalt Int
_salt SetSMBGuestPassword' {Text
Sensitive Text
password :: Sensitive Text
gatewayARN :: Text
$sel:password:SetSMBGuestPassword' :: SetSMBGuestPassword -> Sensitive Text
$sel:gatewayARN:SetSMBGuestPassword' :: SetSMBGuestPassword -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password

instance Prelude.NFData SetSMBGuestPassword where
  rnf :: SetSMBGuestPassword -> ()
rnf SetSMBGuestPassword' {Text
Sensitive Text
password :: Sensitive Text
gatewayARN :: Text
$sel:password:SetSMBGuestPassword' :: SetSMBGuestPassword -> Sensitive Text
$sel:gatewayARN:SetSMBGuestPassword' :: SetSMBGuestPassword -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password

instance Data.ToHeaders SetSMBGuestPassword where
  toHeaders :: SetSMBGuestPassword -> 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
"StorageGateway_20130630.SetSMBGuestPassword" ::
                          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 SetSMBGuestPassword where
  toJSON :: SetSMBGuestPassword -> Value
toJSON SetSMBGuestPassword' {Text
Sensitive Text
password :: Sensitive Text
gatewayARN :: Text
$sel:password:SetSMBGuestPassword' :: SetSMBGuestPassword -> Sensitive Text
$sel:gatewayARN:SetSMBGuestPassword' :: SetSMBGuestPassword -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"GatewayARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayARN),
            forall a. a -> Maybe a
Prelude.Just (Key
"Password" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
password)
          ]
      )

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

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

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

-- |
-- Create a value of 'SetSMBGuestPasswordResponse' 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:
--
-- 'gatewayARN', 'setSMBGuestPasswordResponse_gatewayARN' - Undocumented member.
--
-- 'httpStatus', 'setSMBGuestPasswordResponse_httpStatus' - The response's http status code.
newSetSMBGuestPasswordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SetSMBGuestPasswordResponse
newSetSMBGuestPasswordResponse :: Int -> SetSMBGuestPasswordResponse
newSetSMBGuestPasswordResponse Int
pHttpStatus_ =
  SetSMBGuestPasswordResponse'
    { $sel:gatewayARN:SetSMBGuestPasswordResponse' :: Maybe Text
gatewayARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SetSMBGuestPasswordResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
setSMBGuestPasswordResponse_gatewayARN :: Lens.Lens' SetSMBGuestPasswordResponse (Prelude.Maybe Prelude.Text)
setSMBGuestPasswordResponse_gatewayARN :: Lens' SetSMBGuestPasswordResponse (Maybe Text)
setSMBGuestPasswordResponse_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetSMBGuestPasswordResponse' {Maybe Text
gatewayARN :: Maybe Text
$sel:gatewayARN:SetSMBGuestPasswordResponse' :: SetSMBGuestPasswordResponse -> Maybe Text
gatewayARN} -> Maybe Text
gatewayARN) (\s :: SetSMBGuestPasswordResponse
s@SetSMBGuestPasswordResponse' {} Maybe Text
a -> SetSMBGuestPasswordResponse
s {$sel:gatewayARN:SetSMBGuestPasswordResponse' :: Maybe Text
gatewayARN = Maybe Text
a} :: SetSMBGuestPasswordResponse)

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

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