{-# 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.Lightsail.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 a custom SSH key pair that you can use with an Amazon Lightsail
-- instance.
--
-- Use the
-- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_DownloadDefaultKeyPair.html DownloadDefaultKeyPair>
-- action to create a Lightsail default key pair in an Amazon Web Services
-- Region where a default key pair does not currently exist.
--
-- The @create key pair@ operation supports tag-based access control via
-- request tags. For more information, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-controlling-access-using-tags Amazon Lightsail Developer Guide>.
module Amazonka.Lightsail.CreateKeyPair
  ( -- * Creating a Request
    CreateKeyPair (..),
    newCreateKeyPair,

    -- * Request Lenses
    createKeyPair_tags,
    createKeyPair_keyPairName,

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

    -- * Response Lenses
    createKeyPairResponse_keyPair,
    createKeyPairResponse_operation,
    createKeyPairResponse_privateKeyBase64,
    createKeyPairResponse_publicKeyBase64,
    createKeyPairResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lightsail.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'
  { -- | The tag keys and optional values to add to the resource during create.
    --
    -- Use the @TagResource@ action to tag a resource after it\'s created.
    CreateKeyPair -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name for your new key pair.
    CreateKeyPair -> Text
keyPairName :: 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:
--
-- 'tags', 'createKeyPair_tags' - The tag keys and optional values to add to the resource during create.
--
-- Use the @TagResource@ action to tag a resource after it\'s created.
--
-- 'keyPairName', 'createKeyPair_keyPairName' - The name for your new key pair.
newCreateKeyPair ::
  -- | 'keyPairName'
  Prelude.Text ->
  CreateKeyPair
newCreateKeyPair :: Text -> CreateKeyPair
newCreateKeyPair Text
pKeyPairName_ =
  CreateKeyPair'
    { $sel:tags:CreateKeyPair' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:keyPairName:CreateKeyPair' :: Text
keyPairName = Text
pKeyPairName_
    }

-- | The tag keys and optional values to add to the resource during create.
--
-- Use the @TagResource@ action to tag a resource after it\'s created.
createKeyPair_tags :: Lens.Lens' CreateKeyPair (Prelude.Maybe [Tag])
createKeyPair_tags :: Lens' CreateKeyPair (Maybe [Tag])
createKeyPair_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPair' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateKeyPair' :: CreateKeyPair -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateKeyPair
s@CreateKeyPair' {} Maybe [Tag]
a -> CreateKeyPair
s {$sel:tags:CreateKeyPair' :: Maybe [Tag]
tags = Maybe [Tag]
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

-- | The name for your new key pair.
createKeyPair_keyPairName :: Lens.Lens' CreateKeyPair Prelude.Text
createKeyPair_keyPairName :: Lens' CreateKeyPair Text
createKeyPair_keyPairName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPair' {Text
keyPairName :: Text
$sel:keyPairName:CreateKeyPair' :: CreateKeyPair -> Text
keyPairName} -> Text
keyPairName) (\s :: CreateKeyPair
s@CreateKeyPair' {} Text
a -> CreateKeyPair
s {$sel:keyPairName:CreateKeyPair' :: Text
keyPairName = 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, ToJSON a) => Service -> a -> Request a
Request.postJSON (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 -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe KeyPair
-> Maybe Operation
-> Maybe Text
-> Maybe Text
-> Int
-> CreateKeyPairResponse
CreateKeyPairResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"keyPair")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"operation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"privateKeyBase64")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"publicKeyBase64")
            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 CreateKeyPair where
  hashWithSalt :: Int -> CreateKeyPair -> Int
hashWithSalt Int
_salt CreateKeyPair' {Maybe [Tag]
Text
keyPairName :: Text
tags :: Maybe [Tag]
$sel:keyPairName:CreateKeyPair' :: CreateKeyPair -> Text
$sel:tags:CreateKeyPair' :: CreateKeyPair -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyPairName

instance Prelude.NFData CreateKeyPair where
  rnf :: CreateKeyPair -> ()
rnf CreateKeyPair' {Maybe [Tag]
Text
keyPairName :: Text
tags :: Maybe [Tag]
$sel:keyPairName:CreateKeyPair' :: CreateKeyPair -> Text
$sel:tags:CreateKeyPair' :: CreateKeyPair -> Maybe [Tag]
..} =
    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 Text
keyPairName

instance Data.ToHeaders CreateKeyPair where
  toHeaders :: CreateKeyPair -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Lightsail_20161128.CreateKeyPair" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateKeyPair where
  toJSON :: CreateKeyPair -> Value
toJSON CreateKeyPair' {Maybe [Tag]
Text
keyPairName :: Text
tags :: Maybe [Tag]
$sel:keyPairName:CreateKeyPair' :: CreateKeyPair -> Text
$sel:tags:CreateKeyPair' :: CreateKeyPair -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"keyPairName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyPairName)
          ]
      )

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 = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateKeyPairResponse' smart constructor.
data CreateKeyPairResponse = CreateKeyPairResponse'
  { -- | An array of key-value pairs containing information about the new key
    -- pair you just created.
    CreateKeyPairResponse -> Maybe KeyPair
keyPair :: Prelude.Maybe KeyPair,
    -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    CreateKeyPairResponse -> Maybe Operation
operation :: Prelude.Maybe Operation,
    -- | A base64-encoded RSA private key.
    CreateKeyPairResponse -> Maybe Text
privateKeyBase64 :: Prelude.Maybe Prelude.Text,
    -- | A base64-encoded public key of the @ssh-rsa@ type.
    CreateKeyPairResponse -> Maybe Text
publicKeyBase64 :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateKeyPairResponse -> Int
httpStatus :: Prelude.Int
  }
  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, ReadPrec [CreateKeyPairResponse]
ReadPrec CreateKeyPairResponse
Int -> ReadS CreateKeyPairResponse
ReadS [CreateKeyPairResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateKeyPairResponse]
$creadListPrec :: ReadPrec [CreateKeyPairResponse]
readPrec :: ReadPrec CreateKeyPairResponse
$creadPrec :: ReadPrec CreateKeyPairResponse
readList :: ReadS [CreateKeyPairResponse]
$creadList :: ReadS [CreateKeyPairResponse]
readsPrec :: Int -> ReadS CreateKeyPairResponse
$creadsPrec :: Int -> ReadS CreateKeyPairResponse
Prelude.Read, 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:
--
-- 'keyPair', 'createKeyPairResponse_keyPair' - An array of key-value pairs containing information about the new key
-- pair you just created.
--
-- 'operation', 'createKeyPairResponse_operation' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'privateKeyBase64', 'createKeyPairResponse_privateKeyBase64' - A base64-encoded RSA private key.
--
-- 'publicKeyBase64', 'createKeyPairResponse_publicKeyBase64' - A base64-encoded public key of the @ssh-rsa@ type.
--
-- 'httpStatus', 'createKeyPairResponse_httpStatus' - The response's http status code.
newCreateKeyPairResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateKeyPairResponse
newCreateKeyPairResponse :: Int -> CreateKeyPairResponse
newCreateKeyPairResponse Int
pHttpStatus_ =
  CreateKeyPairResponse'
    { $sel:keyPair:CreateKeyPairResponse' :: Maybe KeyPair
keyPair = forall a. Maybe a
Prelude.Nothing,
      $sel:operation:CreateKeyPairResponse' :: Maybe Operation
operation = forall a. Maybe a
Prelude.Nothing,
      $sel:privateKeyBase64:CreateKeyPairResponse' :: Maybe Text
privateKeyBase64 = forall a. Maybe a
Prelude.Nothing,
      $sel:publicKeyBase64:CreateKeyPairResponse' :: Maybe Text
publicKeyBase64 = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateKeyPairResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of key-value pairs containing information about the new key
-- pair you just created.
createKeyPairResponse_keyPair :: Lens.Lens' CreateKeyPairResponse (Prelude.Maybe KeyPair)
createKeyPairResponse_keyPair :: Lens' CreateKeyPairResponse (Maybe KeyPair)
createKeyPairResponse_keyPair = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Maybe KeyPair
keyPair :: Maybe KeyPair
$sel:keyPair:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe KeyPair
keyPair} -> Maybe KeyPair
keyPair) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Maybe KeyPair
a -> CreateKeyPairResponse
s {$sel:keyPair:CreateKeyPairResponse' :: Maybe KeyPair
keyPair = Maybe KeyPair
a} :: CreateKeyPairResponse)

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
createKeyPairResponse_operation :: Lens.Lens' CreateKeyPairResponse (Prelude.Maybe Operation)
createKeyPairResponse_operation :: Lens' CreateKeyPairResponse (Maybe Operation)
createKeyPairResponse_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Maybe Operation
operation :: Maybe Operation
$sel:operation:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Operation
operation} -> Maybe Operation
operation) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Maybe Operation
a -> CreateKeyPairResponse
s {$sel:operation:CreateKeyPairResponse' :: Maybe Operation
operation = Maybe Operation
a} :: CreateKeyPairResponse)

-- | A base64-encoded RSA private key.
createKeyPairResponse_privateKeyBase64 :: Lens.Lens' CreateKeyPairResponse (Prelude.Maybe Prelude.Text)
createKeyPairResponse_privateKeyBase64 :: Lens' CreateKeyPairResponse (Maybe Text)
createKeyPairResponse_privateKeyBase64 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Maybe Text
privateKeyBase64 :: Maybe Text
$sel:privateKeyBase64:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Text
privateKeyBase64} -> Maybe Text
privateKeyBase64) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Maybe Text
a -> CreateKeyPairResponse
s {$sel:privateKeyBase64:CreateKeyPairResponse' :: Maybe Text
privateKeyBase64 = Maybe Text
a} :: CreateKeyPairResponse)

-- | A base64-encoded public key of the @ssh-rsa@ type.
createKeyPairResponse_publicKeyBase64 :: Lens.Lens' CreateKeyPairResponse (Prelude.Maybe Prelude.Text)
createKeyPairResponse_publicKeyBase64 :: Lens' CreateKeyPairResponse (Maybe Text)
createKeyPairResponse_publicKeyBase64 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKeyPairResponse' {Maybe Text
publicKeyBase64 :: Maybe Text
$sel:publicKeyBase64:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Text
publicKeyBase64} -> Maybe Text
publicKeyBase64) (\s :: CreateKeyPairResponse
s@CreateKeyPairResponse' {} Maybe Text
a -> CreateKeyPairResponse
s {$sel:publicKeyBase64:CreateKeyPairResponse' :: Maybe Text
publicKeyBase64 = Maybe Text
a} :: CreateKeyPairResponse)

-- | 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)

instance Prelude.NFData CreateKeyPairResponse where
  rnf :: CreateKeyPairResponse -> ()
rnf CreateKeyPairResponse' {Int
Maybe Text
Maybe Operation
Maybe KeyPair
httpStatus :: Int
publicKeyBase64 :: Maybe Text
privateKeyBase64 :: Maybe Text
operation :: Maybe Operation
keyPair :: Maybe KeyPair
$sel:httpStatus:CreateKeyPairResponse' :: CreateKeyPairResponse -> Int
$sel:publicKeyBase64:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Text
$sel:privateKeyBase64:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Text
$sel:operation:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe Operation
$sel:keyPair:CreateKeyPairResponse' :: CreateKeyPairResponse -> Maybe KeyPair
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe KeyPair
keyPair
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Operation
operation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
privateKeyBase64
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publicKeyBase64
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus