{-# 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.CognitoIdentityProvider.AdminSetUserPassword
-- 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 specified user\'s password in a user pool as an administrator.
-- Works on any user.
--
-- The password can be temporary or permanent. If it is temporary, the user
-- status enters the @FORCE_CHANGE_PASSWORD@ state. When the user next
-- tries to sign in, the InitiateAuth\/AdminInitiateAuth response will
-- contain the @NEW_PASSWORD_REQUIRED@ challenge. If the user doesn\'t sign
-- in before it expires, the user won\'t be able to sign in, and an
-- administrator must reset their password.
--
-- Once the user has set a new password, or the password is permanent, the
-- user status is set to @Confirmed@.
module Amazonka.CognitoIdentityProvider.AdminSetUserPassword
  ( -- * Creating a Request
    AdminSetUserPassword (..),
    newAdminSetUserPassword,

    -- * Request Lenses
    adminSetUserPassword_permanent,
    adminSetUserPassword_userPoolId,
    adminSetUserPassword_username,
    adminSetUserPassword_password,

    -- * Destructuring the Response
    AdminSetUserPasswordResponse (..),
    newAdminSetUserPasswordResponse,

    -- * Response Lenses
    adminSetUserPasswordResponse_httpStatus,
  )
where

import Amazonka.CognitoIdentityProvider.Types
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

-- | /See:/ 'newAdminSetUserPassword' smart constructor.
data AdminSetUserPassword = AdminSetUserPassword'
  { -- | @True@ if the password is permanent, @False@ if it is temporary.
    AdminSetUserPassword -> Maybe Bool
permanent :: Prelude.Maybe Prelude.Bool,
    -- | The user pool ID for the user pool where you want to set the user\'s
    -- password.
    AdminSetUserPassword -> Text
userPoolId :: Prelude.Text,
    -- | The user name of the user whose password you want to set.
    AdminSetUserPassword -> Sensitive Text
username :: Data.Sensitive Prelude.Text,
    -- | The password for the user.
    AdminSetUserPassword -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  deriving (AdminSetUserPassword -> AdminSetUserPassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdminSetUserPassword -> AdminSetUserPassword -> Bool
$c/= :: AdminSetUserPassword -> AdminSetUserPassword -> Bool
== :: AdminSetUserPassword -> AdminSetUserPassword -> Bool
$c== :: AdminSetUserPassword -> AdminSetUserPassword -> Bool
Prelude.Eq, Int -> AdminSetUserPassword -> ShowS
[AdminSetUserPassword] -> ShowS
AdminSetUserPassword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdminSetUserPassword] -> ShowS
$cshowList :: [AdminSetUserPassword] -> ShowS
show :: AdminSetUserPassword -> String
$cshow :: AdminSetUserPassword -> String
showsPrec :: Int -> AdminSetUserPassword -> ShowS
$cshowsPrec :: Int -> AdminSetUserPassword -> ShowS
Prelude.Show, forall x. Rep AdminSetUserPassword x -> AdminSetUserPassword
forall x. AdminSetUserPassword -> Rep AdminSetUserPassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AdminSetUserPassword x -> AdminSetUserPassword
$cfrom :: forall x. AdminSetUserPassword -> Rep AdminSetUserPassword x
Prelude.Generic)

-- |
-- Create a value of 'AdminSetUserPassword' 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:
--
-- 'permanent', 'adminSetUserPassword_permanent' - @True@ if the password is permanent, @False@ if it is temporary.
--
-- 'userPoolId', 'adminSetUserPassword_userPoolId' - The user pool ID for the user pool where you want to set the user\'s
-- password.
--
-- 'username', 'adminSetUserPassword_username' - The user name of the user whose password you want to set.
--
-- 'password', 'adminSetUserPassword_password' - The password for the user.
newAdminSetUserPassword ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'username'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  AdminSetUserPassword
newAdminSetUserPassword :: Text -> Text -> Text -> AdminSetUserPassword
newAdminSetUserPassword
  Text
pUserPoolId_
  Text
pUsername_
  Text
pPassword_ =
    AdminSetUserPassword'
      { $sel:permanent:AdminSetUserPassword' :: Maybe Bool
permanent = forall a. Maybe a
Prelude.Nothing,
        $sel:userPoolId:AdminSetUserPassword' :: Text
userPoolId = Text
pUserPoolId_,
        $sel:username:AdminSetUserPassword' :: Sensitive Text
username = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pUsername_,
        $sel:password:AdminSetUserPassword' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
      }

-- | @True@ if the password is permanent, @False@ if it is temporary.
adminSetUserPassword_permanent :: Lens.Lens' AdminSetUserPassword (Prelude.Maybe Prelude.Bool)
adminSetUserPassword_permanent :: Lens' AdminSetUserPassword (Maybe Bool)
adminSetUserPassword_permanent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminSetUserPassword' {Maybe Bool
permanent :: Maybe Bool
$sel:permanent:AdminSetUserPassword' :: AdminSetUserPassword -> Maybe Bool
permanent} -> Maybe Bool
permanent) (\s :: AdminSetUserPassword
s@AdminSetUserPassword' {} Maybe Bool
a -> AdminSetUserPassword
s {$sel:permanent:AdminSetUserPassword' :: Maybe Bool
permanent = Maybe Bool
a} :: AdminSetUserPassword)

-- | The user pool ID for the user pool where you want to set the user\'s
-- password.
adminSetUserPassword_userPoolId :: Lens.Lens' AdminSetUserPassword Prelude.Text
adminSetUserPassword_userPoolId :: Lens' AdminSetUserPassword Text
adminSetUserPassword_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminSetUserPassword' {Text
userPoolId :: Text
$sel:userPoolId:AdminSetUserPassword' :: AdminSetUserPassword -> Text
userPoolId} -> Text
userPoolId) (\s :: AdminSetUserPassword
s@AdminSetUserPassword' {} Text
a -> AdminSetUserPassword
s {$sel:userPoolId:AdminSetUserPassword' :: Text
userPoolId = Text
a} :: AdminSetUserPassword)

-- | The user name of the user whose password you want to set.
adminSetUserPassword_username :: Lens.Lens' AdminSetUserPassword Prelude.Text
adminSetUserPassword_username :: Lens' AdminSetUserPassword Text
adminSetUserPassword_username = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminSetUserPassword' {Sensitive Text
username :: Sensitive Text
$sel:username:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
username} -> Sensitive Text
username) (\s :: AdminSetUserPassword
s@AdminSetUserPassword' {} Sensitive Text
a -> AdminSetUserPassword
s {$sel:username:AdminSetUserPassword' :: Sensitive Text
username = Sensitive Text
a} :: AdminSetUserPassword) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The password for the user.
adminSetUserPassword_password :: Lens.Lens' AdminSetUserPassword Prelude.Text
adminSetUserPassword_password :: Lens' AdminSetUserPassword Text
adminSetUserPassword_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminSetUserPassword' {Sensitive Text
password :: Sensitive Text
$sel:password:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
password} -> Sensitive Text
password) (\s :: AdminSetUserPassword
s@AdminSetUserPassword' {} Sensitive Text
a -> AdminSetUserPassword
s {$sel:password:AdminSetUserPassword' :: Sensitive Text
password = Sensitive Text
a} :: AdminSetUserPassword) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest AdminSetUserPassword where
  type
    AWSResponse AdminSetUserPassword =
      AdminSetUserPasswordResponse
  request :: (Service -> Service)
-> AdminSetUserPassword -> Request AdminSetUserPassword
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 AdminSetUserPassword
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AdminSetUserPassword)))
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 -> AdminSetUserPasswordResponse
AdminSetUserPasswordResponse'
            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 AdminSetUserPassword where
  hashWithSalt :: Int -> AdminSetUserPassword -> Int
hashWithSalt Int
_salt AdminSetUserPassword' {Maybe Bool
Text
Sensitive Text
password :: Sensitive Text
username :: Sensitive Text
userPoolId :: Text
permanent :: Maybe Bool
$sel:password:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
$sel:username:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
$sel:userPoolId:AdminSetUserPassword' :: AdminSetUserPassword -> Text
$sel:permanent:AdminSetUserPassword' :: AdminSetUserPassword -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
permanent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
username
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password

instance Prelude.NFData AdminSetUserPassword where
  rnf :: AdminSetUserPassword -> ()
rnf AdminSetUserPassword' {Maybe Bool
Text
Sensitive Text
password :: Sensitive Text
username :: Sensitive Text
userPoolId :: Text
permanent :: Maybe Bool
$sel:password:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
$sel:username:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
$sel:userPoolId:AdminSetUserPassword' :: AdminSetUserPassword -> Text
$sel:permanent:AdminSetUserPassword' :: AdminSetUserPassword -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
permanent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
username
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
password

instance Data.ToHeaders AdminSetUserPassword where
  toHeaders :: AdminSetUserPassword -> 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
"AWSCognitoIdentityProviderService.AdminSetUserPassword" ::
                          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 AdminSetUserPassword where
  toJSON :: AdminSetUserPassword -> Value
toJSON AdminSetUserPassword' {Maybe Bool
Text
Sensitive Text
password :: Sensitive Text
username :: Sensitive Text
userPoolId :: Text
permanent :: Maybe Bool
$sel:password:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
$sel:username:AdminSetUserPassword' :: AdminSetUserPassword -> Sensitive Text
$sel:userPoolId:AdminSetUserPassword' :: AdminSetUserPassword -> Text
$sel:permanent:AdminSetUserPassword' :: AdminSetUserPassword -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Permanent" 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 Bool
permanent,
            forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Username" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
username),
            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 AdminSetUserPassword where
  toPath :: AdminSetUserPassword -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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