{-# 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.UpdateAccountPasswordPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the password policy settings for the Amazon Web Services
-- account.
--
-- This operation does not support partial updates. No parameters are
-- required, but if you do not specify a parameter, that parameter\'s value
-- reverts to its default value. See the __Request Parameters__ section for
-- each parameter\'s default value. Also note that some parameters do not
-- allow the default parameter to be explicitly set. Instead, to invoke the
-- default value, do not include that parameter when you invoke the
-- operation.
--
-- For more information about using a password policy, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_ManagingPasswordPolicies.html Managing an IAM password policy>
-- in the /IAM User Guide/.
module Amazonka.IAM.UpdateAccountPasswordPolicy
  ( -- * Creating a Request
    UpdateAccountPasswordPolicy (..),
    newUpdateAccountPasswordPolicy,

    -- * Request Lenses
    updateAccountPasswordPolicy_allowUsersToChangePassword,
    updateAccountPasswordPolicy_hardExpiry,
    updateAccountPasswordPolicy_maxPasswordAge,
    updateAccountPasswordPolicy_minimumPasswordLength,
    updateAccountPasswordPolicy_passwordReusePrevention,
    updateAccountPasswordPolicy_requireLowercaseCharacters,
    updateAccountPasswordPolicy_requireNumbers,
    updateAccountPasswordPolicy_requireSymbols,
    updateAccountPasswordPolicy_requireUppercaseCharacters,

    -- * Destructuring the Response
    UpdateAccountPasswordPolicyResponse (..),
    newUpdateAccountPasswordPolicyResponse,
  )
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:/ 'newUpdateAccountPasswordPolicy' smart constructor.
data UpdateAccountPasswordPolicy = UpdateAccountPasswordPolicy'
  { -- | Allows all IAM users in your account to use the Amazon Web Services
    -- Management Console to change their own passwords. For more information,
    -- see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_passwords_enable-user-change.html Permitting IAM users to change their own passwords>
    -- in the /IAM User Guide/.
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @false@. The result is that IAM users in the
    -- account do not automatically have permissions to change their own
    -- password.
    UpdateAccountPasswordPolicy -> Maybe Bool
allowUsersToChangePassword :: Prelude.Maybe Prelude.Bool,
    -- | Prevents IAM users who are accessing the account via the Amazon Web
    -- Services Management Console from setting a new console password after
    -- their password has expired. The IAM user cannot access the console until
    -- an administrator resets the password.
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @false@. The result is that IAM users can
    -- change their passwords after they expire and continue to sign in as the
    -- user.
    --
    -- In the Amazon Web Services Management Console, the custom password
    -- policy option __Allow users to change their own password__ gives IAM
    -- users permissions to @iam:ChangePassword@ for only their user and to the
    -- @iam:GetAccountPasswordPolicy@ action. This option does not attach a
    -- permissions policy to each user, rather the permissions are applied at
    -- the account-level for all users by IAM. IAM users with
    -- @iam:ChangePassword@ permission and active access keys can reset their
    -- own expired console password using the CLI or API.
    UpdateAccountPasswordPolicy -> Maybe Bool
hardExpiry :: Prelude.Maybe Prelude.Bool,
    -- | The number of days that an IAM user password is valid.
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @0@. The result is that IAM user passwords
    -- never expire.
    UpdateAccountPasswordPolicy -> Maybe Natural
maxPasswordAge :: Prelude.Maybe Prelude.Natural,
    -- | The minimum number of characters allowed in an IAM user password.
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @6@.
    UpdateAccountPasswordPolicy -> Maybe Natural
minimumPasswordLength :: Prelude.Maybe Prelude.Natural,
    -- | Specifies the number of previous passwords that IAM users are prevented
    -- from reusing.
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @0@. The result is that IAM users are not
    -- prevented from reusing previous passwords.
    UpdateAccountPasswordPolicy -> Maybe Natural
passwordReusePrevention :: Prelude.Maybe Prelude.Natural,
    -- | Specifies whether IAM user passwords must contain at least one lowercase
    -- character from the ISO basic Latin alphabet (a to z).
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @false@. The result is that passwords do not
    -- require at least one lowercase character.
    UpdateAccountPasswordPolicy -> Maybe Bool
requireLowercaseCharacters :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether IAM user passwords must contain at least one numeric
    -- character (0 to 9).
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @false@. The result is that passwords do not
    -- require at least one numeric character.
    UpdateAccountPasswordPolicy -> Maybe Bool
requireNumbers :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether IAM user passwords must contain at least one of the
    -- following non-alphanumeric characters:
    --
    -- ! \@ # $ % ^ & * ( ) _ + - = [ ] { } | \'
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @false@. The result is that passwords do not
    -- require at least one symbol character.
    UpdateAccountPasswordPolicy -> Maybe Bool
requireSymbols :: Prelude.Maybe Prelude.Bool,
    -- | Specifies whether IAM user passwords must contain at least one uppercase
    -- character from the ISO basic Latin alphabet (A to Z).
    --
    -- If you do not specify a value for this parameter, then the operation
    -- uses the default value of @false@. The result is that passwords do not
    -- require at least one uppercase character.
    UpdateAccountPasswordPolicy -> Maybe Bool
requireUppercaseCharacters :: Prelude.Maybe Prelude.Bool
  }
  deriving (UpdateAccountPasswordPolicy -> UpdateAccountPasswordPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAccountPasswordPolicy -> UpdateAccountPasswordPolicy -> Bool
$c/= :: UpdateAccountPasswordPolicy -> UpdateAccountPasswordPolicy -> Bool
== :: UpdateAccountPasswordPolicy -> UpdateAccountPasswordPolicy -> Bool
$c== :: UpdateAccountPasswordPolicy -> UpdateAccountPasswordPolicy -> Bool
Prelude.Eq, ReadPrec [UpdateAccountPasswordPolicy]
ReadPrec UpdateAccountPasswordPolicy
Int -> ReadS UpdateAccountPasswordPolicy
ReadS [UpdateAccountPasswordPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAccountPasswordPolicy]
$creadListPrec :: ReadPrec [UpdateAccountPasswordPolicy]
readPrec :: ReadPrec UpdateAccountPasswordPolicy
$creadPrec :: ReadPrec UpdateAccountPasswordPolicy
readList :: ReadS [UpdateAccountPasswordPolicy]
$creadList :: ReadS [UpdateAccountPasswordPolicy]
readsPrec :: Int -> ReadS UpdateAccountPasswordPolicy
$creadsPrec :: Int -> ReadS UpdateAccountPasswordPolicy
Prelude.Read, Int -> UpdateAccountPasswordPolicy -> ShowS
[UpdateAccountPasswordPolicy] -> ShowS
UpdateAccountPasswordPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAccountPasswordPolicy] -> ShowS
$cshowList :: [UpdateAccountPasswordPolicy] -> ShowS
show :: UpdateAccountPasswordPolicy -> String
$cshow :: UpdateAccountPasswordPolicy -> String
showsPrec :: Int -> UpdateAccountPasswordPolicy -> ShowS
$cshowsPrec :: Int -> UpdateAccountPasswordPolicy -> ShowS
Prelude.Show, forall x.
Rep UpdateAccountPasswordPolicy x -> UpdateAccountPasswordPolicy
forall x.
UpdateAccountPasswordPolicy -> Rep UpdateAccountPasswordPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAccountPasswordPolicy x -> UpdateAccountPasswordPolicy
$cfrom :: forall x.
UpdateAccountPasswordPolicy -> Rep UpdateAccountPasswordPolicy x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAccountPasswordPolicy' 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:
--
-- 'allowUsersToChangePassword', 'updateAccountPasswordPolicy_allowUsersToChangePassword' - Allows all IAM users in your account to use the Amazon Web Services
-- Management Console to change their own passwords. For more information,
-- see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_passwords_enable-user-change.html Permitting IAM users to change their own passwords>
-- in the /IAM User Guide/.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that IAM users in the
-- account do not automatically have permissions to change their own
-- password.
--
-- 'hardExpiry', 'updateAccountPasswordPolicy_hardExpiry' - Prevents IAM users who are accessing the account via the Amazon Web
-- Services Management Console from setting a new console password after
-- their password has expired. The IAM user cannot access the console until
-- an administrator resets the password.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that IAM users can
-- change their passwords after they expire and continue to sign in as the
-- user.
--
-- In the Amazon Web Services Management Console, the custom password
-- policy option __Allow users to change their own password__ gives IAM
-- users permissions to @iam:ChangePassword@ for only their user and to the
-- @iam:GetAccountPasswordPolicy@ action. This option does not attach a
-- permissions policy to each user, rather the permissions are applied at
-- the account-level for all users by IAM. IAM users with
-- @iam:ChangePassword@ permission and active access keys can reset their
-- own expired console password using the CLI or API.
--
-- 'maxPasswordAge', 'updateAccountPasswordPolicy_maxPasswordAge' - The number of days that an IAM user password is valid.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @0@. The result is that IAM user passwords
-- never expire.
--
-- 'minimumPasswordLength', 'updateAccountPasswordPolicy_minimumPasswordLength' - The minimum number of characters allowed in an IAM user password.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @6@.
--
-- 'passwordReusePrevention', 'updateAccountPasswordPolicy_passwordReusePrevention' - Specifies the number of previous passwords that IAM users are prevented
-- from reusing.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @0@. The result is that IAM users are not
-- prevented from reusing previous passwords.
--
-- 'requireLowercaseCharacters', 'updateAccountPasswordPolicy_requireLowercaseCharacters' - Specifies whether IAM user passwords must contain at least one lowercase
-- character from the ISO basic Latin alphabet (a to z).
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one lowercase character.
--
-- 'requireNumbers', 'updateAccountPasswordPolicy_requireNumbers' - Specifies whether IAM user passwords must contain at least one numeric
-- character (0 to 9).
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one numeric character.
--
-- 'requireSymbols', 'updateAccountPasswordPolicy_requireSymbols' - Specifies whether IAM user passwords must contain at least one of the
-- following non-alphanumeric characters:
--
-- ! \@ # $ % ^ & * ( ) _ + - = [ ] { } | \'
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one symbol character.
--
-- 'requireUppercaseCharacters', 'updateAccountPasswordPolicy_requireUppercaseCharacters' - Specifies whether IAM user passwords must contain at least one uppercase
-- character from the ISO basic Latin alphabet (A to Z).
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one uppercase character.
newUpdateAccountPasswordPolicy ::
  UpdateAccountPasswordPolicy
newUpdateAccountPasswordPolicy :: UpdateAccountPasswordPolicy
newUpdateAccountPasswordPolicy =
  UpdateAccountPasswordPolicy'
    { $sel:allowUsersToChangePassword:UpdateAccountPasswordPolicy' :: Maybe Bool
allowUsersToChangePassword =
        forall a. Maybe a
Prelude.Nothing,
      $sel:hardExpiry:UpdateAccountPasswordPolicy' :: Maybe Bool
hardExpiry = forall a. Maybe a
Prelude.Nothing,
      $sel:maxPasswordAge:UpdateAccountPasswordPolicy' :: Maybe Natural
maxPasswordAge = forall a. Maybe a
Prelude.Nothing,
      $sel:minimumPasswordLength:UpdateAccountPasswordPolicy' :: Maybe Natural
minimumPasswordLength = forall a. Maybe a
Prelude.Nothing,
      $sel:passwordReusePrevention:UpdateAccountPasswordPolicy' :: Maybe Natural
passwordReusePrevention = forall a. Maybe a
Prelude.Nothing,
      $sel:requireLowercaseCharacters:UpdateAccountPasswordPolicy' :: Maybe Bool
requireLowercaseCharacters = forall a. Maybe a
Prelude.Nothing,
      $sel:requireNumbers:UpdateAccountPasswordPolicy' :: Maybe Bool
requireNumbers = forall a. Maybe a
Prelude.Nothing,
      $sel:requireSymbols:UpdateAccountPasswordPolicy' :: Maybe Bool
requireSymbols = forall a. Maybe a
Prelude.Nothing,
      $sel:requireUppercaseCharacters:UpdateAccountPasswordPolicy' :: Maybe Bool
requireUppercaseCharacters = forall a. Maybe a
Prelude.Nothing
    }

-- | Allows all IAM users in your account to use the Amazon Web Services
-- Management Console to change their own passwords. For more information,
-- see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_passwords_enable-user-change.html Permitting IAM users to change their own passwords>
-- in the /IAM User Guide/.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that IAM users in the
-- account do not automatically have permissions to change their own
-- password.
updateAccountPasswordPolicy_allowUsersToChangePassword :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Bool)
updateAccountPasswordPolicy_allowUsersToChangePassword :: Lens' UpdateAccountPasswordPolicy (Maybe Bool)
updateAccountPasswordPolicy_allowUsersToChangePassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Bool
allowUsersToChangePassword :: Maybe Bool
$sel:allowUsersToChangePassword:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
allowUsersToChangePassword} -> Maybe Bool
allowUsersToChangePassword) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Bool
a -> UpdateAccountPasswordPolicy
s {$sel:allowUsersToChangePassword:UpdateAccountPasswordPolicy' :: Maybe Bool
allowUsersToChangePassword = Maybe Bool
a} :: UpdateAccountPasswordPolicy)

-- | Prevents IAM users who are accessing the account via the Amazon Web
-- Services Management Console from setting a new console password after
-- their password has expired. The IAM user cannot access the console until
-- an administrator resets the password.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that IAM users can
-- change their passwords after they expire and continue to sign in as the
-- user.
--
-- In the Amazon Web Services Management Console, the custom password
-- policy option __Allow users to change their own password__ gives IAM
-- users permissions to @iam:ChangePassword@ for only their user and to the
-- @iam:GetAccountPasswordPolicy@ action. This option does not attach a
-- permissions policy to each user, rather the permissions are applied at
-- the account-level for all users by IAM. IAM users with
-- @iam:ChangePassword@ permission and active access keys can reset their
-- own expired console password using the CLI or API.
updateAccountPasswordPolicy_hardExpiry :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Bool)
updateAccountPasswordPolicy_hardExpiry :: Lens' UpdateAccountPasswordPolicy (Maybe Bool)
updateAccountPasswordPolicy_hardExpiry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Bool
hardExpiry :: Maybe Bool
$sel:hardExpiry:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
hardExpiry} -> Maybe Bool
hardExpiry) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Bool
a -> UpdateAccountPasswordPolicy
s {$sel:hardExpiry:UpdateAccountPasswordPolicy' :: Maybe Bool
hardExpiry = Maybe Bool
a} :: UpdateAccountPasswordPolicy)

-- | The number of days that an IAM user password is valid.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @0@. The result is that IAM user passwords
-- never expire.
updateAccountPasswordPolicy_maxPasswordAge :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Natural)
updateAccountPasswordPolicy_maxPasswordAge :: Lens' UpdateAccountPasswordPolicy (Maybe Natural)
updateAccountPasswordPolicy_maxPasswordAge = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Natural
maxPasswordAge :: Maybe Natural
$sel:maxPasswordAge:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
maxPasswordAge} -> Maybe Natural
maxPasswordAge) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Natural
a -> UpdateAccountPasswordPolicy
s {$sel:maxPasswordAge:UpdateAccountPasswordPolicy' :: Maybe Natural
maxPasswordAge = Maybe Natural
a} :: UpdateAccountPasswordPolicy)

-- | The minimum number of characters allowed in an IAM user password.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @6@.
updateAccountPasswordPolicy_minimumPasswordLength :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Natural)
updateAccountPasswordPolicy_minimumPasswordLength :: Lens' UpdateAccountPasswordPolicy (Maybe Natural)
updateAccountPasswordPolicy_minimumPasswordLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Natural
minimumPasswordLength :: Maybe Natural
$sel:minimumPasswordLength:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
minimumPasswordLength} -> Maybe Natural
minimumPasswordLength) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Natural
a -> UpdateAccountPasswordPolicy
s {$sel:minimumPasswordLength:UpdateAccountPasswordPolicy' :: Maybe Natural
minimumPasswordLength = Maybe Natural
a} :: UpdateAccountPasswordPolicy)

