{-# 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.EC2InstanceConnect.SendSerialConsoleSSHPublicKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Pushes an SSH public key to the specified EC2 instance. The key remains
-- for 60 seconds, which gives you 60 seconds to establish a serial console
-- connection to the instance using SSH. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-serial-console.html EC2 Serial Console>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2InstanceConnect.SendSerialConsoleSSHPublicKey
  ( -- * Creating a Request
    SendSerialConsoleSSHPublicKey (..),
    newSendSerialConsoleSSHPublicKey,

    -- * Request Lenses
    sendSerialConsoleSSHPublicKey_serialPort,
    sendSerialConsoleSSHPublicKey_instanceId,
    sendSerialConsoleSSHPublicKey_sSHPublicKey,

    -- * Destructuring the Response
    SendSerialConsoleSSHPublicKeyResponse (..),
    newSendSerialConsoleSSHPublicKeyResponse,

    -- * Response Lenses
    sendSerialConsoleSSHPublicKeyResponse_requestId,
    sendSerialConsoleSSHPublicKeyResponse_success,
    sendSerialConsoleSSHPublicKeyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newSendSerialConsoleSSHPublicKey' smart constructor.
data SendSerialConsoleSSHPublicKey = SendSerialConsoleSSHPublicKey'
  { -- | The serial port of the EC2 instance. Currently only port 0 is supported.
    --
    -- Default: 0
    SendSerialConsoleSSHPublicKey -> Maybe Natural
serialPort :: Prelude.Maybe Prelude.Natural,
    -- | The ID of the EC2 instance.
    SendSerialConsoleSSHPublicKey -> Text
instanceId :: Prelude.Text,
    -- | The public key material. To use the public key, you must have the
    -- matching private key. For information about the supported key formats
    -- and lengths, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-key-pairs.html#how-to-generate-your-own-key-and-import-it-to-aws Requirements for key pairs>
    -- in the /Amazon EC2 User Guide/.
    SendSerialConsoleSSHPublicKey -> Text
sSHPublicKey :: Prelude.Text
  }
  deriving (SendSerialConsoleSSHPublicKey
-> SendSerialConsoleSSHPublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendSerialConsoleSSHPublicKey
-> SendSerialConsoleSSHPublicKey -> Bool
$c/= :: SendSerialConsoleSSHPublicKey
-> SendSerialConsoleSSHPublicKey -> Bool
== :: SendSerialConsoleSSHPublicKey
-> SendSerialConsoleSSHPublicKey -> Bool
$c== :: SendSerialConsoleSSHPublicKey
-> SendSerialConsoleSSHPublicKey -> Bool
Prelude.Eq, ReadPrec [SendSerialConsoleSSHPublicKey]
ReadPrec SendSerialConsoleSSHPublicKey
Int -> ReadS SendSerialConsoleSSHPublicKey
ReadS [SendSerialConsoleSSHPublicKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendSerialConsoleSSHPublicKey]
$creadListPrec :: ReadPrec [SendSerialConsoleSSHPublicKey]
readPrec :: ReadPrec SendSerialConsoleSSHPublicKey
$creadPrec :: ReadPrec SendSerialConsoleSSHPublicKey
readList :: ReadS [SendSerialConsoleSSHPublicKey]
$creadList :: ReadS [SendSerialConsoleSSHPublicKey]
readsPrec :: Int -> ReadS SendSerialConsoleSSHPublicKey
$creadsPrec :: Int -> ReadS SendSerialConsoleSSHPublicKey
Prelude.Read, Int -> SendSerialConsoleSSHPublicKey -> ShowS
[SendSerialConsoleSSHPublicKey] -> ShowS
SendSerialConsoleSSHPublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendSerialConsoleSSHPublicKey] -> ShowS
$cshowList :: [SendSerialConsoleSSHPublicKey] -> ShowS
show :: SendSerialConsoleSSHPublicKey -> String
$cshow :: SendSerialConsoleSSHPublicKey -> String
showsPrec :: Int -> SendSerialConsoleSSHPublicKey -> ShowS
$cshowsPrec :: Int -> SendSerialConsoleSSHPublicKey -> ShowS
Prelude.Show, forall x.
Rep SendSerialConsoleSSHPublicKey x
-> SendSerialConsoleSSHPublicKey
forall x.
SendSerialConsoleSSHPublicKey
-> Rep SendSerialConsoleSSHPublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendSerialConsoleSSHPublicKey x
-> SendSerialConsoleSSHPublicKey
$cfrom :: forall x.
SendSerialConsoleSSHPublicKey
-> Rep SendSerialConsoleSSHPublicKey x
Prelude.Generic)

-- |
-- Create a value of 'SendSerialConsoleSSHPublicKey' 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:
--
-- 'serialPort', 'sendSerialConsoleSSHPublicKey_serialPort' - The serial port of the EC2 instance. Currently only port 0 is supported.
--
-- Default: 0
--
-- 'instanceId', 'sendSerialConsoleSSHPublicKey_instanceId' - The ID of the EC2 instance.
--
-- 'sSHPublicKey', 'sendSerialConsoleSSHPublicKey_sSHPublicKey' - The public key material. To use the public key, you must have the
-- matching private key. For information about the supported key formats
-- and lengths, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-key-pairs.html#how-to-generate-your-own-key-and-import-it-to-aws Requirements for key pairs>
-- in the /Amazon EC2 User Guide/.
newSendSerialConsoleSSHPublicKey ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'sSHPublicKey'
  Prelude.Text ->
  SendSerialConsoleSSHPublicKey
newSendSerialConsoleSSHPublicKey :: Text -> Text -> SendSerialConsoleSSHPublicKey
newSendSerialConsoleSSHPublicKey
  Text
pInstanceId_
  Text
pSSHPublicKey_ =
    SendSerialConsoleSSHPublicKey'
      { $sel:serialPort:SendSerialConsoleSSHPublicKey' :: Maybe Natural
serialPort =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceId:SendSerialConsoleSSHPublicKey' :: Text
instanceId = Text
pInstanceId_,
        $sel:sSHPublicKey:SendSerialConsoleSSHPublicKey' :: Text
sSHPublicKey = Text
pSSHPublicKey_
      }

-- | The serial port of the EC2 instance. Currently only port 0 is supported.
--
-- Default: 0
sendSerialConsoleSSHPublicKey_serialPort :: Lens.Lens' SendSerialConsoleSSHPublicKey (Prelude.Maybe Prelude.Natural)
sendSerialConsoleSSHPublicKey_serialPort :: Lens' SendSerialConsoleSSHPublicKey (Maybe Natural)
sendSerialConsoleSSHPublicKey_serialPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSerialConsoleSSHPublicKey' {Maybe Natural
serialPort :: Maybe Natural
$sel:serialPort:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Maybe Natural
serialPort} -> Maybe Natural
serialPort) (\s :: SendSerialConsoleSSHPublicKey
s@SendSerialConsoleSSHPublicKey' {} Maybe Natural
a -> SendSerialConsoleSSHPublicKey
s {$sel:serialPort:SendSerialConsoleSSHPublicKey' :: Maybe Natural
serialPort = Maybe Natural
a} :: SendSerialConsoleSSHPublicKey)

