{-# 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.CreateAccessKey
-- 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 new Amazon Web Services secret access key and corresponding
-- Amazon Web Services access key ID for the specified user. The default
-- status for new keys is @Active@.
--
-- If you do not specify a user name, IAM determines the user name
-- implicitly based on the Amazon Web Services access key ID signing the
-- request. This operation works for access keys under the Amazon Web
-- Services account. Consequently, you can use this operation to manage
-- Amazon Web Services account root user credentials. This is true even if
-- the Amazon Web Services account has no associated users.
--
-- For information about quotas on the number of keys you can create, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_iam-quotas.html IAM and STS quotas>
-- in the /IAM User Guide/.
--
-- To ensure the security of your Amazon Web Services account, the secret
-- access key is accessible only during key and user creation. You must
-- save the key (for example, in a text file) if you want to be able to
-- access it again. If a secret key is lost, you can delete the access keys
-- for the associated user and then create new keys.
module Amazonka.IAM.CreateAccessKey
  ( -- * Creating a Request
    CreateAccessKey (..),
    newCreateAccessKey,

    -- * Request Lenses
    createAccessKey_userName,

    -- * Destructuring the Response
    CreateAccessKeyResponse (..),
    newCreateAccessKeyResponse,

    -- * Response Lenses
    createAccessKeyResponse_httpStatus,
    createAccessKeyResponse_accessKey,
  )
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:/ 'newCreateAccessKey' smart constructor.
data CreateAccessKey = CreateAccessKey'
  { -- | The name of the IAM user that the new key will belong to.
    --
    -- 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: _+=,.\@-
    CreateAccessKey -> Maybe Text
userName :: Prelude.Maybe Prelude.Text
  }
  deriving (CreateAccessKey -> CreateAccessKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccessKey -> CreateAccessKey -> Bool
$c/= :: CreateAccessKey -> CreateAccessKey -> Bool
== :: CreateAccessKey -> CreateAccessKey -> Bool
$c== :: CreateAccessKey -> CreateAccessKey -> Bool
Prelude.Eq, ReadPrec [CreateAccessKey]
ReadPrec CreateAccessKey
Int -> ReadS CreateAccessKey
ReadS [CreateAccessKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAccessKey]
$creadListPrec :: ReadPrec [CreateAccessKey]
readPrec :: ReadPrec CreateAccessKey
$creadPrec :: ReadPrec CreateAccessKey
readList :: ReadS [CreateAccessKey]
$creadList :: ReadS [CreateAccessKey]
readsPrec :: Int -> ReadS CreateAccessKey
$creadsPrec :: Int -> ReadS CreateAccessKey
Prelude.Read, Int -> CreateAccessKey -> ShowS
[CreateAccessKey] -> ShowS
CreateAccessKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccessKey] -> ShowS
$cshowList :: [CreateAccessKey] -> ShowS
show :: CreateAccessKey -> String
$cshow :: CreateAccessKey -> String
showsPrec :: Int -> CreateAccessKey -> ShowS
$cshowsPrec :: Int -> CreateAccessKey -> ShowS
Prelude.Show, forall x. Rep CreateAccessKey x -> CreateAccessKey
forall x. CreateAccessKey -> Rep CreateAccessKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAccessKey x -> CreateAccessKey
$cfrom :: forall x. CreateAccessKey -> Rep CreateAccessKey x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccessKey' 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:
--
-- 'userName', 'createAccessKey_userName' - The name of the IAM user that the new key will belong to.
--
-- 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: _+=,.\@-
newCreateAccessKey ::
  CreateAccessKey
newCreateAccessKey :: CreateAccessKey
newCreateAccessKey =
  CreateAccessKey' {$sel:userName:CreateAccessKey' :: Maybe Text
userName = forall a. Maybe a
Prelude.Nothing}

-- | The name of the IAM user that the new key will belong to.
--
-- 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: _+=,.\@-
createAccessKey_userName :: Lens.Lens' CreateAccessKey (Prelude.Maybe Prelude.Text)
createAccessKey_userName :: Lens' CreateAccessKey (Maybe Text)
createAccessKey_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessKey' {Maybe Text
userName :: Maybe Text
$sel:userName:CreateAccessKey' :: CreateAccessKey -> Maybe Text
userName} -> Maybe Text
userName) (\s :: CreateAccessKey
s@CreateAccessKey' {} Maybe Text
a -> CreateAccessKey
s {$sel:userName:CreateAccessKey' :: Maybe Text
userName = Maybe Text
a} :: CreateAccessKey)

instance Core.AWSRequest CreateAccessKey where
  type
    AWSResponse CreateAccessKey =
      CreateAccessKeyResponse
  request :: (Service -> Service) -> CreateAccessKey -> Request CreateAccessKey
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 CreateAccessKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateAccessKey)))
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
"CreateAccessKeyResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> AccessKeyInfo -> CreateAccessKeyResponse
CreateAccessKeyResponse'
            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
"AccessKey")
      )

instance Prelude.Hashable CreateAccessKey where
  hashWithSalt :: Int -> CreateAccessKey -> Int
hashWithSalt Int
_salt CreateAccessKey' {Maybe Text
userName :: Maybe Text
$sel:userName:CreateAccessKey' :: CreateAccessKey -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userName

instance Prelude.NFData CreateAccessKey where
  rnf :: CreateAccessKey -> ()
rnf CreateAccessKey' {Maybe Text
userName :: Maybe Text
$sel:userName:CreateAccessKey' :: CreateAccessKey -> Maybe Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userName

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

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

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

-- | Contains the response to a successful CreateAccessKey request.
--
-- /See:/ 'newCreateAccessKeyResponse' smart constructor.
data CreateAccessKeyResponse = CreateAccessKeyResponse'
  { -- | The response's http status code.
    CreateAccessKeyResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure with details about the access key.
    CreateAccessKeyResponse -> AccessKeyInfo
accessKey :: AccessKeyInfo
  }
  deriving (CreateAccessKeyResponse -> CreateAccessKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccessKeyResponse -> CreateAccessKeyResponse -> Bool
$c/= :: CreateAccessKeyResponse -> CreateAccessKeyResponse -> Bool
== :: CreateAccessKeyResponse -> CreateAccessKeyResponse -> Bool
$c== :: CreateAccessKeyResponse -> CreateAccessKeyResponse -> Bool
Prelude.Eq, Int -> CreateAccessKeyResponse -> ShowS
[CreateAccessKeyResponse] -> ShowS
CreateAccessKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccessKeyResponse] -> ShowS
$cshowList :: [CreateAccessKeyResponse] -> ShowS
show :: CreateAccessKeyResponse -> String
$cshow :: CreateAccessKeyResponse -> String
showsPrec :: Int -> CreateAccessKeyResponse -> ShowS
$cshowsPrec :: Int -> CreateAccessKeyResponse -> ShowS
Prelude.Show, forall x. Rep CreateAccessKeyResponse x -> CreateAccessKeyResponse
forall x. CreateAccessKeyResponse -> Rep CreateAccessKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAccessKeyResponse x -> CreateAccessKeyResponse
$cfrom :: forall x. CreateAccessKeyResponse -> Rep CreateAccessKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccessKeyResponse' 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', 'createAccessKeyResponse_httpStatus' - The response's http status code.
--
-- 'accessKey', 'createAccessKeyResponse_accessKey' - A structure with details about the access key.
newCreateAccessKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'accessKey'
  AccessKeyInfo ->
  CreateAccessKeyResponse
newCreateAccessKeyResponse :: Int -> AccessKeyInfo -> CreateAccessKeyResponse
newCreateAccessKeyResponse Int
pHttpStatus_ AccessKeyInfo
pAccessKey_ =
  CreateAccessKeyResponse'
    { $sel:httpStatus:CreateAccessKeyResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:accessKey:CreateAccessKeyResponse' :: AccessKeyInfo
accessKey = AccessKeyInfo
pAccessKey_
    }

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

-- | A structure with details about the access key.
createAccessKeyResponse_accessKey :: Lens.Lens' CreateAccessKeyResponse AccessKeyInfo
createAccessKeyResponse_accessKey :: Lens' CreateAccessKeyResponse AccessKeyInfo
createAccessKeyResponse_accessKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccessKeyResponse' {AccessKeyInfo
accessKey :: AccessKeyInfo
$sel:accessKey:CreateAccessKeyResponse' :: CreateAccessKeyResponse -> AccessKeyInfo
accessKey} -> AccessKeyInfo
accessKey) (\s :: CreateAccessKeyResponse
s@CreateAccessKeyResponse' {} AccessKeyInfo
a -> CreateAccessKeyResponse
s {$sel:accessKey:CreateAccessKeyResponse' :: AccessKeyInfo
accessKey = AccessKeyInfo
a} :: CreateAccessKeyResponse)

instance Prelude.NFData CreateAccessKeyResponse where
  rnf :: CreateAccessKeyResponse -> ()
rnf CreateAccessKeyResponse' {Int
AccessKeyInfo
accessKey :: AccessKeyInfo
httpStatus :: Int
$sel:accessKey:CreateAccessKeyResponse' :: CreateAccessKeyResponse -> AccessKeyInfo
$sel:httpStatus:CreateAccessKeyResponse' :: CreateAccessKeyResponse -> 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 AccessKeyInfo
accessKey