-- | Specifies the number of previous passwords that IAM users are prevented
-- from reusing.
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @0@. The result is that IAM users are not
-- prevented from reusing previous passwords.
updateAccountPasswordPolicy_passwordReusePrevention :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Natural)
updateAccountPasswordPolicy_passwordReusePrevention :: Lens' UpdateAccountPasswordPolicy (Maybe Natural)
updateAccountPasswordPolicy_passwordReusePrevention = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Natural
passwordReusePrevention :: Maybe Natural
$sel:passwordReusePrevention:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
passwordReusePrevention} -> Maybe Natural
passwordReusePrevention) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Natural
a -> UpdateAccountPasswordPolicy
s {$sel:passwordReusePrevention:UpdateAccountPasswordPolicy' :: Maybe Natural
passwordReusePrevention = Maybe Natural
a} :: UpdateAccountPasswordPolicy)

-- | Specifies whether IAM user passwords must contain at least one lowercase
-- character from the ISO basic Latin alphabet (a to z).
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one lowercase character.
updateAccountPasswordPolicy_requireLowercaseCharacters :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Bool)
updateAccountPasswordPolicy_requireLowercaseCharacters :: Lens' UpdateAccountPasswordPolicy (Maybe Bool)
updateAccountPasswordPolicy_requireLowercaseCharacters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Bool
requireLowercaseCharacters :: Maybe Bool
$sel:requireLowercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
requireLowercaseCharacters} -> Maybe Bool
requireLowercaseCharacters) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Bool
a -> UpdateAccountPasswordPolicy
s {$sel:requireLowercaseCharacters:UpdateAccountPasswordPolicy' :: Maybe Bool
requireLowercaseCharacters = Maybe Bool
a} :: UpdateAccountPasswordPolicy)