-- | The ID of the EC2 instance.
sendSerialConsoleSSHPublicKey_instanceId :: Lens.Lens' SendSerialConsoleSSHPublicKey Prelude.Text
sendSerialConsoleSSHPublicKey_instanceId :: Lens' SendSerialConsoleSSHPublicKey Text
sendSerialConsoleSSHPublicKey_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSerialConsoleSSHPublicKey' {Text
instanceId :: Text
$sel:instanceId:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
instanceId} -> Text
instanceId) (\s :: SendSerialConsoleSSHPublicKey
s@SendSerialConsoleSSHPublicKey' {} Text
a -> SendSerialConsoleSSHPublicKey
s {$sel:instanceId:SendSerialConsoleSSHPublicKey' :: Text
instanceId = Text
a} :: SendSerialConsoleSSHPublicKey)

-- | The public key material. To use the public key, you must have the
-- matching private key. For information about the supported key formats
-- and lengths, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-key-pairs.html#how-to-generate-your-own-key-and-import-it-to-aws Requirements for key pairs>
-- in the /Amazon EC2 User Guide/.
sendSerialConsoleSSHPublicKey_sSHPublicKey :: Lens.Lens' SendSerialConsoleSSHPublicKey Prelude.Text
sendSerialConsoleSSHPublicKey_sSHPublicKey :: Lens' SendSerialConsoleSSHPublicKey Text
sendSerialConsoleSSHPublicKey_sSHPublicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSerialConsoleSSHPublicKey' {Text
sSHPublicKey :: Text
$sel:sSHPublicKey:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
sSHPublicKey} -> Text
sSHPublicKey) (\s :: SendSerialConsoleSSHPublicKey
s@SendSerialConsoleSSHPublicKey' {} Text
a -> SendSerialConsoleSSHPublicKey
s {$sel:sSHPublicKey:SendSerialConsoleSSHPublicKey' :: Text
sSHPublicKey = Text
a} :: SendSerialConsoleSSHPublicKey)

