{-# 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.WorkMail.ResetPassword
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allows the administrator to reset the password for a user.
module Amazonka.WorkMail.ResetPassword
  ( -- * Creating a Request
    ResetPassword (..),
    newResetPassword,

    -- * Request Lenses
    resetPassword_organizationId,
    resetPassword_userId,
    resetPassword_password,

    -- * Destructuring the Response
    ResetPasswordResponse (..),
    newResetPasswordResponse,

    -- * Response Lenses
    resetPasswordResponse_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.WorkMail.Types

-- | /See:/ 'newResetPassword' smart constructor.
data ResetPassword = ResetPassword'
  { -- | The identifier of the organization that contains the user for which the
    -- password is reset.
    ResetPassword -> Text
organizationId :: Prelude.Text,
    -- | The identifier of the user for whom the password is reset.
    ResetPassword -> Text
userId :: Prelude.Text,
    -- | The new password for the user.
    ResetPassword -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  deriving (ResetPassword -> ResetPassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetPassword -> ResetPassword -> Bool
$c/= :: ResetPassword -> ResetPassword -> Bool
== :: ResetPassword -> ResetPassword -> Bool
$c== :: ResetPassword -> ResetPassword -> Bool
Prelude.Eq, Int -> ResetPassword -> ShowS
[ResetPassword] -> ShowS
ResetPassword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetPassword] -> ShowS
$cshowList :: [ResetPassword] -> ShowS
show :: ResetPassword -> String
$cshow :: ResetPassword -> String
showsPrec :: Int -> ResetPassword -> ShowS
$cshowsPrec :: Int -> ResetPassword -> ShowS
Prelude.Show, forall x. Rep ResetPassword x -> ResetPassword
forall x. ResetPassword -> Rep ResetPassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetPassword x -> ResetPassword
$cfrom :: forall x. ResetPassword -> Rep ResetPassword x
Prelude.Generic)

-- |
-- Create a value of 'ResetPassword' 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:
--
-- 'organizationId', 'resetPassword_organizationId' - The identifier of the organization that contains the user for which the
-- password is reset.
--
-- 'userId', 'resetPassword_userId' - The identifier of the user for whom the password is reset.
--
-- 'password', 'resetPassword_password' - The new password for the user.
newResetPassword ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  ResetPassword
newResetPassword :: Text -> Text -> Text -> ResetPassword
newResetPassword Text
pOrganizationId_ Text
pUserId_ Text
pPassword_ =
  ResetPassword'
    { $sel:organizationId:ResetPassword' :: Text
organizationId = Text
pOrganizationId_,
      $sel:userId:ResetPassword' :: Text
userId = Text
pUserId_,
      $sel:password:ResetPassword' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
    }

-- | The identifier of the organization that contains the user for which the
-- password is reset.
resetPassword_organizationId :: Lens.Lens' ResetPassword Prelude.Text
resetPassword_organizationId :: Lens' ResetPassword Text
resetPassword_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetPassword' {Text
organizationId :: Text
$sel:organizationId:ResetPassword' :: ResetPassword -> Text
organizationId} -> Text
organizationId) (\s :: ResetPassword
s@ResetPassword' {} Text
a -> ResetPassword
s {$sel:organizationId:ResetPassword' :: Text
organizationId = Text
a} :: ResetPassword)

-- | The identifier of the user for whom the password is reset.
resetPassword_userId :: Lens.Lens' ResetPassword Prelude.Text
resetPassword_userId :: Lens' ResetPassword Text
resetPassword_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetPassword' {Text
userId :: Text
$sel:userId:ResetPassword' :: ResetPassword -> Text
userId} -> Text
userId) (\s :: ResetPassword
s@ResetPassword' {} Text
a -> ResetPassword
s {$sel:userId:ResetPassword' :: Text
userId = Text
a} :: ResetPassword)

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

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

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

instance Data.ToHeaders ResetPassword where
  toHeaders :: ResetPassword -> 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
"WorkMailService.ResetPassword" ::
                          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 ResetPassword where
  toJSON :: ResetPassword -> Value
toJSON ResetPassword' {Text
Sensitive Text
password :: Sensitive Text
userId :: Text
organizationId :: Text
$sel:password:ResetPassword' :: ResetPassword -> Sensitive Text
$sel:userId:ResetPassword' :: ResetPassword -> Text
$sel:organizationId:ResetPassword' :: ResetPassword -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userId),
            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 ResetPassword where
  toPath :: ResetPassword -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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