{-# 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.FinSpaceData.ResetUserPassword
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resets the password for a specified user ID and generates a temporary
-- one. Only a superuser can reset password for other users. Resetting the
-- password immediately invalidates the previous password associated with
-- the user.
module Amazonka.FinSpaceData.ResetUserPassword
  ( -- * Creating a Request
    ResetUserPassword (..),
    newResetUserPassword,

    -- * Request Lenses
    resetUserPassword_clientToken,
    resetUserPassword_userId,

    -- * Destructuring the Response
    ResetUserPasswordResponse (..),
    newResetUserPasswordResponse,

    -- * Response Lenses
    resetUserPasswordResponse_temporaryPassword,
    resetUserPasswordResponse_userId,
    resetUserPasswordResponse_httpStatus,
  )
where

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

-- | /See:/ 'newResetUserPassword' smart constructor.
data ResetUserPassword = ResetUserPassword'
  { -- | A token that ensures idempotency. This token expires in 10 minutes.
    ResetUserPassword -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the user that a temporary password is requested
    -- for.
    ResetUserPassword -> Text
userId :: Prelude.Text
  }
  deriving (ResetUserPassword -> ResetUserPassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetUserPassword -> ResetUserPassword -> Bool
$c/= :: ResetUserPassword -> ResetUserPassword -> Bool
== :: ResetUserPassword -> ResetUserPassword -> Bool
$c== :: ResetUserPassword -> ResetUserPassword -> Bool
Prelude.Eq, ReadPrec [ResetUserPassword]
ReadPrec ResetUserPassword
Int -> ReadS ResetUserPassword
ReadS [ResetUserPassword]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetUserPassword]
$creadListPrec :: ReadPrec [ResetUserPassword]
readPrec :: ReadPrec ResetUserPassword
$creadPrec :: ReadPrec ResetUserPassword
readList :: ReadS [ResetUserPassword]
$creadList :: ReadS [ResetUserPassword]
readsPrec :: Int -> ReadS ResetUserPassword
$creadsPrec :: Int -> ReadS ResetUserPassword
Prelude.Read, Int -> ResetUserPassword -> ShowS
[ResetUserPassword] -> ShowS
ResetUserPassword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetUserPassword] -> ShowS
$cshowList :: [ResetUserPassword] -> ShowS
show :: ResetUserPassword -> String
$cshow :: ResetUserPassword -> String
showsPrec :: Int -> ResetUserPassword -> ShowS
$cshowsPrec :: Int -> ResetUserPassword -> ShowS
Prelude.Show, forall x. Rep ResetUserPassword x -> ResetUserPassword
forall x. ResetUserPassword -> Rep ResetUserPassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetUserPassword x -> ResetUserPassword
$cfrom :: forall x. ResetUserPassword -> Rep ResetUserPassword x
Prelude.Generic)

-- |
-- Create a value of 'ResetUserPassword' 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:
--
-- 'clientToken', 'resetUserPassword_clientToken' - A token that ensures idempotency. This token expires in 10 minutes.
--
-- 'userId', 'resetUserPassword_userId' - The unique identifier of the user that a temporary password is requested
-- for.
newResetUserPassword ::
  -- | 'userId'
  Prelude.Text ->
  ResetUserPassword
newResetUserPassword :: Text -> ResetUserPassword
newResetUserPassword Text
pUserId_ =
  ResetUserPassword'
    { $sel:clientToken:ResetUserPassword' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:userId:ResetUserPassword' :: Text
userId = Text
pUserId_
    }

-- | A token that ensures idempotency. This token expires in 10 minutes.
resetUserPassword_clientToken :: Lens.Lens' ResetUserPassword (Prelude.Maybe Prelude.Text)
resetUserPassword_clientToken :: Lens' ResetUserPassword (Maybe Text)
resetUserPassword_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetUserPassword' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:ResetUserPassword' :: ResetUserPassword -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: ResetUserPassword
s@ResetUserPassword' {} Maybe Text
a -> ResetUserPassword
s {$sel:clientToken:ResetUserPassword' :: Maybe Text
clientToken = Maybe Text
a} :: ResetUserPassword)

-- | The unique identifier of the user that a temporary password is requested
-- for.
resetUserPassword_userId :: Lens.Lens' ResetUserPassword Prelude.Text
resetUserPassword_userId :: Lens' ResetUserPassword Text
resetUserPassword_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetUserPassword' {Text
userId :: Text
$sel:userId:ResetUserPassword' :: ResetUserPassword -> Text
userId} -> Text
userId) (\s :: ResetUserPassword
s@ResetUserPassword' {} Text
a -> ResetUserPassword
s {$sel:userId:ResetUserPassword' :: Text
userId = Text
a} :: ResetUserPassword)

instance Core.AWSRequest ResetUserPassword where
  type
    AWSResponse ResetUserPassword =
      ResetUserPasswordResponse
  request :: (Service -> Service)
-> ResetUserPassword -> Request ResetUserPassword
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 ResetUserPassword
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResetUserPassword)))
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 (Sensitive Text)
-> Maybe Text -> Int -> ResetUserPasswordResponse
ResetUserPasswordResponse'
            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
"temporaryPassword")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"userId")
            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 ResetUserPassword where
  hashWithSalt :: Int -> ResetUserPassword -> Int
hashWithSalt Int
_salt ResetUserPassword' {Maybe Text
Text
userId :: Text
clientToken :: Maybe Text
$sel:userId:ResetUserPassword' :: ResetUserPassword -> Text
$sel:clientToken:ResetUserPassword' :: ResetUserPassword -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId

instance Prelude.NFData ResetUserPassword where
  rnf :: ResetUserPassword -> ()
rnf ResetUserPassword' {Maybe Text
Text
userId :: Text
clientToken :: Maybe Text
$sel:userId:ResetUserPassword' :: ResetUserPassword -> Text
$sel:clientToken:ResetUserPassword' :: ResetUserPassword -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId

instance Data.ToHeaders ResetUserPassword where
  toHeaders :: ResetUserPassword -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ResetUserPassword where
  toJSON :: ResetUserPassword -> Value
toJSON ResetUserPassword' {Maybe Text
Text
userId :: Text
clientToken :: Maybe Text
$sel:userId:ResetUserPassword' :: ResetUserPassword -> Text
$sel:clientToken:ResetUserPassword' :: ResetUserPassword -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"clientToken" 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
clientToken]
      )

instance Data.ToPath ResetUserPassword where
  toPath :: ResetUserPassword -> ByteString
toPath ResetUserPassword' {Maybe Text
Text
userId :: Text
clientToken :: Maybe Text
$sel:userId:ResetUserPassword' :: ResetUserPassword -> Text
$sel:clientToken:ResetUserPassword' :: ResetUserPassword -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/user/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId, ByteString
"/password"]

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

-- | /See:/ 'newResetUserPasswordResponse' smart constructor.
data ResetUserPasswordResponse = ResetUserPasswordResponse'
  { -- | A randomly generated temporary password for the requested user account.
    -- This password expires in 7 days.
    ResetUserPasswordResponse -> Maybe (Sensitive Text)
temporaryPassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The unique identifier of the user that a new password is generated for.
    ResetUserPasswordResponse -> Maybe Text
userId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ResetUserPasswordResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ResetUserPasswordResponse -> ResetUserPasswordResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetUserPasswordResponse -> ResetUserPasswordResponse -> Bool
$c/= :: ResetUserPasswordResponse -> ResetUserPasswordResponse -> Bool
== :: ResetUserPasswordResponse -> ResetUserPasswordResponse -> Bool
$c== :: ResetUserPasswordResponse -> ResetUserPasswordResponse -> Bool
Prelude.Eq, Int -> ResetUserPasswordResponse -> ShowS
[ResetUserPasswordResponse] -> ShowS
ResetUserPasswordResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetUserPasswordResponse] -> ShowS
$cshowList :: [ResetUserPasswordResponse] -> ShowS
show :: ResetUserPasswordResponse -> String
$cshow :: ResetUserPasswordResponse -> String
showsPrec :: Int -> ResetUserPasswordResponse -> ShowS
$cshowsPrec :: Int -> ResetUserPasswordResponse -> ShowS
Prelude.Show, forall x.
Rep ResetUserPasswordResponse x -> ResetUserPasswordResponse
forall x.
ResetUserPasswordResponse -> Rep ResetUserPasswordResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResetUserPasswordResponse x -> ResetUserPasswordResponse
$cfrom :: forall x.
ResetUserPasswordResponse -> Rep ResetUserPasswordResponse x
Prelude.Generic)

-- |
-- Create a value of 'ResetUserPasswordResponse' 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:
--
-- 'temporaryPassword', 'resetUserPasswordResponse_temporaryPassword' - A randomly generated temporary password for the requested user account.
-- This password expires in 7 days.
--
-- 'userId', 'resetUserPasswordResponse_userId' - The unique identifier of the user that a new password is generated for.
--
-- 'httpStatus', 'resetUserPasswordResponse_httpStatus' - The response's http status code.
newResetUserPasswordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ResetUserPasswordResponse
newResetUserPasswordResponse :: Int -> ResetUserPasswordResponse
newResetUserPasswordResponse Int
pHttpStatus_ =
  ResetUserPasswordResponse'
    { $sel:temporaryPassword:ResetUserPasswordResponse' :: Maybe (Sensitive Text)
temporaryPassword =
        forall a. Maybe a
Prelude.Nothing,
      $sel:userId:ResetUserPasswordResponse' :: Maybe Text
userId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ResetUserPasswordResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A randomly generated temporary password for the requested user account.
-- This password expires in 7 days.
resetUserPasswordResponse_temporaryPassword :: Lens.Lens' ResetUserPasswordResponse (Prelude.Maybe Prelude.Text)
resetUserPasswordResponse_temporaryPassword :: Lens' ResetUserPasswordResponse (Maybe Text)
resetUserPasswordResponse_temporaryPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetUserPasswordResponse' {Maybe (Sensitive Text)
temporaryPassword :: Maybe (Sensitive Text)
$sel:temporaryPassword:ResetUserPasswordResponse' :: ResetUserPasswordResponse -> Maybe (Sensitive Text)
temporaryPassword} -> Maybe (Sensitive Text)
temporaryPassword) (\s :: ResetUserPasswordResponse
s@ResetUserPasswordResponse' {} Maybe (Sensitive Text)
a -> ResetUserPasswordResponse
s {$sel:temporaryPassword:ResetUserPasswordResponse' :: Maybe (Sensitive Text)
temporaryPassword = Maybe (Sensitive Text)
a} :: ResetUserPasswordResponse) 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 unique identifier of the user that a new password is generated for.
resetUserPasswordResponse_userId :: Lens.Lens' ResetUserPasswordResponse (Prelude.Maybe Prelude.Text)
resetUserPasswordResponse_userId :: Lens' ResetUserPasswordResponse (Maybe Text)
resetUserPasswordResponse_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetUserPasswordResponse' {Maybe Text
userId :: Maybe Text
$sel:userId:ResetUserPasswordResponse' :: ResetUserPasswordResponse -> Maybe Text
userId} -> Maybe Text
userId) (\s :: ResetUserPasswordResponse
s@ResetUserPasswordResponse' {} Maybe Text
a -> ResetUserPasswordResponse
s {$sel:userId:ResetUserPasswordResponse' :: Maybe Text
userId = Maybe Text
a} :: ResetUserPasswordResponse)

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

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