{-# 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.EC2.CreateKeyPair
-- 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 an ED25519 or 2048-bit RSA key pair with the specified name and
-- in the specified PEM or PPK format. Amazon EC2 stores the public key and
-- displays the private key for you to save to a file. The private key is
-- returned as an unencrypted PEM encoded PKCS#1 private key or an
-- unencrypted PPK formatted private key for use with PuTTY. If a key with
-- the specified name already exists, Amazon EC2 returns an error.
--
-- The key pair returned to you is available only in the Amazon Web
-- Services Region in which you create it. If you prefer, you can create
-- your own key pair using a third-party tool and upload it to any Region
-- using ImportKeyPair.
--
-- You can have up to 5,000 key pairs per Amazon Web Services Region.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-key-pairs.html Amazon EC2 key pairs>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.CreateKeyPair
  ( -- * Creating a Request
    CreateKeyPair (..),
    newCreateKeyPair,

    -- * Request Lenses
    createKeyPair_dryRun,
    createKeyPair_keyFormat,
    createKeyPair_keyType,
    createKeyPair_tagSpecifications,
    createKeyPair_keyName,

    -- * Destructuring the Response
    CreateKeyPairResponse (..),
    newCreateKeyPairResponse,

    -- * Response Lenses
    createKeyPairResponse_keyPairId,
    createKeyPairResponse_tags,
    createKeyPairResponse_httpStatus,
    createKeyPairResponse_keyName,
    createKeyPairResponse_keyFingerprint,
    createKeyPairResponse_keyMaterial,
  )
where

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

-- | /See:/ 'newCreateKeyPair' smart constructor.
data CreateKeyPair = CreateKeyPair'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateKeyPair -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The format of the key pair.
    --
    -- Default: @pem@
    CreateKeyPair -> Maybe KeyFormat
keyFormat :: Prelude.Maybe KeyFormat,
    -- | The type of key pair. Note that ED25519 keys are not supported for
    -- Windows instances.
    --
    -- Default: @rsa@
    CreateKeyPair -> Maybe KeyType
keyType :: Prelude.Maybe KeyType,
    -- | The tags to apply to the new key pair.
    CreateKeyPair -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | A unique name for the key pair.
    --
    -- Constraints: Up to 255 ASCII characters
    CreateKeyPair -> Text
keyName :: Prelude.Text
  }
  deriving (CreateKeyPair -> CreateKeyPair -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKeyPair -> CreateKeyPair -> Bool
$c/= :: CreateKeyPair -> CreateKeyPair -> Bool
== :: CreateKeyPair -> CreateKeyPair -> Bool
$c== :: CreateKeyPair -> CreateKeyPair -> Bool
Prelude.Eq, ReadPrec [CreateKeyPair]
ReadPrec CreateKeyPair
Int -> ReadS CreateKeyPair
ReadS [CreateKeyPair]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateKeyPair]
$creadListPrec :: ReadPrec [CreateKeyPair]
readPrec :: ReadPrec CreateKeyPair
$creadPrec :: ReadPrec CreateKeyPair
readList :: ReadS [CreateKeyPair]
$creadList :: ReadS [CreateKeyPair]
readsPrec :: Int -> ReadS CreateKeyPair
$creadsPrec :: Int -> ReadS CreateKeyPair
Prelude.Read, Int -> CreateKeyPair -> ShowS
[CreateKeyPair] -> ShowS
CreateKeyPair -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKeyPair] -> ShowS
$cshowList :: [CreateKeyPair] -> ShowS
show :: CreateKeyPair -> String
$cshow :: CreateKeyPair -> String
showsPrec :: Int -> CreateKeyPair -> ShowS
$cshowsPrec :: Int -> CreateKeyPair -> ShowS
Prelude.Show, forall x. Rep CreateKeyPair x -> CreateKeyPair
forall x. CreateKeyPair -> Rep CreateKeyPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateKeyPair x -> CreateKeyPair
$cfrom :: forall x. CreateKeyPair -> Rep CreateKeyPair x
Prelude.Generic)

-- |
-- Create a value of 'CreateKeyPair' 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:
--
-- 'dryRun', 'createKeyPair_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'keyFormat', 'createKeyPair_keyFormat' - The format of the key pair.
--
-- Default: @pem@
--
-- 'keyType', 'createKeyPair_keyType' - The type of key pair. Note that ED25519 keys are not supported for
-- Windows instances.
--
-- Default: @rsa@
--
-- 'tagSpecifications', 'createKeyPair_tagSpecifications' - The tags to apply to the new key pair.
--
-- 'keyName', 'createKeyPair_keyName' - A unique name for the key pair.
--
-- Constraints: Up to 255 ASCII characters
newCreateKeyPair ::
  -- | 'keyName'
  Prelude.Text ->
  CreateKeyPair
newCreateKeyPair :: Text -> CreateKeyPair
newCreateKeyPair Text
pKeyName_ =
  CreateKeyPair'
    { $sel:dryRun:CreateKeyPair' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:keyFormat:CreateKeyPair' :: Maybe KeyFormat
keyFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:keyType:CreateKeyPair' :: Maybe KeyType
keyType = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateKeyPair' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:keyName:CreateKeyPair' :: Text
keyName = Text
pKeyName_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createKeyPair_dryRun :: Lens.Lens' CreateKeyPair (Prelude.Maybe Prelude.Bool)
createKeyPair_dryRun :: Lens' CreateKeyPair (Maybe Bool)
createKeyPair_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPair' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateKeyPair' :: CreateKeyPair -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateKeyPair
s@CreateKeyPair' {} Maybe Bool
a -> CreateKeyPair
s {$sel:dryRun:CreateKeyPair' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateKeyPair)

-- | The format of the key pair.
--
-- Default: @pem@
createKeyPair_keyFormat :: Lens.Lens' CreateKeyPair (Prelude.Maybe KeyFormat)
createKeyPair_keyFormat :: Lens' CreateKeyPair (Maybe KeyFormat)
createKeyPair_keyFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPair' {Maybe KeyFormat
keyFormat :: Maybe KeyFormat
$sel:keyFormat:CreateKeyPair' :: CreateKeyPair -> Maybe KeyFormat
keyFormat} -> Maybe KeyFormat
keyFormat) (\s :: CreateKeyPair
s@CreateKeyPair' {} Maybe KeyFormat
a -> CreateKeyPair
s {$sel:keyFormat:CreateKeyPair' :: Maybe KeyFormat
keyFormat = Maybe KeyFormat
a} :: CreateKeyPair)

-- | The type of key pair. Note that ED25519 keys are not supported for
-- Windows instances.
--
-- Default: @rsa@
createKeyPair_keyType :: Lens.Lens' CreateKeyPair (Prelude.Maybe KeyType)
createKeyPair_keyType :: Lens' CreateKeyPair (Maybe KeyType)
createKeyPair_keyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPair' {Maybe KeyType
keyType :: Maybe KeyType
$sel:keyType:CreateKeyPair' :: CreateKeyPair -> Maybe KeyType
keyType} -> Maybe KeyType
keyType) (\s :: CreateKeyPair
s@CreateKeyPair' {} Maybe KeyType
a -> CreateKeyPair
s {$sel:keyType:CreateKeyPair' :: Maybe KeyType
keyType = Maybe KeyType
a} :: CreateKeyPair)

-- | The tags to apply to the new key pair.
createKeyPair_tagSpecifications :: Lens.Lens' CreateKeyPair (Prelude.Maybe [TagSpecification])
createKeyPair_tagSpecifications :: Lens' CreateKeyPair (Maybe [TagSpecification])
createKeyPair_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPair' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateKeyPair' :: CreateKeyPair -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateKeyPair
s@CreateKeyPair' {} Maybe [TagSpecification]
a -> CreateKeyPair
s {$sel:tagSpecifications:CreateKeyPair' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateKeyPair) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A unique name for the key pair.
--
-- Constraints: Up to 255 ASCII characters
createKeyPair_keyName :: Lens.Lens' CreateKeyPair Prelude.Text
createKeyPair_keyName :: Lens' CreateKeyPair Text
createKeyPair_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPair' {Text
keyName :: Text
$sel:keyName:CreateKeyPair' :: CreateKeyPair -> Text
keyName} -> Text
keyName) (\s :: CreateKeyPair
s@CreateKeyPair' {} Text
a -> CreateKeyPair
s {$sel:keyName:CreateKeyPair' :: Text
keyName = Text
a} :: CreateKeyPair)

instance Core.AWSRequest CreateKeyPair where
  type
    AWSResponse CreateKeyPair =
      CreateKeyPairResponse
  request :: (Service -> Service) -> CreateKeyPair -> Request CreateKeyPair
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 CreateKeyPair
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateKeyPair)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [Tag]
-> Int
-> Text
-> Text
-> Sensitive Text
-> CreateKeyPairResponse
CreateKeyPairResponse'
            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
"keyPairId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"tagSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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))
            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
"keyName")
            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
"keyFingerprint")
            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
"keyMaterial")
      )

instance Prelude.Hashable CreateKeyPair where
  hashWithSalt :: Int -> CreateKeyPair -> Int
hashWithSalt Int
_salt CreateKeyPair' {Maybe Bool
Maybe [TagSpecification]
Maybe KeyFormat
Maybe KeyType
Text
keyName :: Text
tagSpecifications :: Maybe [TagSpecification]
keyType :: Maybe KeyType
keyFormat :: Maybe KeyFormat
dryRun :: Maybe Bool
$sel:keyName:CreateKeyPair' :: CreateKeyPair -> Text
$sel:tagSpecifications:CreateKeyPair' :: CreateKeyPair -> Maybe [TagSpecification]
$sel:keyType:CreateKeyPair' :: CreateKeyPair -> Maybe KeyType
$sel:keyFormat:CreateKeyPair' :: CreateKeyPair -> Maybe KeyFormat
$sel:dryRun:CreateKeyPair' :: CreateKeyPair -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KeyFormat
keyFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KeyType
keyType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyName

instance Prelude.NFData CreateKeyPair where
  rnf :: CreateKeyPair -> ()
rnf CreateKeyPair' {Maybe Bool
Maybe [TagSpecification]
Maybe KeyFormat
Maybe KeyType
Text
keyName :: Text
tagSpecifications :: Maybe [TagSpecification]
keyType :: Maybe KeyType
keyFormat :: Maybe KeyFormat
dryRun :: Maybe Bool
$sel:keyName:CreateKeyPair' :: CreateKeyPair -> Text
$sel:tagSpecifications:CreateKeyPair' :: CreateKeyPair -> Maybe [TagSpecification]
$sel:keyType:CreateKeyPair' :: CreateKeyPair -> Maybe KeyType
$sel:keyFormat:CreateKeyPair' :: CreateKeyPair -> Maybe KeyFormat
$sel:dryRun:CreateKeyPair' :: CreateKeyPair -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KeyFormat
keyFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KeyType
keyType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyName

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

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

instance Data.ToQuery CreateKeyPair where
  toQuery :: CreateKeyPair -> QueryString
toQuery CreateKeyPair' {Maybe Bool
Maybe [TagSpecification]
Maybe KeyFormat
Maybe KeyType
Text
keyName :: Text
tagSpecifications :: Maybe [TagSpecification]
keyType :: Maybe KeyType
keyFormat :: Maybe KeyFormat
dryRun :: Maybe Bool
$sel:keyName:CreateKeyPair' :: CreateKeyPair -> Text
$sel:tagSpecifications:CreateKeyPair' :: CreateKeyPair -> Maybe [TagSpecification]
$sel:keyType:CreateKeyPair' :: CreateKeyPair -> Maybe KeyType
$sel:keyFormat:CreateKeyPair' :: CreateKeyPair -> Maybe KeyFormat
$sel:dryRun:CreateKeyPair' :: CreateKeyPair -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateKeyPair" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"KeyFormat" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe KeyFormat
keyFormat,
        ByteString
"KeyType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe KeyType
keyType,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"KeyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
keyName
      ]

-- | Describes a key pair.
--
-- /See:/ 'newCreateKeyPairResponse' smart constructor.
data CreateKeyPairResponse = CreateKeyPairResponse'
  { -- | The ID of the key pair.
    CreateKeyPairResponse -> Maybe Text
keyPairId :: Prelude.Maybe Prelude.Text,
    -- | Any tags applied to the key pair.
    CreateKeyPairResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    CreateKeyPairResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the key pair.
    CreateKeyPairResponse -> Text
keyName :: Prelude.Text,
    -- | -   For RSA key pairs, the key fingerprint is the SHA-1 digest of the
    --     DER encoded private key.
    --
    -- -   For ED25519 key pairs, the key fingerprint is the base64-encoded
    --     SHA-256 digest, which is the default for OpenSSH, starting with
    --     OpenSSH 6.8.
    CreateKeyPairResponse -> Text
keyFingerprint :: Prelude.Text,
    -- | An unencrypted PEM encoded RSA or ED25519 private key.
    CreateKeyPairResponse -> Sensitive Text
keyMaterial :: Data.Sensitive Prelude.Text
  }
  deriving (CreateKeyPairResponse -> CreateKeyPairResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKeyPairResponse -> CreateKeyPairResponse -> Bool
$c/= :: CreateKeyPairResponse -> CreateKeyPairResponse -> Bool
== :: CreateKeyPairResponse -> CreateKeyPairResponse -> Bool
$c== :: CreateKeyPairResponse -> CreateKeyPairResponse -> Bool
Prelude.Eq, Int -> CreateKeyPairResponse -> ShowS
[CreateKeyPairResponse] -> ShowS
CreateKeyPairResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKeyPairResponse] -> ShowS
$cshowList :: [CreateKeyPairResponse] -> ShowS
show :: CreateKeyPairResponse -> String
$cshow :: CreateKeyPairResponse -> String
showsPrec :: Int -> CreateKeyPairResponse -> ShowS
$cshowsPrec :: Int -> CreateKeyPairResponse -> ShowS
Prelude.Show, forall x. Rep CreateKeyPairResponse x -> CreateKeyPairResponse
forall x. CreateKeyPairResponse -> Rep CreateKeyPairResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateKeyPairResponse x -> CreateKeyPairResponse
$cfrom :: forall x. CreateKeyPairResponse -> Rep CreateKeyPairResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateKeyPairResponse' 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:
--
-- 'keyPairId', 'createKeyPairResponse_keyPairId' - The ID of the key pair.
--
-- 'tags', 'createKeyPairResponse_tags' - Any tags applied to the key pair.
--
-- 'httpStatus', 'createKeyPairResponse_httpStatus' - The response's http status code.
--
-- 'keyName', 'createKeyPairResponse_keyName' - The name of the key pair.
--
-- 'keyFingerprint', 'createKeyPairResponse_keyFingerprint' - -   For RSA key pairs, the key fingerprint is the SHA-1 digest of the
--     DER encoded private key.
--
-- -   For ED25519 key pairs, the key fingerprint is the base64-encoded
--     SHA-256 digest, which is the default for OpenSSH, starting with
--     OpenSSH 6.8.
--
-- 'keyMaterial', 'createKeyPairResponse_keyMaterial' - An unencrypted PEM encoded RSA or ED25519 private key.
newCreateKeyPairResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'keyName'
  Prelude.Text ->
  -- | 'keyFingerprint'
  Prelude.Text ->
  -- | 'keyMaterial'
  Prelude.Text ->
  CreateKeyPairResponse
newCreateKeyPairResponse :: Int -> Text -> Text -> Text -> CreateKeyPairResponse
newCreateKeyPairResponse
  Int
pHttpStatus_
  Text
pKeyName_
  Text
pKeyFingerprint_
  Text
pKeyMaterial_ =
    CreateKeyPairResponse'
      { $sel:keyPairId:CreateKeyPairResponse' :: Maybe Text
keyPairId = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateKeyPairResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateKeyPairResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:keyName:CreateKeyPairResponse' :: Text
keyName = Text
pKeyName_,
        $sel:keyFingerprint:CreateKeyPairResponse' :: Text
keyFingerprint = Text
pKeyFingerprint_,
        $sel:keyMaterial:CreateKeyPairResponse' :: Sensitive Text
keyMaterial = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pKeyMaterial_
      }

-- | The ID of the key pair.
createKeyPairResponse_keyPairId :: Lens.Lens' CreateKeyPairResponse (Prelude.Maybe Prelude.Text)
createKeyPairResponse_keyPairId :: Lens' CreateKeyPairResponse (Maybe Text)
createKeyPairResponse_keyPairId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Maybe Text
keyPairId :: Maybe Text
$sel:keyPairId:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Text
keyPairId} -> Maybe Text
keyPairId) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Maybe Text
a -> CreateKeyPairResponse
s {$sel:keyPairId:CreateKeyPairResponse' :: Maybe Text
keyPairId = Maybe Text
a} :: CreateKeyPairResponse)

-- | Any tags applied to the key pair.
createKeyPairResponse_tags :: Lens.Lens' CreateKeyPairResponse (Prelude.Maybe [Tag])
createKeyPairResponse_tags :: Lens' CreateKeyPairResponse (Maybe [Tag])
createKeyPairResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Maybe [Tag]
a -> CreateKeyPairResponse
s {$sel:tags:CreateKeyPairResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateKeyPairResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | The name of the key pair.
createKeyPairResponse_keyName :: Lens.Lens' CreateKeyPairResponse Prelude.Text
createKeyPairResponse_keyName :: Lens' CreateKeyPairResponse Text
createKeyPairResponse_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Text
keyName :: Text
$sel:keyName:CreateKeyPairResponse' :: CreateKeyPairResponse -> Text
keyName} -> Text
keyName) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Text
a -> CreateKeyPairResponse
s {$sel:keyName:CreateKeyPairResponse' :: Text
keyName = Text
a} :: CreateKeyPairResponse)

-- | -   For RSA key pairs, the key fingerprint is the SHA-1 digest of the
--     DER encoded private key.
--
-- -   For ED25519 key pairs, the key fingerprint is the base64-encoded
--     SHA-256 digest, which is the default for OpenSSH, starting with
--     OpenSSH 6.8.
createKeyPairResponse_keyFingerprint :: Lens.Lens' CreateKeyPairResponse Prelude.Text
createKeyPairResponse_keyFingerprint :: Lens' CreateKeyPairResponse Text
createKeyPairResponse_keyFingerprint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Text
keyFingerprint :: Text
$sel:keyFingerprint:CreateKeyPairResponse' :: CreateKeyPairResponse -> Text
keyFingerprint} -> Text
keyFingerprint) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Text
a -> CreateKeyPairResponse
s {$sel:keyFingerprint:CreateKeyPairResponse' :: Text
keyFingerprint = Text
a} :: CreateKeyPairResponse)

-- | An unencrypted PEM encoded RSA or ED25519 private key.
createKeyPairResponse_keyMaterial :: Lens.Lens' CreateKeyPairResponse Prelude.Text
createKeyPairResponse_keyMaterial :: Lens' CreateKeyPairResponse Text
createKeyPairResponse_keyMaterial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Sensitive Text
keyMaterial :: Sensitive Text
$sel:keyMaterial:CreateKeyPairResponse' :: CreateKeyPairResponse -> Sensitive Text
keyMaterial} -> Sensitive Text
keyMaterial) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Sensitive Text
a -> CreateKeyPairResponse
s {$sel:keyMaterial:CreateKeyPairResponse' :: Sensitive Text
keyMaterial = Sensitive Text
a} :: CreateKeyPairResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Prelude.NFData CreateKeyPairResponse where
  rnf :: CreateKeyPairResponse -> ()
rnf CreateKeyPairResponse' {Int
Maybe [Tag]
Maybe Text
Text
Sensitive Text
keyMaterial :: Sensitive Text
keyFingerprint :: Text
keyName :: Text
httpStatus :: Int
tags :: Maybe [Tag]
keyPairId :: Maybe Text
$sel:keyMaterial:CreateKeyPairResponse' :: CreateKeyPairResponse -> Sensitive Text
$sel:keyFingerprint:CreateKeyPairResponse' :: CreateKeyPairResponse -> Text
$sel:keyName:CreateKeyPairResponse' :: CreateKeyPairResponse -> Text
$sel:httpStatus:CreateKeyPairResponse' :: CreateKeyPairResponse -> Int
$sel:tags:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe [Tag]
$sel:keyPairId:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyPairId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
keyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyFingerprint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
keyMaterial