{-# 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.IAM.ChangePassword
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes the password of the IAM user who is calling this operation. This
-- operation can be performed using the CLI, the Amazon Web Services API,
-- or the __My Security Credentials__ page in the Amazon Web Services
-- Management Console. The Amazon Web Services account root user password
-- is not affected by this operation.
--
-- Use UpdateLoginProfile to use the CLI, the Amazon Web Services API, or
-- the __Users__ page in the IAM console to change the password for any IAM
-- user. For more information about modifying passwords, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_ManagingLogins.html Managing passwords>
-- in the /IAM User Guide/.
module Amazonka.IAM.ChangePassword
  ( -- * Creating a Request
    ChangePassword (..),
    newChangePassword,

    -- * Request Lenses
    changePassword_oldPassword,
    changePassword_newPassword,

    -- * Destructuring the Response
    ChangePasswordResponse (..),
    newChangePasswordResponse,
  )
where

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

-- | /See:/ 'newChangePassword' smart constructor.
data ChangePassword = ChangePassword'
  { -- | The IAM user\'s current password.
    ChangePassword -> Sensitive Text
oldPassword :: Data.Sensitive Prelude.Text,
    -- | The new password. The new password must conform to the Amazon Web
    -- Services account\'s password policy, if one exists.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
    -- validate this parameter is a string of characters. That string can
    -- include almost any printable ASCII character from the space (@\\u0020@)
    -- through the end of the ASCII character range (@\\u00FF@). You can also
    -- include the tab (@\\u0009@), line feed (@\\u000A@), and carriage return
    -- (@\\u000D@) characters. Any of these characters are valid in a password.
    -- However, many tools, such as the Amazon Web Services Management Console,
    -- might restrict the ability to type certain characters because they have
    -- special meaning within that tool.
    ChangePassword -> Sensitive Text
newPassword' :: Data.Sensitive Prelude.Text
  }
  deriving (ChangePassword -> ChangePassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangePassword -> ChangePassword -> Bool
$c/= :: ChangePassword -> ChangePassword -> Bool
== :: ChangePassword -> ChangePassword -> Bool
$c== :: ChangePassword -> ChangePassword -> Bool
Prelude.Eq, Int -> ChangePassword -> ShowS
[ChangePassword] -> ShowS
ChangePassword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangePassword] -> ShowS
$cshowList :: [ChangePassword] -> ShowS
show :: ChangePassword -> String
$cshow :: ChangePassword -> String
showsPrec :: Int -> ChangePassword -> ShowS
$cshowsPrec :: Int -> ChangePassword -> ShowS
Prelude.Show, forall x. Rep ChangePassword x -> ChangePassword
forall x. ChangePassword -> Rep ChangePassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChangePassword x -> ChangePassword
$cfrom :: forall x. ChangePassword -> Rep ChangePassword x
Prelude.Generic)

-- |
-- Create a value of 'ChangePassword' 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:
--
-- 'oldPassword', 'changePassword_oldPassword' - The IAM user\'s current password.
--
-- 'newPassword'', 'changePassword_newPassword' - The new password. The new password must conform to the Amazon Web
-- Services account\'s password policy, if one exists.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
-- validate this parameter is a string of characters. That string can
-- include almost any printable ASCII character from the space (@\\u0020@)
-- through the end of the ASCII character range (@\\u00FF@). You can also
-- include the tab (@\\u0009@), line feed (@\\u000A@), and carriage return
-- (@\\u000D@) characters. Any of these characters are valid in a password.
-- However, many tools, such as the Amazon Web Services Management Console,
-- might restrict the ability to type certain characters because they have
-- special meaning within that tool.
newChangePassword ::
  -- | 'oldPassword'
  Prelude.Text ->
  -- | 'newPassword''
  Prelude.Text ->
  ChangePassword
newChangePassword :: Text -> Text -> ChangePassword
newChangePassword Text
pOldPassword_ Text
pNewPassword_ =
  ChangePassword'
    { $sel:oldPassword:ChangePassword' :: Sensitive Text
oldPassword =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pOldPassword_,
      $sel:newPassword':ChangePassword' :: Sensitive Text
newPassword' = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pNewPassword_
    }

-- | The IAM user\'s current password.
changePassword_oldPassword :: Lens.Lens' ChangePassword Prelude.Text
changePassword_oldPassword :: Lens' ChangePassword Text
changePassword_oldPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangePassword' {Sensitive Text
oldPassword :: Sensitive Text
$sel:oldPassword:ChangePassword' :: ChangePassword -> Sensitive Text
oldPassword} -> Sensitive Text
oldPassword) (\s :: ChangePassword
s@ChangePassword' {} Sensitive Text
a -> ChangePassword
s {$sel:oldPassword:ChangePassword' :: Sensitive Text
oldPassword = Sensitive Text
a} :: ChangePassword) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The new password. The new password must conform to the Amazon Web
-- Services account\'s password policy, if one exists.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
-- validate this parameter is a string of characters. That string can
-- include almost any printable ASCII character from the space (@\\u0020@)
-- through the end of the ASCII character range (@\\u00FF@). You can also
-- include the tab (@\\u0009@), line feed (@\\u000A@), and carriage return
-- (@\\u000D@) characters. Any of these characters are valid in a password.
-- However, many tools, such as the Amazon Web Services Management Console,
-- might restrict the ability to type certain characters because they have
-- special meaning within that tool.
changePassword_newPassword :: Lens.Lens' ChangePassword Prelude.Text
changePassword_newPassword :: Lens' ChangePassword Text
changePassword_newPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ChangePassword' {Sensitive Text
newPassword' :: Sensitive Text
$sel:newPassword':ChangePassword' :: ChangePassword -> Sensitive Text
newPassword'} -> Sensitive Text
newPassword') (\s :: ChangePassword
s@ChangePassword' {} Sensitive Text
a -> ChangePassword
s {$sel:newPassword':ChangePassword' :: Sensitive Text
newPassword' = Sensitive Text
a} :: ChangePassword) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest ChangePassword where
  type
    AWSResponse ChangePassword =
      ChangePasswordResponse
  request :: (Service -> Service) -> ChangePassword -> Request ChangePassword
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ChangePassword
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ChangePassword)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull ChangePasswordResponse
ChangePasswordResponse'

instance Prelude.Hashable ChangePassword where
  hashWithSalt :: Int -> ChangePassword -> Int
hashWithSalt Int
_salt ChangePassword' {Sensitive Text
newPassword' :: Sensitive Text
oldPassword :: Sensitive Text
$sel:newPassword':ChangePassword' :: ChangePassword -> Sensitive Text
$sel:oldPassword:ChangePassword' :: ChangePassword -> Sensitive Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
oldPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
newPassword'

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

instance Data.ToHeaders ChangePassword where
  toHeaders :: ChangePassword -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ChangePassword where
  toQuery :: ChangePassword -> QueryString
toQuery ChangePassword' {Sensitive Text
newPassword' :: Sensitive Text
oldPassword :: Sensitive Text
$sel:newPassword':ChangePassword' :: ChangePassword -> Sensitive Text
$sel:oldPassword:ChangePassword' :: ChangePassword -> Sensitive Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ChangePassword" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"OldPassword" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Sensitive Text
oldPassword,
        ByteString
"NewPassword" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Sensitive Text
newPassword'
      ]

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

-- |
-- Create a value of 'ChangePasswordResponse' 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.
newChangePasswordResponse ::
  ChangePasswordResponse
newChangePasswordResponse :: ChangePasswordResponse
newChangePasswordResponse = ChangePasswordResponse
ChangePasswordResponse'

instance Prelude.NFData ChangePasswordResponse where
  rnf :: ChangePasswordResponse -> ()
rnf ChangePasswordResponse
_ = ()