{-# 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.CreateLoginProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a password for the specified IAM user. A password allows an IAM
-- user to access Amazon Web Services services through the Amazon Web
-- Services Management Console.
--
-- You can use the CLI, the Amazon Web Services API, or the __Users__ page
-- in the IAM console to create a password for any IAM user. Use
-- ChangePassword to update your own existing password in the __My Security
-- Credentials__ page in the Amazon Web Services Management Console.
--
-- For more information about managing passwords, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_ManagingLogins.html Managing passwords>
-- in the /IAM User Guide/.
module Amazonka.IAM.CreateLoginProfile
  ( -- * Creating a Request
    CreateLoginProfile (..),
    newCreateLoginProfile,

    -- * Request Lenses
    createLoginProfile_passwordResetRequired,
    createLoginProfile_userName,
    createLoginProfile_password,

    -- * Destructuring the Response
    CreateLoginProfileResponse (..),
    newCreateLoginProfileResponse,

    -- * Response Lenses
    createLoginProfileResponse_httpStatus,
    createLoginProfileResponse_loginProfile,
  )
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:/ 'newCreateLoginProfile' smart constructor.
data CreateLoginProfile = CreateLoginProfile'
  { -- | Specifies whether the user is required to set a new password on next
    -- sign-in.
    CreateLoginProfile -> Maybe Bool
passwordResetRequired :: Prelude.Maybe Prelude.Bool,
    -- | The name of the IAM user to create a password for. The user must already
    -- exist.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    CreateLoginProfile -> Text
userName :: Prelude.Text,
    -- | The new password for the user.
    --
    -- 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.
    CreateLoginProfile -> Sensitive Text
password :: Data.Sensitive Prelude.Text
  }
  deriving (CreateLoginProfile -> CreateLoginProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLoginProfile -> CreateLoginProfile -> Bool
$c/= :: CreateLoginProfile -> CreateLoginProfile -> Bool
== :: CreateLoginProfile -> CreateLoginProfile -> Bool
$c== :: CreateLoginProfile -> CreateLoginProfile -> Bool
Prelude.Eq, Int -> CreateLoginProfile -> ShowS
[CreateLoginProfile] -> ShowS
CreateLoginProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLoginProfile] -> ShowS
$cshowList :: [CreateLoginProfile] -> ShowS
show :: CreateLoginProfile -> String
$cshow :: CreateLoginProfile -> String
showsPrec :: Int -> CreateLoginProfile -> ShowS
$cshowsPrec :: Int -> CreateLoginProfile -> ShowS
Prelude.Show, forall x. Rep CreateLoginProfile x -> CreateLoginProfile
forall x. CreateLoginProfile -> Rep CreateLoginProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLoginProfile x -> CreateLoginProfile
$cfrom :: forall x. CreateLoginProfile -> Rep CreateLoginProfile x
Prelude.Generic)

-- |
-- Create a value of 'CreateLoginProfile' 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:
--
-- 'passwordResetRequired', 'createLoginProfile_passwordResetRequired' - Specifies whether the user is required to set a new password on next
-- sign-in.
--
-- 'userName', 'createLoginProfile_userName' - The name of the IAM user to create a password for. The user must already
-- exist.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
--
-- 'password', 'createLoginProfile_password' - The new password for the user.
--
-- 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.
newCreateLoginProfile ::
  -- | 'userName'
  Prelude.Text ->
  -- | 'password'
  Prelude.Text ->
  CreateLoginProfile
newCreateLoginProfile :: Text -> Text -> CreateLoginProfile
newCreateLoginProfile Text
pUserName_ Text
pPassword_ =
  CreateLoginProfile'
    { $sel:passwordResetRequired:CreateLoginProfile' :: Maybe Bool
passwordResetRequired =
        forall a. Maybe a
Prelude.Nothing,
      $sel:userName:CreateLoginProfile' :: Text
userName = Text
pUserName_,
      $sel:password:CreateLoginProfile' :: Sensitive Text
password = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPassword_
    }

-- | Specifies whether the user is required to set a new password on next
-- sign-in.
createLoginProfile_passwordResetRequired :: Lens.Lens' CreateLoginProfile (Prelude.Maybe Prelude.Bool)
createLoginProfile_passwordResetRequired :: Lens' CreateLoginProfile (Maybe Bool)
createLoginProfile_passwordResetRequired = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoginProfile' {Maybe Bool
passwordResetRequired :: Maybe Bool
$sel:passwordResetRequired:CreateLoginProfile' :: CreateLoginProfile -> Maybe Bool
passwordResetRequired} -> Maybe Bool
passwordResetRequired) (\s :: CreateLoginProfile
s@CreateLoginProfile' {} Maybe Bool
a -> CreateLoginProfile
s {$sel:passwordResetRequired:CreateLoginProfile' :: Maybe Bool
passwordResetRequired = Maybe Bool
a} :: CreateLoginProfile)

-- | The name of the IAM user to create a password for. The user must already
-- exist.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
createLoginProfile_userName :: Lens.Lens' CreateLoginProfile Prelude.Text
createLoginProfile_userName :: Lens' CreateLoginProfile Text
createLoginProfile_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoginProfile' {Text
userName :: Text
$sel:userName:CreateLoginProfile' :: CreateLoginProfile -> Text
userName} -> Text
userName) (\s :: CreateLoginProfile
s@CreateLoginProfile' {} Text
a -> CreateLoginProfile
s {$sel:userName:CreateLoginProfile' :: Text
userName = Text
a} :: CreateLoginProfile)

-- | The new password for the user.
--
-- 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.
createLoginProfile_password :: Lens.Lens' CreateLoginProfile Prelude.Text
createLoginProfile_password :: Lens' CreateLoginProfile Text
createLoginProfile_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoginProfile' {Sensitive Text
password :: Sensitive Text
$sel:password:CreateLoginProfile' :: CreateLoginProfile -> Sensitive Text
password} -> Sensitive Text
password) (\s :: CreateLoginProfile
s@CreateLoginProfile' {} Sensitive Text
a -> CreateLoginProfile
s {$sel:password:CreateLoginProfile' :: Sensitive Text
password = Sensitive Text
a} :: CreateLoginProfile) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest CreateLoginProfile where
  type
    AWSResponse CreateLoginProfile =
      CreateLoginProfileResponse
  request :: (Service -> Service)
-> CreateLoginProfile -> Request CreateLoginProfile
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 CreateLoginProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLoginProfile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreateLoginProfileResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> LoginProfile -> CreateLoginProfileResponse
CreateLoginProfileResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"LoginProfile")
      )

instance Prelude.Hashable CreateLoginProfile where
  hashWithSalt :: Int -> CreateLoginProfile -> Int
hashWithSalt Int
_salt CreateLoginProfile' {Maybe Bool
Text
Sensitive Text
password :: Sensitive Text
userName :: Text
passwordResetRequired :: Maybe Bool
$sel:password:CreateLoginProfile' :: CreateLoginProfile -> Sensitive Text
$sel:userName:CreateLoginProfile' :: CreateLoginProfile -> Text
$sel:passwordResetRequired:CreateLoginProfile' :: CreateLoginProfile -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
passwordResetRequired
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
password

instance Prelude.NFData CreateLoginProfile where
  rnf :: CreateLoginProfile -> ()
rnf CreateLoginProfile' {Maybe Bool
Text
Sensitive Text
password :: Sensitive Text
userName :: Text
passwordResetRequired :: Maybe Bool
$sel:password:CreateLoginProfile' :: CreateLoginProfile -> Sensitive Text
$sel:userName:CreateLoginProfile' :: CreateLoginProfile -> Text
$sel:passwordResetRequired:CreateLoginProfile' :: CreateLoginProfile -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
passwordResetRequired
      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
password

instance Data.ToHeaders CreateLoginProfile where
  toHeaders :: CreateLoginProfile -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery CreateLoginProfile where
  toQuery :: CreateLoginProfile -> QueryString
toQuery CreateLoginProfile' {Maybe Bool
Text
Sensitive Text
password :: Sensitive Text
userName :: Text
passwordResetRequired :: Maybe Bool
$sel:password:CreateLoginProfile' :: CreateLoginProfile -> Sensitive Text
$sel:userName:CreateLoginProfile' :: CreateLoginProfile -> Text
$sel:passwordResetRequired:CreateLoginProfile' :: CreateLoginProfile -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateLoginProfile" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"PasswordResetRequired"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
passwordResetRequired,
        ByteString
"UserName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
userName,
        ByteString
"Password" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Sensitive Text
password
      ]

-- | Contains the response to a successful CreateLoginProfile request.
--
-- /See:/ 'newCreateLoginProfileResponse' smart constructor.
data CreateLoginProfileResponse = CreateLoginProfileResponse'
  { -- | The response's http status code.
    CreateLoginProfileResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure containing the user name and password create date.
    CreateLoginProfileResponse -> LoginProfile
loginProfile :: LoginProfile
  }
  deriving (CreateLoginProfileResponse -> CreateLoginProfileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLoginProfileResponse -> CreateLoginProfileResponse -> Bool
$c/= :: CreateLoginProfileResponse -> CreateLoginProfileResponse -> Bool
== :: CreateLoginProfileResponse -> CreateLoginProfileResponse -> Bool
$c== :: CreateLoginProfileResponse -> CreateLoginProfileResponse -> Bool
Prelude.Eq, ReadPrec [CreateLoginProfileResponse]
ReadPrec CreateLoginProfileResponse
Int -> ReadS CreateLoginProfileResponse
ReadS [CreateLoginProfileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLoginProfileResponse]
$creadListPrec :: ReadPrec [CreateLoginProfileResponse]
readPrec :: ReadPrec CreateLoginProfileResponse
$creadPrec :: ReadPrec CreateLoginProfileResponse
readList :: ReadS [CreateLoginProfileResponse]
$creadList :: ReadS [CreateLoginProfileResponse]
readsPrec :: Int -> ReadS CreateLoginProfileResponse
$creadsPrec :: Int -> ReadS CreateLoginProfileResponse
Prelude.Read, Int -> CreateLoginProfileResponse -> ShowS
[CreateLoginProfileResponse] -> ShowS
CreateLoginProfileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLoginProfileResponse] -> ShowS
$cshowList :: [CreateLoginProfileResponse] -> ShowS
show :: CreateLoginProfileResponse -> String
$cshow :: CreateLoginProfileResponse -> String
showsPrec :: Int -> CreateLoginProfileResponse -> ShowS
$cshowsPrec :: Int -> CreateLoginProfileResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLoginProfileResponse x -> CreateLoginProfileResponse
forall x.
CreateLoginProfileResponse -> Rep CreateLoginProfileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLoginProfileResponse x -> CreateLoginProfileResponse
$cfrom :: forall x.
CreateLoginProfileResponse -> Rep CreateLoginProfileResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLoginProfileResponse' 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', 'createLoginProfileResponse_httpStatus' - The response's http status code.
--
-- 'loginProfile', 'createLoginProfileResponse_loginProfile' - A structure containing the user name and password create date.
newCreateLoginProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'loginProfile'
  LoginProfile ->
  CreateLoginProfileResponse
newCreateLoginProfileResponse :: Int -> LoginProfile -> CreateLoginProfileResponse
newCreateLoginProfileResponse
  Int
pHttpStatus_
  LoginProfile
pLoginProfile_ =
    CreateLoginProfileResponse'
      { $sel:httpStatus:CreateLoginProfileResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:loginProfile:CreateLoginProfileResponse' :: LoginProfile
loginProfile = LoginProfile
pLoginProfile_
      }

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

-- | A structure containing the user name and password create date.
createLoginProfileResponse_loginProfile :: Lens.Lens' CreateLoginProfileResponse LoginProfile
createLoginProfileResponse_loginProfile :: Lens' CreateLoginProfileResponse LoginProfile
createLoginProfileResponse_loginProfile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoginProfileResponse' {LoginProfile
loginProfile :: LoginProfile
$sel:loginProfile:CreateLoginProfileResponse' :: CreateLoginProfileResponse -> LoginProfile
loginProfile} -> LoginProfile
loginProfile) (\s :: CreateLoginProfileResponse
s@CreateLoginProfileResponse' {} LoginProfile
a -> CreateLoginProfileResponse
s {$sel:loginProfile:CreateLoginProfileResponse' :: LoginProfile
loginProfile = LoginProfile
a} :: CreateLoginProfileResponse)

instance Prelude.NFData CreateLoginProfileResponse where
  rnf :: CreateLoginProfileResponse -> ()
rnf CreateLoginProfileResponse' {Int
LoginProfile
loginProfile :: LoginProfile
httpStatus :: Int
$sel:loginProfile:CreateLoginProfileResponse' :: CreateLoginProfileResponse -> LoginProfile
$sel:httpStatus:CreateLoginProfileResponse' :: CreateLoginProfileResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LoginProfile
loginProfile