{-# 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.CreateServiceSpecificCredential
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates a set of credentials consisting of a user name and password
-- that can be used to access the service specified in the request. These
-- credentials are generated by IAM, and can be used only for the specified
-- service.
--
-- You can have a maximum of two sets of service-specific credentials for
-- each supported service per user.
--
-- You can create service-specific credentials for CodeCommit and Amazon
-- Keyspaces (for Apache Cassandra).
--
-- You can reset the password to a new service-generated value by calling
-- ResetServiceSpecificCredential.
--
-- For more information about service-specific credentials, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_ssh-keys.html Using IAM with CodeCommit: Git credentials, SSH keys, and Amazon Web Services access keys>
-- in the /IAM User Guide/.
module Amazonka.IAM.CreateServiceSpecificCredential
  ( -- * Creating a Request
    CreateServiceSpecificCredential (..),
    newCreateServiceSpecificCredential,

    -- * Request Lenses
    createServiceSpecificCredential_userName,
    createServiceSpecificCredential_serviceName,

    -- * Destructuring the Response
    CreateServiceSpecificCredentialResponse (..),
    newCreateServiceSpecificCredentialResponse,

    -- * Response Lenses
    createServiceSpecificCredentialResponse_serviceSpecificCredential,
    createServiceSpecificCredentialResponse_httpStatus,
  )
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:/ 'newCreateServiceSpecificCredential' smart constructor.
data CreateServiceSpecificCredential = CreateServiceSpecificCredential'
  { -- | The name of the IAM user that is to be associated with the credentials.
    -- The new service-specific credentials have the same permissions as the
    -- associated user except that they can be used only to access the
    -- specified service.
    --
    -- 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: _+=,.\@-
    CreateServiceSpecificCredential -> Text
userName :: Prelude.Text,
    -- | The name of the Amazon Web Services service that is to be associated
    -- with the credentials. The service you specify here is the only service
    -- that can be accessed using these credentials.
    CreateServiceSpecificCredential -> Text
serviceName :: Prelude.Text
  }
  deriving (CreateServiceSpecificCredential
-> CreateServiceSpecificCredential -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateServiceSpecificCredential
-> CreateServiceSpecificCredential -> Bool
$c/= :: CreateServiceSpecificCredential
-> CreateServiceSpecificCredential -> Bool
== :: CreateServiceSpecificCredential
-> CreateServiceSpecificCredential -> Bool
$c== :: CreateServiceSpecificCredential
-> CreateServiceSpecificCredential -> Bool
Prelude.Eq, ReadPrec [CreateServiceSpecificCredential]
ReadPrec CreateServiceSpecificCredential
Int -> ReadS CreateServiceSpecificCredential
ReadS [CreateServiceSpecificCredential]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateServiceSpecificCredential]
$creadListPrec :: ReadPrec [CreateServiceSpecificCredential]
readPrec :: ReadPrec CreateServiceSpecificCredential
$creadPrec :: ReadPrec CreateServiceSpecificCredential
readList :: ReadS [CreateServiceSpecificCredential]
$creadList :: ReadS [CreateServiceSpecificCredential]
readsPrec :: Int -> ReadS CreateServiceSpecificCredential
$creadsPrec :: Int -> ReadS CreateServiceSpecificCredential
Prelude.Read, Int -> CreateServiceSpecificCredential -> ShowS
[CreateServiceSpecificCredential] -> ShowS
CreateServiceSpecificCredential -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateServiceSpecificCredential] -> ShowS
$cshowList :: [CreateServiceSpecificCredential] -> ShowS
show :: CreateServiceSpecificCredential -> String
$cshow :: CreateServiceSpecificCredential -> String
showsPrec :: Int -> CreateServiceSpecificCredential -> ShowS
$cshowsPrec :: Int -> CreateServiceSpecificCredential -> ShowS
Prelude.Show, forall x.
Rep CreateServiceSpecificCredential x
-> CreateServiceSpecificCredential
forall x.
CreateServiceSpecificCredential
-> Rep CreateServiceSpecificCredential x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateServiceSpecificCredential x
-> CreateServiceSpecificCredential
$cfrom :: forall x.
CreateServiceSpecificCredential
-> Rep CreateServiceSpecificCredential x
Prelude.Generic)

-- |
-- Create a value of 'CreateServiceSpecificCredential' 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', 'createServiceSpecificCredential_userName' - The name of the IAM user that is to be associated with the credentials.
-- The new service-specific credentials have the same permissions as the
-- associated user except that they can be used only to access the
-- specified service.
--
-- 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: _+=,.\@-
--
-- 'serviceName', 'createServiceSpecificCredential_serviceName' - The name of the Amazon Web Services service that is to be associated
-- with the credentials. The service you specify here is the only service
-- that can be accessed using these credentials.
newCreateServiceSpecificCredential ::
  -- | 'userName'
  Prelude.Text ->
  -- | 'serviceName'
  Prelude.Text ->
  CreateServiceSpecificCredential
newCreateServiceSpecificCredential :: Text -> Text -> CreateServiceSpecificCredential
newCreateServiceSpecificCredential
  Text
pUserName_
  Text
pServiceName_ =
    CreateServiceSpecificCredential'
      { $sel:userName:CreateServiceSpecificCredential' :: Text
userName =
          Text
pUserName_,
        $sel:serviceName:CreateServiceSpecificCredential' :: Text
serviceName = Text
pServiceName_
      }

-- | The name of the IAM user that is to be associated with the credentials.
-- The new service-specific credentials have the same permissions as the
-- associated user except that they can be used only to access the
-- specified service.
--
-- 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: _+=,.\@-
createServiceSpecificCredential_userName :: Lens.Lens' CreateServiceSpecificCredential Prelude.Text
createServiceSpecificCredential_userName :: Lens' CreateServiceSpecificCredential Text
createServiceSpecificCredential_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceSpecificCredential' {Text
userName :: Text
$sel:userName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
userName} -> Text
userName) (\s :: CreateServiceSpecificCredential
s@CreateServiceSpecificCredential' {} Text
a -> CreateServiceSpecificCredential
s {$sel:userName:CreateServiceSpecificCredential' :: Text
userName = Text
a} :: CreateServiceSpecificCredential)

-- | The name of the Amazon Web Services service that is to be associated
-- with the credentials. The service you specify here is the only service
-- that can be accessed using these credentials.
createServiceSpecificCredential_serviceName :: Lens.Lens' CreateServiceSpecificCredential Prelude.Text
createServiceSpecificCredential_serviceName :: Lens' CreateServiceSpecificCredential Text
createServiceSpecificCredential_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceSpecificCredential' {Text
serviceName :: Text
$sel:serviceName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
serviceName} -> Text
serviceName) (\s :: CreateServiceSpecificCredential
s@CreateServiceSpecificCredential' {} Text
a -> CreateServiceSpecificCredential
s {$sel:serviceName:CreateServiceSpecificCredential' :: Text
serviceName = Text
a} :: CreateServiceSpecificCredential)

instance
  Core.AWSRequest
    CreateServiceSpecificCredential
  where
  type
    AWSResponse CreateServiceSpecificCredential =
      CreateServiceSpecificCredentialResponse
  request :: (Service -> Service)
-> CreateServiceSpecificCredential
-> Request CreateServiceSpecificCredential
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 CreateServiceSpecificCredential
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateServiceSpecificCredential)))
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
"CreateServiceSpecificCredentialResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ServiceSpecificCredential
-> Int -> CreateServiceSpecificCredentialResponse
CreateServiceSpecificCredentialResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ServiceSpecificCredential")
            forall (f :: * -> *) a b. Applicative f => 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
    CreateServiceSpecificCredential
  where
  hashWithSalt :: Int -> CreateServiceSpecificCredential -> Int
hashWithSalt
    Int
_salt
    CreateServiceSpecificCredential' {Text
serviceName :: Text
userName :: Text
$sel:serviceName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
$sel:userName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceName

instance
  Prelude.NFData
    CreateServiceSpecificCredential
  where
  rnf :: CreateServiceSpecificCredential -> ()
rnf CreateServiceSpecificCredential' {Text
serviceName :: Text
userName :: Text
$sel:serviceName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
$sel:userName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
..} =
    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 Text
serviceName

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

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

instance Data.ToQuery CreateServiceSpecificCredential where
  toQuery :: CreateServiceSpecificCredential -> QueryString
toQuery CreateServiceSpecificCredential' {Text
serviceName :: Text
userName :: Text
$sel:serviceName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
$sel:userName:CreateServiceSpecificCredential' :: CreateServiceSpecificCredential -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateServiceSpecificCredential" ::
                      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.=: Text
userName,
        ByteString
"ServiceName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serviceName
      ]

-- | /See:/ 'newCreateServiceSpecificCredentialResponse' smart constructor.
data CreateServiceSpecificCredentialResponse = CreateServiceSpecificCredentialResponse'
  { -- | A structure that contains information about the newly created
    -- service-specific credential.
    --
    -- This is the only time that the password for this credential set is
    -- available. It cannot be recovered later. Instead, you must reset the
    -- password with ResetServiceSpecificCredential.
    CreateServiceSpecificCredentialResponse
-> Maybe ServiceSpecificCredential
serviceSpecificCredential :: Prelude.Maybe ServiceSpecificCredential,
    -- | The response's http status code.
    CreateServiceSpecificCredentialResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateServiceSpecificCredentialResponse
-> CreateServiceSpecificCredentialResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateServiceSpecificCredentialResponse
-> CreateServiceSpecificCredentialResponse -> Bool
$c/= :: CreateServiceSpecificCredentialResponse
-> CreateServiceSpecificCredentialResponse -> Bool
== :: CreateServiceSpecificCredentialResponse
-> CreateServiceSpecificCredentialResponse -> Bool
$c== :: CreateServiceSpecificCredentialResponse
-> CreateServiceSpecificCredentialResponse -> Bool
Prelude.Eq, Int -> CreateServiceSpecificCredentialResponse -> ShowS
[CreateServiceSpecificCredentialResponse] -> ShowS
CreateServiceSpecificCredentialResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateServiceSpecificCredentialResponse] -> ShowS
$cshowList :: [CreateServiceSpecificCredentialResponse] -> ShowS
show :: CreateServiceSpecificCredentialResponse -> String
$cshow :: CreateServiceSpecificCredentialResponse -> String
showsPrec :: Int -> CreateServiceSpecificCredentialResponse -> ShowS
$cshowsPrec :: Int -> CreateServiceSpecificCredentialResponse -> ShowS
Prelude.Show, forall x.
Rep CreateServiceSpecificCredentialResponse x
-> CreateServiceSpecificCredentialResponse
forall x.
CreateServiceSpecificCredentialResponse
-> Rep CreateServiceSpecificCredentialResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateServiceSpecificCredentialResponse x
-> CreateServiceSpecificCredentialResponse
$cfrom :: forall x.
CreateServiceSpecificCredentialResponse
-> Rep CreateServiceSpecificCredentialResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateServiceSpecificCredentialResponse' 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:
--
-- 'serviceSpecificCredential', 'createServiceSpecificCredentialResponse_serviceSpecificCredential' - A structure that contains information about the newly created
-- service-specific credential.
--
-- This is the only time that the password for this credential set is
-- available. It cannot be recovered later. Instead, you must reset the
-- password with ResetServiceSpecificCredential.
--
-- 'httpStatus', 'createServiceSpecificCredentialResponse_httpStatus' - The response's http status code.
newCreateServiceSpecificCredentialResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateServiceSpecificCredentialResponse
newCreateServiceSpecificCredentialResponse :: Int -> CreateServiceSpecificCredentialResponse
newCreateServiceSpecificCredentialResponse
  Int
pHttpStatus_ =
    CreateServiceSpecificCredentialResponse'
      { $sel:serviceSpecificCredential:CreateServiceSpecificCredentialResponse' :: Maybe ServiceSpecificCredential
serviceSpecificCredential =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateServiceSpecificCredentialResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A structure that contains information about the newly created
-- service-specific credential.
--
-- This is the only time that the password for this credential set is
-- available. It cannot be recovered later. Instead, you must reset the
-- password with ResetServiceSpecificCredential.
createServiceSpecificCredentialResponse_serviceSpecificCredential :: Lens.Lens' CreateServiceSpecificCredentialResponse (Prelude.Maybe ServiceSpecificCredential)
createServiceSpecificCredentialResponse_serviceSpecificCredential :: Lens'
  CreateServiceSpecificCredentialResponse
  (Maybe ServiceSpecificCredential)
createServiceSpecificCredentialResponse_serviceSpecificCredential = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceSpecificCredentialResponse' {Maybe ServiceSpecificCredential
serviceSpecificCredential :: Maybe ServiceSpecificCredential
$sel:serviceSpecificCredential:CreateServiceSpecificCredentialResponse' :: CreateServiceSpecificCredentialResponse
-> Maybe ServiceSpecificCredential
serviceSpecificCredential} -> Maybe ServiceSpecificCredential
serviceSpecificCredential) (\s :: CreateServiceSpecificCredentialResponse
s@CreateServiceSpecificCredentialResponse' {} Maybe ServiceSpecificCredential
a -> CreateServiceSpecificCredentialResponse
s {$sel:serviceSpecificCredential:CreateServiceSpecificCredentialResponse' :: Maybe ServiceSpecificCredential
serviceSpecificCredential = Maybe ServiceSpecificCredential
a} :: CreateServiceSpecificCredentialResponse)

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

instance
  Prelude.NFData
    CreateServiceSpecificCredentialResponse
  where
  rnf :: CreateServiceSpecificCredentialResponse -> ()
rnf CreateServiceSpecificCredentialResponse' {Int
Maybe ServiceSpecificCredential
httpStatus :: Int
serviceSpecificCredential :: Maybe ServiceSpecificCredential
$sel:httpStatus:CreateServiceSpecificCredentialResponse' :: CreateServiceSpecificCredentialResponse -> Int
$sel:serviceSpecificCredential:CreateServiceSpecificCredentialResponse' :: CreateServiceSpecificCredentialResponse
-> Maybe ServiceSpecificCredential
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceSpecificCredential
serviceSpecificCredential
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus