{-# 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.SendSSHPublicKey
-- 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 for use by the
-- specified user. The key remains for 60 seconds. For more information,
-- see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Connect-using-EC2-Instance-Connect.html Connect to your Linux instance using EC2 Instance Connect>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2InstanceConnect.SendSSHPublicKey
  ( -- * Creating a Request
    SendSSHPublicKey (..),
    newSendSSHPublicKey,

    -- * Request Lenses
    sendSSHPublicKey_availabilityZone,
    sendSSHPublicKey_instanceId,
    sendSSHPublicKey_instanceOSUser,
    sendSSHPublicKey_sSHPublicKey,

    -- * Destructuring the Response
    SendSSHPublicKeyResponse (..),
    newSendSSHPublicKeyResponse,

    -- * Response Lenses
    sendSSHPublicKeyResponse_requestId,
    sendSSHPublicKeyResponse_success,
    sendSSHPublicKeyResponse_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:/ 'newSendSSHPublicKey' smart constructor.
data SendSSHPublicKey = SendSSHPublicKey'
  { -- | The Availability Zone in which the EC2 instance was launched.
    SendSSHPublicKey -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The ID of the EC2 instance.
    SendSSHPublicKey -> Text
instanceId :: Prelude.Text,
    -- | The OS user on the EC2 instance for whom the key can be used to
    -- authenticate.
    SendSSHPublicKey -> Text
instanceOSUser :: Prelude.Text,
    -- | The public key material. To use the public key, you must have the
    -- matching private key.
    SendSSHPublicKey -> Text
sSHPublicKey :: Prelude.Text
  }
  deriving (SendSSHPublicKey -> SendSSHPublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendSSHPublicKey -> SendSSHPublicKey -> Bool
$c/= :: SendSSHPublicKey -> SendSSHPublicKey -> Bool
== :: SendSSHPublicKey -> SendSSHPublicKey -> Bool
$c== :: SendSSHPublicKey -> SendSSHPublicKey -> Bool
Prelude.Eq, ReadPrec [SendSSHPublicKey]
ReadPrec SendSSHPublicKey
Int -> ReadS SendSSHPublicKey
ReadS [SendSSHPublicKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendSSHPublicKey]
$creadListPrec :: ReadPrec [SendSSHPublicKey]
readPrec :: ReadPrec SendSSHPublicKey
$creadPrec :: ReadPrec SendSSHPublicKey
readList :: ReadS [SendSSHPublicKey]
$creadList :: ReadS [SendSSHPublicKey]
readsPrec :: Int -> ReadS SendSSHPublicKey
$creadsPrec :: Int -> ReadS SendSSHPublicKey
Prelude.Read, Int -> SendSSHPublicKey -> ShowS
[SendSSHPublicKey] -> ShowS
SendSSHPublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendSSHPublicKey] -> ShowS
$cshowList :: [SendSSHPublicKey] -> ShowS
show :: SendSSHPublicKey -> String
$cshow :: SendSSHPublicKey -> String
showsPrec :: Int -> SendSSHPublicKey -> ShowS
$cshowsPrec :: Int -> SendSSHPublicKey -> ShowS
Prelude.Show, forall x. Rep SendSSHPublicKey x -> SendSSHPublicKey
forall x. SendSSHPublicKey -> Rep SendSSHPublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendSSHPublicKey x -> SendSSHPublicKey
$cfrom :: forall x. SendSSHPublicKey -> Rep SendSSHPublicKey x
Prelude.Generic)

-- |
-- Create a value of 'SendSSHPublicKey' 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:
--
-- 'availabilityZone', 'sendSSHPublicKey_availabilityZone' - The Availability Zone in which the EC2 instance was launched.
--
-- 'instanceId', 'sendSSHPublicKey_instanceId' - The ID of the EC2 instance.
--
-- 'instanceOSUser', 'sendSSHPublicKey_instanceOSUser' - The OS user on the EC2 instance for whom the key can be used to
-- authenticate.
--
-- 'sSHPublicKey', 'sendSSHPublicKey_sSHPublicKey' - The public key material. To use the public key, you must have the
-- matching private key.
newSendSSHPublicKey ::
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'instanceOSUser'
  Prelude.Text ->
  -- | 'sSHPublicKey'
  Prelude.Text ->
  SendSSHPublicKey
newSendSSHPublicKey :: Text -> Text -> Text -> SendSSHPublicKey
newSendSSHPublicKey
  Text
pInstanceId_
  Text
pInstanceOSUser_
  Text
pSSHPublicKey_ =
    SendSSHPublicKey'
      { $sel:availabilityZone:SendSSHPublicKey' :: Maybe Text
availabilityZone =
          forall a. Maybe a
Prelude.Nothing,
        $sel:instanceId:SendSSHPublicKey' :: Text
instanceId = Text
pInstanceId_,
        $sel:instanceOSUser:SendSSHPublicKey' :: Text
instanceOSUser = Text
pInstanceOSUser_,
        $sel:sSHPublicKey:SendSSHPublicKey' :: Text
sSHPublicKey = Text
pSSHPublicKey_
      }

-- | The Availability Zone in which the EC2 instance was launched.
sendSSHPublicKey_availabilityZone :: Lens.Lens' SendSSHPublicKey (Prelude.Maybe Prelude.Text)
sendSSHPublicKey_availabilityZone :: Lens' SendSSHPublicKey (Maybe Text)
sendSSHPublicKey_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSSHPublicKey' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:SendSSHPublicKey' :: SendSSHPublicKey -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: SendSSHPublicKey
s@SendSSHPublicKey' {} Maybe Text
a -> SendSSHPublicKey
s {$sel:availabilityZone:SendSSHPublicKey' :: Maybe Text
availabilityZone = Maybe Text
a} :: SendSSHPublicKey)

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

-- | The OS user on the EC2 instance for whom the key can be used to
-- authenticate.
sendSSHPublicKey_instanceOSUser :: Lens.Lens' SendSSHPublicKey Prelude.Text
sendSSHPublicKey_instanceOSUser :: Lens' SendSSHPublicKey Text
sendSSHPublicKey_instanceOSUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSSHPublicKey' {Text
instanceOSUser :: Text
$sel:instanceOSUser:SendSSHPublicKey' :: SendSSHPublicKey -> Text
instanceOSUser} -> Text
instanceOSUser) (\s :: SendSSHPublicKey
s@SendSSHPublicKey' {} Text
a -> SendSSHPublicKey
s {$sel:instanceOSUser:SendSSHPublicKey' :: Text
instanceOSUser = Text
a} :: SendSSHPublicKey)

-- | The public key material. To use the public key, you must have the
-- matching private key.
sendSSHPublicKey_sSHPublicKey :: Lens.Lens' SendSSHPublicKey Prelude.Text
sendSSHPublicKey_sSHPublicKey :: Lens' SendSSHPublicKey Text
sendSSHPublicKey_sSHPublicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendSSHPublicKey' {Text
sSHPublicKey :: Text
$sel:sSHPublicKey:SendSSHPublicKey' :: SendSSHPublicKey -> Text
sSHPublicKey} -> Text
sSHPublicKey) (\s :: SendSSHPublicKey
s@SendSSHPublicKey' {} Text
a -> SendSSHPublicKey
s {$sel:sSHPublicKey:SendSSHPublicKey' :: Text
sSHPublicKey = Text
a} :: SendSSHPublicKey)

instance Core.AWSRequest SendSSHPublicKey where
  type
    AWSResponse SendSSHPublicKey =
      SendSSHPublicKeyResponse
  request :: (Service -> Service)
-> SendSSHPublicKey -> Request SendSSHPublicKey
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 SendSSHPublicKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SendSSHPublicKey)))
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 -> SendSSHPublicKeyResponse
SendSSHPublicKeyResponse'
            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 SendSSHPublicKey where
  hashWithSalt :: Int -> SendSSHPublicKey -> Int
hashWithSalt Int
_salt SendSSHPublicKey' {Maybe Text
Text
sSHPublicKey :: Text
instanceOSUser :: Text
instanceId :: Text
availabilityZone :: Maybe Text
$sel:sSHPublicKey:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:instanceOSUser:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:instanceId:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:availabilityZone:SendSSHPublicKey' :: SendSSHPublicKey -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceOSUser
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sSHPublicKey

instance Prelude.NFData SendSSHPublicKey where
  rnf :: SendSSHPublicKey -> ()
rnf SendSSHPublicKey' {Maybe Text
Text
sSHPublicKey :: Text
instanceOSUser :: Text
instanceId :: Text
availabilityZone :: Maybe Text
$sel:sSHPublicKey:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:instanceOSUser:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:instanceId:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:availabilityZone:SendSSHPublicKey' :: SendSSHPublicKey -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      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
instanceOSUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sSHPublicKey

instance Data.ToHeaders SendSSHPublicKey where
  toHeaders :: SendSSHPublicKey -> 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.SendSSHPublicKey" ::
                          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 SendSSHPublicKey where
  toJSON :: SendSSHPublicKey -> Value
toJSON SendSSHPublicKey' {Maybe Text
Text
sSHPublicKey :: Text
instanceOSUser :: Text
instanceId :: Text
availabilityZone :: Maybe Text
$sel:sSHPublicKey:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:instanceOSUser:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:instanceId:SendSSHPublicKey' :: SendSSHPublicKey -> Text
$sel:availabilityZone:SendSSHPublicKey' :: SendSSHPublicKey -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AvailabilityZone" 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 Text
availabilityZone,
            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
"InstanceOSUser" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceOSUser),
            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 SendSSHPublicKey where
  toPath :: SendSSHPublicKey -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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

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

instance Prelude.NFData SendSSHPublicKeyResponse where
  rnf :: SendSSHPublicKeyResponse -> ()
rnf SendSSHPublicKeyResponse' {Int
Maybe Bool
Maybe Text
httpStatus :: Int
success :: Maybe Bool
requestId :: Maybe Text
$sel:httpStatus:SendSSHPublicKeyResponse' :: SendSSHPublicKeyResponse -> Int
$sel:success:SendSSHPublicKeyResponse' :: SendSSHPublicKeyResponse -> Maybe Bool
$sel:requestId:SendSSHPublicKeyResponse' :: SendSSHPublicKeyResponse -> 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