instance
  Core.AWSRequest
    SendSerialConsoleSSHPublicKey
  where
  type
    AWSResponse SendSerialConsoleSSHPublicKey =
      SendSerialConsoleSSHPublicKeyResponse
  request :: (Service -> Service)
-> SendSerialConsoleSSHPublicKey
-> Request SendSerialConsoleSSHPublicKey
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 SendSerialConsoleSSHPublicKey
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SendSerialConsoleSSHPublicKey)))
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 Text
-> Maybe Bool -> Int -> SendSerialConsoleSSHPublicKeyResponse
SendSerialConsoleSSHPublicKeyResponse'
            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
"RequestId")
            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
"Success")
            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
    SendSerialConsoleSSHPublicKey
  where
  hashWithSalt :: Int -> SendSerialConsoleSSHPublicKey -> Int
hashWithSalt Int
_salt SendSerialConsoleSSHPublicKey' {Maybe Natural
Text
sSHPublicKey :: Text
instanceId :: Text
serialPort :: Maybe Natural
$sel:sSHPublicKey:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
$sel:instanceId:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
$sel:serialPort:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
serialPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sSHPublicKey

instance Prelude.NFData SendSerialConsoleSSHPublicKey where
  rnf :: SendSerialConsoleSSHPublicKey -> ()
rnf SendSerialConsoleSSHPublicKey' {Maybe Natural
Text
sSHPublicKey :: Text
instanceId :: Text
serialPort :: Maybe Natural
$sel:sSHPublicKey:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
$sel:instanceId:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
$sel:serialPort:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
serialPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sSHPublicKey

instance Data.ToHeaders SendSerialConsoleSSHPublicKey where
  toHeaders :: SendSerialConsoleSSHPublicKey -> 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
"AWSEC2InstanceConnectService.SendSerialConsoleSSHPublicKey" ::
                          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 SendSerialConsoleSSHPublicKey where
  toJSON :: SendSerialConsoleSSHPublicKey -> Value
toJSON SendSerialConsoleSSHPublicKey' {Maybe Natural
Text
sSHPublicKey :: Text
instanceId :: Text
serialPort :: Maybe Natural
$sel:sSHPublicKey:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
$sel:instanceId:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Text
$sel:serialPort:SendSerialConsoleSSHPublicKey' :: SendSerialConsoleSSHPublicKey -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SerialPort" 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 Natural
serialPort,
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"SSHPublicKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sSHPublicKey)
          ]
      )

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

instance Data.ToQuery SendSerialConsoleSSHPublicKey where
  toQuery :: SendSerialConsoleSSHPublicKey -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newSendSerialConsoleSSHPublicKeyResponse' smart constructor.
data SendSerialConsoleSSHPublicKeyResponse = SendSerialConsoleSSHPublicKeyResponse'
  { -- | The ID of the request. Please provide this ID when contacting AWS
    -- Support for assistance.
    SendSerialConsoleSSHPublicKeyResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | Is true if the request succeeds and an error otherwise.
    SendSerialConsoleSSHPublicKeyResponse -> Maybe Bool
success :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    SendSerialConsoleSSHPublicKeyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendSerialConsoleSSHPublicKeyResponse
-> SendSerialConsoleSSHPublicKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendSerialConsoleSSHPublicKeyResponse
-> SendSerialConsoleSSHPublicKeyResponse -> Bool
$c/= :: SendSerialConsoleSSHPublicKeyResponse
-> SendSerialConsoleSSHPublicKeyResponse -> Bool
== :: SendSerialConsoleSSHPublicKeyResponse
-> SendSerialConsoleSSHPublicKeyResponse -> Bool
$c== :: SendSerialConsoleSSHPublicKeyResponse
-> SendSerialConsoleSSHPublicKeyResponse -> Bool
Prelude.Eq, ReadPrec [SendSerialConsoleSSHPublicKeyResponse]
ReadPrec SendSerialConsoleSSHPublicKeyResponse
Int -> ReadS SendSerialConsoleSSHPublicKeyResponse
ReadS [SendSerialConsoleSSHPublicKeyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendSerialConsoleSSHPublicKeyResponse]
$creadListPrec :: ReadPrec [SendSerialConsoleSSHPublicKeyResponse]
readPrec :: ReadPrec SendSerialConsoleSSHPublicKeyResponse
$creadPrec :: ReadPrec SendSerialConsoleSSHPublicKeyResponse
readList :: ReadS [SendSerialConsoleSSHPublicKeyResponse]
$creadList :: ReadS [SendSerialConsoleSSHPublicKeyResponse]
readsPrec :: Int -> ReadS SendSerialConsoleSSHPublicKeyResponse
$creadsPrec :: Int -> ReadS SendSerialConsoleSSHPublicKeyResponse
Prelude.Read, Int -> SendSerialConsoleSSHPublicKeyResponse -> ShowS
[SendSerialConsoleSSHPublicKeyResponse] -> ShowS
SendSerialConsoleSSHPublicKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendSerialConsoleSSHPublicKeyResponse] -> ShowS
$cshowList :: [SendSerialConsoleSSHPublicKeyResponse] -> ShowS
show :: SendSerialConsoleSSHPublicKeyResponse -> String
$cshow :: SendSerialConsoleSSHPublicKeyResponse -> String
showsPrec :: Int -> SendSerialConsoleSSHPublicKeyResponse -> ShowS
$cshowsPrec :: Int -> SendSerialConsoleSSHPublicKeyResponse -> ShowS
Prelude.Show, forall x.
Rep SendSerialConsoleSSHPublicKeyResponse x
-> SendSerialConsoleSSHPublicKeyResponse
forall x.
SendSerialConsoleSSHPublicKeyResponse
-> Rep SendSerialConsoleSSHPublicKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendSerialConsoleSSHPublicKeyResponse x
-> SendSerialConsoleSSHPublicKeyResponse
$cfrom :: forall x.
SendSerialConsoleSSHPublicKeyResponse
-> Rep SendSerialConsoleSSHPublicKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendSerialConsoleSSHPublicKeyResponse' 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:
--
-- 'requestId', 'sendSerialConsoleSSHPublicKeyResponse_requestId' - The ID of the request. Please provide this ID when contacting AWS
-- Support for assistance.
--
-- 'success', 'sendSerialConsoleSSHPublicKeyResponse_success' - Is true if the request succeeds and an error otherwise.
--
-- 'httpStatus', 'sendSerialConsoleSSHPublicKeyResponse_httpStatus' - The response's http status code.
newSendSerialConsoleSSHPublicKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendSerialConsoleSSHPublicKeyResponse
newSendSerialConsoleSSHPublicKeyResponse :: Int -> SendSerialConsoleSSHPublicKeyResponse
newSendSerialConsoleSSHPublicKeyResponse Int
pHttpStatus_ =
  SendSerialConsoleSSHPublicKeyResponse'
    { $sel:requestId:SendSerialConsoleSSHPublicKeyResponse' :: Maybe Text
requestId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:success:SendSerialConsoleSSHPublicKeyResponse' :: Maybe Bool
success = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SendSerialConsoleSSHPublicKeyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the request. Please provide this ID when contacting AWS
-- Support for assistance.
sendSerialConsoleSSHPublicKeyResponse_requestId :: Lens.Lens' SendSerialConsoleSSHPublicKeyResponse (Prelude.Maybe Prelude.Text)
sendSerialConsoleSSHPublicKeyResponse_requestId :: Lens' SendSerialConsoleSSHPublicKeyResponse (Maybe Text)
sendSerialConsoleSSHPublicKeyResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSerialConsoleSSHPublicKeyResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:SendSerialConsoleSSHPublicKeyResponse' :: SendSerialConsoleSSHPublicKeyResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: SendSerialConsoleSSHPublicKeyResponse
s@SendSerialConsoleSSHPublicKeyResponse' {} Maybe Text
a -> SendSerialConsoleSSHPublicKeyResponse
s {$sel:requestId:SendSerialConsoleSSHPublicKeyResponse' :: Maybe Text
requestId = Maybe Text
a} :: SendSerialConsoleSSHPublicKeyResponse)

-- | Is true if the request succeeds and an error otherwise.
sendSerialConsoleSSHPublicKeyResponse_success :: Lens.Lens' SendSerialConsoleSSHPublicKeyResponse (Prelude.Maybe Prelude.Bool)
sendSerialConsoleSSHPublicKeyResponse_success :: Lens' SendSerialConsoleSSHPublicKeyResponse (Maybe Bool)
sendSerialConsoleSSHPublicKeyResponse_success = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSerialConsoleSSHPublicKeyResponse' {Maybe Bool
success :: Maybe Bool
$sel:success:SendSerialConsoleSSHPublicKeyResponse' :: SendSerialConsoleSSHPublicKeyResponse -> Maybe Bool
success} -> Maybe Bool
success) (\s :: SendSerialConsoleSSHPublicKeyResponse
s@SendSerialConsoleSSHPublicKeyResponse' {} Maybe Bool
a -> SendSerialConsoleSSHPublicKeyResponse
s {$sel:success:SendSerialConsoleSSHPublicKeyResponse' :: Maybe Bool
success = Maybe Bool
a} :: SendSerialConsoleSSHPublicKeyResponse)

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

instance
  Prelude.NFData
    SendSerialConsoleSSHPublicKeyResponse
  where
  rnf :: SendSerialConsoleSSHPublicKeyResponse -> ()
rnf SendSerialConsoleSSHPublicKeyResponse' {Int
Maybe Bool
Maybe Text
httpStatus :: Int
success :: Maybe Bool
requestId :: Maybe Text
$sel:httpStatus:SendSerialConsoleSSHPublicKeyResponse' :: SendSerialConsoleSSHPublicKeyResponse -> Int
$sel:success:SendSerialConsoleSSHPublicKeyResponse' :: SendSerialConsoleSSHPublicKeyResponse -> Maybe Bool
$sel:requestId:SendSerialConsoleSSHPublicKeyResponse' :: SendSerialConsoleSSHPublicKeyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
success
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus