{-# 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.DirectoryService.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 any user in your Managed Microsoft AD or Simple
-- AD directory.
--
-- You can reset the password for any user in your directory with the
-- following exceptions:
--
-- -   For Simple AD, you cannot reset the password for any user that is a
--     member of either the __Domain Admins__ or __Enterprise Admins__
--     group except for the administrator user.
--
-- -   For Managed Microsoft AD, you can only reset the password for a user
--     that is in an OU based off of the NetBIOS name that you typed when
--     you created your directory. For example, you cannot reset the
--     password for a user in the __Amazon Web Services Reserved__ OU. For
--     more information about the OU structure for an Managed Microsoft AD
--     directory, see
--     <https://docs.aws.amazon.com/directoryservice/latest/admin-guide/ms_ad_getting_started_what_gets_created.html What Gets Created>
--     in the /Directory Service Administration Guide/.
module Amazonka.DirectoryService.ResetUserPassword
  ( -- * Creating a Request
    ResetUserPassword (..),
    newResetUserPassword,

    -- * Request Lenses
    resetUserPassword_directoryId,
    resetUserPassword_userName,
    resetUserPassword_newPassword,

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

    -- * Response Lenses
    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.DirectoryService.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'
  { -- | Identifier of the Managed Microsoft AD or Simple AD directory in which
    -- the user resides.
    ResetUserPassword -> Text
directoryId :: Prelude.Text,
    -- | The user name of the user whose password will be reset.
    ResetUserPassword -> Text
userName :: Prelude.Text,
    -- | The new password that will be reset.
    ResetUserPassword -> Sensitive Text
newPassword' :: Data.Sensitive 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, 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:
--
-- 'directoryId', 'resetUserPassword_directoryId' - Identifier of the Managed Microsoft AD or Simple AD directory in which
-- the user resides.
--
-- 'userName', 'resetUserPassword_userName' - The user name of the user whose password will be reset.
--
-- 'newPassword'', 'resetUserPassword_newPassword' - The new password that will be reset.
newResetUserPassword ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'userName'
  Prelude.Text ->
  -- | 'newPassword''
  Prelude.Text ->
  ResetUserPassword
newResetUserPassword :: Text -> Text -> Text -> ResetUserPassword
newResetUserPassword
  Text
pDirectoryId_
  Text
pUserName_
  Text
pNewPassword_ =
    ResetUserPassword'
      { $sel:directoryId:ResetUserPassword' :: Text
directoryId = Text
pDirectoryId_,
        $sel:userName:ResetUserPassword' :: Text
userName = Text
pUserName_,
        $sel:newPassword':ResetUserPassword' :: Sensitive Text
newPassword' = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pNewPassword_
      }

-- | Identifier of the Managed Microsoft AD or Simple AD directory in which
-- the user resides.
resetUserPassword_directoryId :: Lens.Lens' ResetUserPassword Prelude.Text
resetUserPassword_directoryId :: Lens' ResetUserPassword Text
resetUserPassword_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetUserPassword' {Text
directoryId :: Text
$sel:directoryId:ResetUserPassword' :: ResetUserPassword -> Text
directoryId} -> Text
directoryId) (\s :: ResetUserPassword
s@ResetUserPassword' {} Text
a -> ResetUserPassword
s {$sel:directoryId:ResetUserPassword' :: Text
directoryId = Text
a} :: ResetUserPassword)

-- | The user name of the user whose password will be reset.
resetUserPassword_userName :: Lens.Lens' ResetUserPassword Prelude.Text
resetUserPassword_userName :: Lens' ResetUserPassword Text
resetUserPassword_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetUserPassword' {Text
userName :: Text
$sel:userName:ResetUserPassword' :: ResetUserPassword -> Text
userName} -> Text
userName) (\s :: ResetUserPassword
s@ResetUserPassword' {} Text
a -> ResetUserPassword
s {$sel:userName:ResetUserPassword' :: Text
userName = Text
a} :: ResetUserPassword)

-- | The new password that will be reset.
resetUserPassword_newPassword :: Lens.Lens' ResetUserPassword Prelude.Text
resetUserPassword_newPassword :: Lens' ResetUserPassword Text
resetUserPassword_newPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetUserPassword' {Sensitive Text
newPassword' :: Sensitive Text
$sel:newPassword':ResetUserPassword' :: ResetUserPassword -> Sensitive Text
newPassword'} -> Sensitive Text
newPassword') (\s :: ResetUserPassword
s@ResetUserPassword' {} Sensitive Text
a -> ResetUserPassword
s {$sel:newPassword':ResetUserPassword' :: Sensitive Text
newPassword' = Sensitive Text
a} :: ResetUserPassword) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

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 -> () -> 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 -> ResetUserPasswordResponse
ResetUserPasswordResponse'
            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 ResetUserPassword where
  hashWithSalt :: Int -> ResetUserPassword -> Int
hashWithSalt Int
_salt ResetUserPassword' {Text
Sensitive Text
newPassword' :: Sensitive Text
userName :: Text
directoryId :: Text
$sel:newPassword':ResetUserPassword' :: ResetUserPassword -> Sensitive Text
$sel:userName:ResetUserPassword' :: ResetUserPassword -> Text
$sel:directoryId:ResetUserPassword' :: ResetUserPassword -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
newPassword'

instance Prelude.NFData ResetUserPassword where
  rnf :: ResetUserPassword -> ()
rnf ResetUserPassword' {Text
Sensitive Text
newPassword' :: Sensitive Text
userName :: Text
directoryId :: Text
$sel:newPassword':ResetUserPassword' :: ResetUserPassword -> Sensitive Text
$sel:userName:ResetUserPassword' :: ResetUserPassword -> Text
$sel:directoryId:ResetUserPassword' :: ResetUserPassword -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
newPassword'

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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DirectoryService_20150416.ResetUserPassword" ::
                          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 ResetUserPassword where
  toJSON :: ResetUserPassword -> Value
toJSON ResetUserPassword' {Text
Sensitive Text
newPassword' :: Sensitive Text
userName :: Text
directoryId :: Text
$sel:newPassword':ResetUserPassword' :: ResetUserPassword -> Sensitive Text
$sel:userName:ResetUserPassword' :: ResetUserPassword -> Text
$sel:directoryId:ResetUserPassword' :: ResetUserPassword -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userName),
            forall a. a -> Maybe a
Prelude.Just (Key
"NewPassword" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
newPassword')
          ]
      )

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

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'
  { -- | 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, ReadPrec [ResetUserPasswordResponse]
ReadPrec ResetUserPasswordResponse
Int -> ReadS ResetUserPasswordResponse
ReadS [ResetUserPasswordResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetUserPasswordResponse]
$creadListPrec :: ReadPrec [ResetUserPasswordResponse]
readPrec :: ReadPrec ResetUserPasswordResponse
$creadPrec :: ReadPrec ResetUserPasswordResponse
readList :: ReadS [ResetUserPasswordResponse]
$creadList :: ReadS [ResetUserPasswordResponse]
readsPrec :: Int -> ReadS ResetUserPasswordResponse
$creadsPrec :: Int -> ReadS ResetUserPasswordResponse
Prelude.Read, 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:
--
-- 'httpStatus', 'resetUserPasswordResponse_httpStatus' - The response's http status code.
newResetUserPasswordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ResetUserPasswordResponse
newResetUserPasswordResponse :: Int -> ResetUserPasswordResponse
newResetUserPasswordResponse Int
pHttpStatus_ =
  ResetUserPasswordResponse'
    { $sel:httpStatus:ResetUserPasswordResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | 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
httpStatus :: Int
$sel:httpStatus:ResetUserPasswordResponse' :: ResetUserPasswordResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus