{-# 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.ImportKeyPair
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports the public key from an RSA or ED25519 key pair that you created
-- with a third-party tool. Compare this with CreateKeyPair, in which
-- Amazon Web Services creates the key pair and gives the keys to you
-- (Amazon Web Services keeps a copy of the public key). With
-- ImportKeyPair, you create the key pair and give Amazon Web Services just
-- the public key. The private key is never transferred between you and
-- Amazon Web Services.
--
-- For more information about key pairs, 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.ImportKeyPair
  ( -- * Creating a Request
    ImportKeyPair (..),
    newImportKeyPair,

    -- * Request Lenses
    importKeyPair_dryRun,
    importKeyPair_tagSpecifications,
    importKeyPair_keyName,
    importKeyPair_publicKeyMaterial,

    -- * Destructuring the Response
    ImportKeyPairResponse (..),
    newImportKeyPairResponse,

    -- * Response Lenses
    importKeyPairResponse_keyFingerprint,
    importKeyPairResponse_keyName,
    importKeyPairResponse_keyPairId,
    importKeyPairResponse_tags,
    importKeyPairResponse_httpStatus,
  )
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:/ 'newImportKeyPair' smart constructor.
data ImportKeyPair = ImportKeyPair'
  { -- | 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@.
    ImportKeyPair -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The tags to apply to the imported key pair.
    ImportKeyPair -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | A unique name for the key pair.
    ImportKeyPair -> Text
keyName :: Prelude.Text,
    -- | The public key. For API calls, the text must be base64-encoded. For
    -- command line tools, base64 encoding is performed for you.
    ImportKeyPair -> Base64
publicKeyMaterial :: Data.Base64
  }
  deriving (ImportKeyPair -> ImportKeyPair -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportKeyPair -> ImportKeyPair -> Bool
$c/= :: ImportKeyPair -> ImportKeyPair -> Bool
== :: ImportKeyPair -> ImportKeyPair -> Bool
$c== :: ImportKeyPair -> ImportKeyPair -> Bool
Prelude.Eq, ReadPrec [ImportKeyPair]
ReadPrec ImportKeyPair
Int -> ReadS ImportKeyPair
ReadS [ImportKeyPair]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportKeyPair]
$creadListPrec :: ReadPrec [ImportKeyPair]
readPrec :: ReadPrec ImportKeyPair
$creadPrec :: ReadPrec ImportKeyPair
readList :: ReadS [ImportKeyPair]
$creadList :: ReadS [ImportKeyPair]
readsPrec :: Int -> ReadS ImportKeyPair
$creadsPrec :: Int -> ReadS ImportKeyPair
Prelude.Read, Int -> ImportKeyPair -> ShowS
[ImportKeyPair] -> ShowS
ImportKeyPair -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportKeyPair] -> ShowS
$cshowList :: [ImportKeyPair] -> ShowS
show :: ImportKeyPair -> String
$cshow :: ImportKeyPair -> String
showsPrec :: Int -> ImportKeyPair -> ShowS
$cshowsPrec :: Int -> ImportKeyPair -> ShowS
Prelude.Show, forall x. Rep ImportKeyPair x -> ImportKeyPair
forall x. ImportKeyPair -> Rep ImportKeyPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportKeyPair x -> ImportKeyPair
$cfrom :: forall x. ImportKeyPair -> Rep ImportKeyPair x
Prelude.Generic)

-- |
-- Create a value of 'ImportKeyPair' 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', 'importKeyPair_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@.
--
-- 'tagSpecifications', 'importKeyPair_tagSpecifications' - The tags to apply to the imported key pair.
--
-- 'keyName', 'importKeyPair_keyName' - A unique name for the key pair.
--
-- 'publicKeyMaterial', 'importKeyPair_publicKeyMaterial' - The public key. For API calls, the text must be base64-encoded. For
-- command line tools, base64 encoding is performed for you.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
newImportKeyPair ::
  -- | 'keyName'
  Prelude.Text ->
  -- | 'publicKeyMaterial'
  Prelude.ByteString ->
  ImportKeyPair
newImportKeyPair :: Text -> ByteString -> ImportKeyPair
newImportKeyPair Text
pKeyName_ ByteString
pPublicKeyMaterial_ =
  ImportKeyPair'
    { $sel:dryRun:ImportKeyPair' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:ImportKeyPair' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:keyName:ImportKeyPair' :: Text
keyName = Text
pKeyName_,
      $sel:publicKeyMaterial:ImportKeyPair' :: Base64
publicKeyMaterial =
        Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pPublicKeyMaterial_
    }

-- | 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@.
importKeyPair_dryRun :: Lens.Lens' ImportKeyPair (Prelude.Maybe Prelude.Bool)
importKeyPair_dryRun :: Lens' ImportKeyPair (Maybe Bool)
importKeyPair_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPair' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ImportKeyPair' :: ImportKeyPair -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ImportKeyPair
s@ImportKeyPair' {} Maybe Bool
a -> ImportKeyPair
s {$sel:dryRun:ImportKeyPair' :: Maybe Bool
dryRun = Maybe Bool
a} :: ImportKeyPair)

-- | The tags to apply to the imported key pair.
importKeyPair_tagSpecifications :: Lens.Lens' ImportKeyPair (Prelude.Maybe [TagSpecification])
importKeyPair_tagSpecifications :: Lens' ImportKeyPair (Maybe [TagSpecification])
importKeyPair_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPair' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:ImportKeyPair' :: ImportKeyPair -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: ImportKeyPair
s@ImportKeyPair' {} Maybe [TagSpecification]
a -> ImportKeyPair
s {$sel:tagSpecifications:ImportKeyPair' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: ImportKeyPair) 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.
importKeyPair_keyName :: Lens.Lens' ImportKeyPair Prelude.Text
importKeyPair_keyName :: Lens' ImportKeyPair Text
importKeyPair_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPair' {Text
keyName :: Text
$sel:keyName:ImportKeyPair' :: ImportKeyPair -> Text
keyName} -> Text
keyName) (\s :: ImportKeyPair
s@ImportKeyPair' {} Text
a -> ImportKeyPair
s {$sel:keyName:ImportKeyPair' :: Text
keyName = Text
a} :: ImportKeyPair)

-- | The public key. For API calls, the text must be base64-encoded. For
-- command line tools, base64 encoding is performed for you.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
importKeyPair_publicKeyMaterial :: Lens.Lens' ImportKeyPair Prelude.ByteString
importKeyPair_publicKeyMaterial :: Lens' ImportKeyPair ByteString
importKeyPair_publicKeyMaterial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPair' {Base64
publicKeyMaterial :: Base64
$sel:publicKeyMaterial:ImportKeyPair' :: ImportKeyPair -> Base64
publicKeyMaterial} -> Base64
publicKeyMaterial) (\s :: ImportKeyPair
s@ImportKeyPair' {} Base64
a -> ImportKeyPair
s {$sel:publicKeyMaterial:ImportKeyPair' :: Base64
publicKeyMaterial = Base64
a} :: ImportKeyPair) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

instance Core.AWSRequest ImportKeyPair where
  type
    AWSResponse ImportKeyPair =
      ImportKeyPairResponse
  request :: (Service -> Service) -> ImportKeyPair -> Request ImportKeyPair
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 ImportKeyPair
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportKeyPair)))
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 Text
-> Maybe Text
-> Maybe [Tag]
-> Int
-> ImportKeyPairResponse
ImportKeyPairResponse'
            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
"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 (Maybe 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 (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))
      )

instance Prelude.Hashable ImportKeyPair where
  hashWithSalt :: Int -> ImportKeyPair -> Int
hashWithSalt Int
_salt ImportKeyPair' {Maybe Bool
Maybe [TagSpecification]
Text
Base64
publicKeyMaterial :: Base64
keyName :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:publicKeyMaterial:ImportKeyPair' :: ImportKeyPair -> Base64
$sel:keyName:ImportKeyPair' :: ImportKeyPair -> Text
$sel:tagSpecifications:ImportKeyPair' :: ImportKeyPair -> Maybe [TagSpecification]
$sel:dryRun:ImportKeyPair' :: ImportKeyPair -> 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 [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
publicKeyMaterial

instance Prelude.NFData ImportKeyPair where
  rnf :: ImportKeyPair -> ()
rnf ImportKeyPair' {Maybe Bool
Maybe [TagSpecification]
Text
Base64
publicKeyMaterial :: Base64
keyName :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:publicKeyMaterial:ImportKeyPair' :: ImportKeyPair -> Base64
$sel:keyName:ImportKeyPair' :: ImportKeyPair -> Text
$sel:tagSpecifications:ImportKeyPair' :: ImportKeyPair -> Maybe [TagSpecification]
$sel:dryRun:ImportKeyPair' :: ImportKeyPair -> 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 [TagSpecification]
tagSpecifications
      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 Base64
publicKeyMaterial

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

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

instance Data.ToQuery ImportKeyPair where
  toQuery :: ImportKeyPair -> QueryString
toQuery ImportKeyPair' {Maybe Bool
Maybe [TagSpecification]
Text
Base64
publicKeyMaterial :: Base64
keyName :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:publicKeyMaterial:ImportKeyPair' :: ImportKeyPair -> Base64
$sel:keyName:ImportKeyPair' :: ImportKeyPair -> Text
$sel:tagSpecifications:ImportKeyPair' :: ImportKeyPair -> Maybe [TagSpecification]
$sel:dryRun:ImportKeyPair' :: ImportKeyPair -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ImportKeyPair" :: 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,
        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,
        ByteString
"PublicKeyMaterial" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Base64
publicKeyMaterial
      ]

-- | /See:/ 'newImportKeyPairResponse' smart constructor.
data ImportKeyPairResponse = ImportKeyPairResponse'
  { -- | -   For RSA key pairs, the key fingerprint is the MD5 public key
    --     fingerprint as specified in section 4 of RFC 4716.
    --
    -- -   For ED25519 key pairs, the key fingerprint is the base64-encoded
    --     SHA-256 digest, which is the default for OpenSSH, starting with
    --     <http://www.openssh.com/txt/release-6.8 OpenSSH 6.8>.
    ImportKeyPairResponse -> Maybe Text
keyFingerprint :: Prelude.Maybe Prelude.Text,
    -- | The key pair name that you provided.
    ImportKeyPairResponse -> Maybe Text
keyName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the resulting key pair.
    ImportKeyPairResponse -> Maybe Text
keyPairId :: Prelude.Maybe Prelude.Text,
    -- | The tags applied to the imported key pair.
    ImportKeyPairResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    ImportKeyPairResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportKeyPairResponse -> ImportKeyPairResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportKeyPairResponse -> ImportKeyPairResponse -> Bool
$c/= :: ImportKeyPairResponse -> ImportKeyPairResponse -> Bool
== :: ImportKeyPairResponse -> ImportKeyPairResponse -> Bool
$c== :: ImportKeyPairResponse -> ImportKeyPairResponse -> Bool
Prelude.Eq, ReadPrec [ImportKeyPairResponse]
ReadPrec ImportKeyPairResponse
Int -> ReadS ImportKeyPairResponse
ReadS [ImportKeyPairResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportKeyPairResponse]
$creadListPrec :: ReadPrec [ImportKeyPairResponse]
readPrec :: ReadPrec ImportKeyPairResponse
$creadPrec :: ReadPrec ImportKeyPairResponse
readList :: ReadS [ImportKeyPairResponse]
$creadList :: ReadS [ImportKeyPairResponse]
readsPrec :: Int -> ReadS ImportKeyPairResponse
$creadsPrec :: Int -> ReadS ImportKeyPairResponse
Prelude.Read, Int -> ImportKeyPairResponse -> ShowS
[ImportKeyPairResponse] -> ShowS
ImportKeyPairResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportKeyPairResponse] -> ShowS
$cshowList :: [ImportKeyPairResponse] -> ShowS
show :: ImportKeyPairResponse -> String
$cshow :: ImportKeyPairResponse -> String
showsPrec :: Int -> ImportKeyPairResponse -> ShowS
$cshowsPrec :: Int -> ImportKeyPairResponse -> ShowS
Prelude.Show, forall x. Rep ImportKeyPairResponse x -> ImportKeyPairResponse
forall x. ImportKeyPairResponse -> Rep ImportKeyPairResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportKeyPairResponse x -> ImportKeyPairResponse
$cfrom :: forall x. ImportKeyPairResponse -> Rep ImportKeyPairResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportKeyPairResponse' 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:
--
-- 'keyFingerprint', 'importKeyPairResponse_keyFingerprint' - -   For RSA key pairs, the key fingerprint is the MD5 public key
--     fingerprint as specified in section 4 of RFC 4716.
--
-- -   For ED25519 key pairs, the key fingerprint is the base64-encoded
--     SHA-256 digest, which is the default for OpenSSH, starting with
--     <http://www.openssh.com/txt/release-6.8 OpenSSH 6.8>.
--
-- 'keyName', 'importKeyPairResponse_keyName' - The key pair name that you provided.
--
-- 'keyPairId', 'importKeyPairResponse_keyPairId' - The ID of the resulting key pair.
--
-- 'tags', 'importKeyPairResponse_tags' - The tags applied to the imported key pair.
--
-- 'httpStatus', 'importKeyPairResponse_httpStatus' - The response's http status code.
newImportKeyPairResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportKeyPairResponse
newImportKeyPairResponse :: Int -> ImportKeyPairResponse
newImportKeyPairResponse Int
pHttpStatus_ =
  ImportKeyPairResponse'
    { $sel:keyFingerprint:ImportKeyPairResponse' :: Maybe Text
keyFingerprint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:keyName:ImportKeyPairResponse' :: Maybe Text
keyName = forall a. Maybe a
Prelude.Nothing,
      $sel:keyPairId:ImportKeyPairResponse' :: Maybe Text
keyPairId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportKeyPairResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportKeyPairResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | -   For RSA key pairs, the key fingerprint is the MD5 public key
--     fingerprint as specified in section 4 of RFC 4716.
--
-- -   For ED25519 key pairs, the key fingerprint is the base64-encoded
--     SHA-256 digest, which is the default for OpenSSH, starting with
--     <http://www.openssh.com/txt/release-6.8 OpenSSH 6.8>.
importKeyPairResponse_keyFingerprint :: Lens.Lens' ImportKeyPairResponse (Prelude.Maybe Prelude.Text)
importKeyPairResponse_keyFingerprint :: Lens' ImportKeyPairResponse (Maybe Text)
importKeyPairResponse_keyFingerprint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPairResponse' {Maybe Text
keyFingerprint :: Maybe Text
$sel:keyFingerprint:ImportKeyPairResponse' :: ImportKeyPairResponse -> Maybe Text
keyFingerprint} -> Maybe Text
keyFingerprint) (\s :: ImportKeyPairResponse
s@ImportKeyPairResponse' {} Maybe Text
a -> ImportKeyPairResponse
s {$sel:keyFingerprint:ImportKeyPairResponse' :: Maybe Text
keyFingerprint = Maybe Text
a} :: ImportKeyPairResponse)

-- | The key pair name that you provided.
importKeyPairResponse_keyName :: Lens.Lens' ImportKeyPairResponse (Prelude.Maybe Prelude.Text)
importKeyPairResponse_keyName :: Lens' ImportKeyPairResponse (Maybe Text)
importKeyPairResponse_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPairResponse' {Maybe Text
keyName :: Maybe Text
$sel:keyName:ImportKeyPairResponse' :: ImportKeyPairResponse -> Maybe Text
keyName} -> Maybe Text
keyName) (\s :: ImportKeyPairResponse
s@ImportKeyPairResponse' {} Maybe Text
a -> ImportKeyPairResponse
s {$sel:keyName:ImportKeyPairResponse' :: Maybe Text
keyName = Maybe Text
a} :: ImportKeyPairResponse)

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

-- | The tags applied to the imported key pair.
importKeyPairResponse_tags :: Lens.Lens' ImportKeyPairResponse (Prelude.Maybe [Tag])
importKeyPairResponse_tags :: Lens' ImportKeyPairResponse (Maybe [Tag])
importKeyPairResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPairResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ImportKeyPairResponse' :: ImportKeyPairResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ImportKeyPairResponse
s@ImportKeyPairResponse' {} Maybe [Tag]
a -> ImportKeyPairResponse
s {$sel:tags:ImportKeyPairResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ImportKeyPairResponse) 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.
importKeyPairResponse_httpStatus :: Lens.Lens' ImportKeyPairResponse Prelude.Int
importKeyPairResponse_httpStatus :: Lens' ImportKeyPairResponse Int
importKeyPairResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportKeyPairResponse' {Int
httpStatus :: Int
$sel:httpStatus:ImportKeyPairResponse' :: ImportKeyPairResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ImportKeyPairResponse
s@ImportKeyPairResponse' {} Int
a -> ImportKeyPairResponse
s {$sel:httpStatus:ImportKeyPairResponse' :: Int
httpStatus = Int
a} :: ImportKeyPairResponse)

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