-- | Specifies whether IAM user passwords must contain at least one numeric
-- character (0 to 9).
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one numeric character.
updateAccountPasswordPolicy_requireNumbers :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Bool)
updateAccountPasswordPolicy_requireNumbers :: Lens' UpdateAccountPasswordPolicy (Maybe Bool)
updateAccountPasswordPolicy_requireNumbers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Bool
requireNumbers :: Maybe Bool
$sel:requireNumbers:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
requireNumbers} -> Maybe Bool
requireNumbers) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Bool
a -> UpdateAccountPasswordPolicy
s {$sel:requireNumbers:UpdateAccountPasswordPolicy' :: Maybe Bool
requireNumbers = Maybe Bool
a} :: UpdateAccountPasswordPolicy)

-- | Specifies whether IAM user passwords must contain at least one of the
-- following non-alphanumeric characters:
--
-- ! \@ # $ % ^ & * ( ) _ + - = [ ] { } | \'
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one symbol character.
updateAccountPasswordPolicy_requireSymbols :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Bool)
updateAccountPasswordPolicy_requireSymbols :: Lens' UpdateAccountPasswordPolicy (Maybe Bool)
updateAccountPasswordPolicy_requireSymbols = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Bool
requireSymbols :: Maybe Bool
$sel:requireSymbols:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
requireSymbols} -> Maybe Bool
requireSymbols) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Bool
a -> UpdateAccountPasswordPolicy
s {$sel:requireSymbols:UpdateAccountPasswordPolicy' :: Maybe Bool
requireSymbols = Maybe Bool
a} :: UpdateAccountPasswordPolicy)

-- | Specifies whether IAM user passwords must contain at least one uppercase
-- character from the ISO basic Latin alphabet (A to Z).
--
-- If you do not specify a value for this parameter, then the operation
-- uses the default value of @false@. The result is that passwords do not
-- require at least one uppercase character.
updateAccountPasswordPolicy_requireUppercaseCharacters :: Lens.Lens' UpdateAccountPasswordPolicy (Prelude.Maybe Prelude.Bool)
updateAccountPasswordPolicy_requireUppercaseCharacters :: Lens' UpdateAccountPasswordPolicy (Maybe Bool)
updateAccountPasswordPolicy_requireUppercaseCharacters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountPasswordPolicy' {Maybe Bool
requireUppercaseCharacters :: Maybe Bool
$sel:requireUppercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
requireUppercaseCharacters} -> Maybe Bool
requireUppercaseCharacters) (\s :: UpdateAccountPasswordPolicy
s@UpdateAccountPasswordPolicy' {} Maybe Bool
a -> UpdateAccountPasswordPolicy
s {$sel:requireUppercaseCharacters:UpdateAccountPasswordPolicy' :: Maybe Bool
requireUppercaseCharacters = Maybe Bool
a} :: UpdateAccountPasswordPolicy)

instance Core.AWSRequest UpdateAccountPasswordPolicy where
  type
    AWSResponse UpdateAccountPasswordPolicy =
      UpdateAccountPasswordPolicyResponse
  request :: (Service -> Service)
-> UpdateAccountPasswordPolicy
-> Request UpdateAccountPasswordPolicy
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 UpdateAccountPasswordPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAccountPasswordPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      UpdateAccountPasswordPolicyResponse
UpdateAccountPasswordPolicyResponse'

instance Prelude.Hashable UpdateAccountPasswordPolicy where
  hashWithSalt :: Int -> UpdateAccountPasswordPolicy -> Int
hashWithSalt Int
_salt UpdateAccountPasswordPolicy' {Maybe Bool
Maybe Natural
requireUppercaseCharacters :: Maybe Bool
requireSymbols :: Maybe Bool
requireNumbers :: Maybe Bool
requireLowercaseCharacters :: Maybe Bool
passwordReusePrevention :: Maybe Natural
minimumPasswordLength :: Maybe Natural
maxPasswordAge :: Maybe Natural
hardExpiry :: Maybe Bool
allowUsersToChangePassword :: Maybe Bool
$sel:requireUppercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireSymbols:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireNumbers:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireLowercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:passwordReusePrevention:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:minimumPasswordLength:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:maxPasswordAge:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:hardExpiry:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:allowUsersToChangePassword:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowUsersToChangePassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
hardExpiry
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxPasswordAge
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minimumPasswordLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
passwordReusePrevention
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
requireLowercaseCharacters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
requireNumbers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
requireSymbols
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
requireUppercaseCharacters

instance Prelude.NFData UpdateAccountPasswordPolicy where
  rnf :: UpdateAccountPasswordPolicy -> ()
rnf UpdateAccountPasswordPolicy' {Maybe Bool
Maybe Natural
requireUppercaseCharacters :: Maybe Bool
requireSymbols :: Maybe Bool
requireNumbers :: Maybe Bool
requireLowercaseCharacters :: Maybe Bool
passwordReusePrevention :: Maybe Natural
minimumPasswordLength :: Maybe Natural
maxPasswordAge :: Maybe Natural
hardExpiry :: Maybe Bool
allowUsersToChangePassword :: Maybe Bool
$sel:requireUppercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireSymbols:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireNumbers:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireLowercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:passwordReusePrevention:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:minimumPasswordLength:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:maxPasswordAge:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:hardExpiry:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:allowUsersToChangePassword:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowUsersToChangePassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
hardExpiry
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxPasswordAge
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minimumPasswordLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
passwordReusePrevention
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
requireLowercaseCharacters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
requireNumbers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
requireSymbols
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
requireUppercaseCharacters

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

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

instance Data.ToQuery UpdateAccountPasswordPolicy where
  toQuery :: UpdateAccountPasswordPolicy -> QueryString
toQuery UpdateAccountPasswordPolicy' {Maybe Bool
Maybe Natural
requireUppercaseCharacters :: Maybe Bool
requireSymbols :: Maybe Bool
requireNumbers :: Maybe Bool
requireLowercaseCharacters :: Maybe Bool
passwordReusePrevention :: Maybe Natural
minimumPasswordLength :: Maybe Natural
maxPasswordAge :: Maybe Natural
hardExpiry :: Maybe Bool
allowUsersToChangePassword :: Maybe Bool
$sel:requireUppercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireSymbols:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireNumbers:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:requireLowercaseCharacters:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:passwordReusePrevention:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:minimumPasswordLength:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:maxPasswordAge:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Natural
$sel:hardExpiry:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
$sel:allowUsersToChangePassword:UpdateAccountPasswordPolicy' :: UpdateAccountPasswordPolicy -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"UpdateAccountPasswordPolicy" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"AllowUsersToChangePassword"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
allowUsersToChangePassword,
        ByteString
"HardExpiry" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
hardExpiry,
        ByteString
"MaxPasswordAge" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxPasswordAge,
        ByteString
"MinimumPasswordLength"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
minimumPasswordLength,
        ByteString
"PasswordReusePrevention"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
passwordReusePrevention,
        ByteString
"RequireLowercaseCharacters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
requireLowercaseCharacters,
        ByteString
"RequireNumbers" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
requireNumbers,
        ByteString
"RequireSymbols" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
requireSymbols,
        ByteString
"RequireUppercaseCharacters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
requireUppercaseCharacters
      ]

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

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

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