{-# 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.Transfer.ImportSshPublicKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a Secure Shell (SSH) public key to a user account identified by a
-- @UserName@ value assigned to the specific file transfer protocol-enabled
-- server, identified by @ServerId@.
--
-- The response returns the @UserName@ value, the @ServerId@ value, and the
-- name of the @SshPublicKeyId@.
module Amazonka.Transfer.ImportSshPublicKey
  ( -- * Creating a Request
    ImportSshPublicKey (..),
    newImportSshPublicKey,

    -- * Request Lenses
    importSshPublicKey_serverId,
    importSshPublicKey_sshPublicKeyBody,
    importSshPublicKey_userName,

    -- * Destructuring the Response
    ImportSshPublicKeyResponse (..),
    newImportSshPublicKeyResponse,

    -- * Response Lenses
    importSshPublicKeyResponse_httpStatus,
    importSshPublicKeyResponse_serverId,
    importSshPublicKeyResponse_sshPublicKeyId,
    importSshPublicKeyResponse_userName,
  )
where

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

-- | /See:/ 'newImportSshPublicKey' smart constructor.
data ImportSshPublicKey = ImportSshPublicKey'
  { -- | A system-assigned unique identifier for a server.
    ImportSshPublicKey -> Text
serverId :: Prelude.Text,
    -- | The public key portion of an SSH key pair.
    --
    -- Transfer Family accepts RSA, ECDSA, and ED25519 keys.
    ImportSshPublicKey -> Text
sshPublicKeyBody :: Prelude.Text,
    -- | The name of the user account that is assigned to one or more servers.
    ImportSshPublicKey -> Text
userName :: Prelude.Text
  }
  deriving (ImportSshPublicKey -> ImportSshPublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSshPublicKey -> ImportSshPublicKey -> Bool
$c/= :: ImportSshPublicKey -> ImportSshPublicKey -> Bool
== :: ImportSshPublicKey -> ImportSshPublicKey -> Bool
$c== :: ImportSshPublicKey -> ImportSshPublicKey -> Bool
Prelude.Eq, ReadPrec [ImportSshPublicKey]
ReadPrec ImportSshPublicKey
Int -> ReadS ImportSshPublicKey
ReadS [ImportSshPublicKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportSshPublicKey]
$creadListPrec :: ReadPrec [ImportSshPublicKey]
readPrec :: ReadPrec ImportSshPublicKey
$creadPrec :: ReadPrec ImportSshPublicKey
readList :: ReadS [ImportSshPublicKey]
$creadList :: ReadS [ImportSshPublicKey]
readsPrec :: Int -> ReadS ImportSshPublicKey
$creadsPrec :: Int -> ReadS ImportSshPublicKey
Prelude.Read, Int -> ImportSshPublicKey -> ShowS
[ImportSshPublicKey] -> ShowS
ImportSshPublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportSshPublicKey] -> ShowS
$cshowList :: [ImportSshPublicKey] -> ShowS
show :: ImportSshPublicKey -> String
$cshow :: ImportSshPublicKey -> String
showsPrec :: Int -> ImportSshPublicKey -> ShowS
$cshowsPrec :: Int -> ImportSshPublicKey -> ShowS
Prelude.Show, forall x. Rep ImportSshPublicKey x -> ImportSshPublicKey
forall x. ImportSshPublicKey -> Rep ImportSshPublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportSshPublicKey x -> ImportSshPublicKey
$cfrom :: forall x. ImportSshPublicKey -> Rep ImportSshPublicKey x
Prelude.Generic)

-- |
-- Create a value of 'ImportSshPublicKey' 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:
--
-- 'serverId', 'importSshPublicKey_serverId' - A system-assigned unique identifier for a server.
--
-- 'sshPublicKeyBody', 'importSshPublicKey_sshPublicKeyBody' - The public key portion of an SSH key pair.
--
-- Transfer Family accepts RSA, ECDSA, and ED25519 keys.
--
-- 'userName', 'importSshPublicKey_userName' - The name of the user account that is assigned to one or more servers.
newImportSshPublicKey ::
  -- | 'serverId'
  Prelude.Text ->
  -- | 'sshPublicKeyBody'
  Prelude.Text ->
  -- | 'userName'
  Prelude.Text ->
  ImportSshPublicKey
newImportSshPublicKey :: Text -> Text -> Text -> ImportSshPublicKey
newImportSshPublicKey
  Text
pServerId_
  Text
pSshPublicKeyBody_
  Text
pUserName_ =
    ImportSshPublicKey'
      { $sel:serverId:ImportSshPublicKey' :: Text
serverId = Text
pServerId_,
        $sel:sshPublicKeyBody:ImportSshPublicKey' :: Text
sshPublicKeyBody = Text
pSshPublicKeyBody_,
        $sel:userName:ImportSshPublicKey' :: Text
userName = Text
pUserName_
      }

-- | A system-assigned unique identifier for a server.
importSshPublicKey_serverId :: Lens.Lens' ImportSshPublicKey Prelude.Text
importSshPublicKey_serverId :: Lens' ImportSshPublicKey Text
importSshPublicKey_serverId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSshPublicKey' {Text
serverId :: Text
$sel:serverId:ImportSshPublicKey' :: ImportSshPublicKey -> Text
serverId} -> Text
serverId) (\s :: ImportSshPublicKey
s@ImportSshPublicKey' {} Text
a -> ImportSshPublicKey
s {$sel:serverId:ImportSshPublicKey' :: Text
serverId = Text
a} :: ImportSshPublicKey)

-- | The public key portion of an SSH key pair.
--
-- Transfer Family accepts RSA, ECDSA, and ED25519 keys.
importSshPublicKey_sshPublicKeyBody :: Lens.Lens' ImportSshPublicKey Prelude.Text
importSshPublicKey_sshPublicKeyBody :: Lens' ImportSshPublicKey Text
importSshPublicKey_sshPublicKeyBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSshPublicKey' {Text
sshPublicKeyBody :: Text
$sel:sshPublicKeyBody:ImportSshPublicKey' :: ImportSshPublicKey -> Text
sshPublicKeyBody} -> Text
sshPublicKeyBody) (\s :: ImportSshPublicKey
s@ImportSshPublicKey' {} Text
a -> ImportSshPublicKey
s {$sel:sshPublicKeyBody:ImportSshPublicKey' :: Text
sshPublicKeyBody = Text
a} :: ImportSshPublicKey)

-- | The name of the user account that is assigned to one or more servers.
importSshPublicKey_userName :: Lens.Lens' ImportSshPublicKey Prelude.Text
importSshPublicKey_userName :: Lens' ImportSshPublicKey Text
importSshPublicKey_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSshPublicKey' {Text
userName :: Text
$sel:userName:ImportSshPublicKey' :: ImportSshPublicKey -> Text
userName} -> Text
userName) (\s :: ImportSshPublicKey
s@ImportSshPublicKey' {} Text
a -> ImportSshPublicKey
s {$sel:userName:ImportSshPublicKey' :: Text
userName = Text
a} :: ImportSshPublicKey)

instance Core.AWSRequest ImportSshPublicKey where
  type
    AWSResponse ImportSshPublicKey =
      ImportSshPublicKeyResponse
  request :: (Service -> Service)
-> ImportSshPublicKey -> Request ImportSshPublicKey
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 ImportSshPublicKey
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportSshPublicKey)))
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 ->
          Int -> Text -> Text -> Text -> ImportSshPublicKeyResponse
ImportSshPublicKeyResponse'
            forall (f :: * -> *) a b. Functor 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ServerId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"SshPublicKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"UserName")
      )

instance Prelude.Hashable ImportSshPublicKey where
  hashWithSalt :: Int -> ImportSshPublicKey -> Int
hashWithSalt Int
_salt ImportSshPublicKey' {Text
userName :: Text
sshPublicKeyBody :: Text
serverId :: Text
$sel:userName:ImportSshPublicKey' :: ImportSshPublicKey -> Text
$sel:sshPublicKeyBody:ImportSshPublicKey' :: ImportSshPublicKey -> Text
$sel:serverId:ImportSshPublicKey' :: ImportSshPublicKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sshPublicKeyBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName

instance Prelude.NFData ImportSshPublicKey where
  rnf :: ImportSshPublicKey -> ()
rnf ImportSshPublicKey' {Text
userName :: Text
sshPublicKeyBody :: Text
serverId :: Text
$sel:userName:ImportSshPublicKey' :: ImportSshPublicKey -> Text
$sel:sshPublicKeyBody:ImportSshPublicKey' :: ImportSshPublicKey -> Text
$sel:serverId:ImportSshPublicKey' :: ImportSshPublicKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
serverId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sshPublicKeyBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userName

instance Data.ToHeaders ImportSshPublicKey where
  toHeaders :: ImportSshPublicKey -> 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
"TransferService.ImportSshPublicKey" ::
                          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 ImportSshPublicKey where
  toJSON :: ImportSshPublicKey -> Value
toJSON ImportSshPublicKey' {Text
userName :: Text
sshPublicKeyBody :: Text
serverId :: Text
$sel:userName:ImportSshPublicKey' :: ImportSshPublicKey -> Text
$sel:sshPublicKeyBody:ImportSshPublicKey' :: ImportSshPublicKey -> Text
$sel:serverId:ImportSshPublicKey' :: ImportSshPublicKey -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ServerId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serverId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SshPublicKeyBody" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sshPublicKeyBody),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userName)
          ]
      )

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

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

-- | Identifies the user, the server they belong to, and the identifier of
-- the SSH public key associated with that user. A user can have more than
-- one key on each server that they are associated with.
--
-- /See:/ 'newImportSshPublicKeyResponse' smart constructor.
data ImportSshPublicKeyResponse = ImportSshPublicKeyResponse'
  { -- | The response's http status code.
    ImportSshPublicKeyResponse -> Int
httpStatus :: Prelude.Int,
    -- | A system-assigned unique identifier for a server.
    ImportSshPublicKeyResponse -> Text
serverId :: Prelude.Text,
    -- | The name given to a public key by the system that was imported.
    ImportSshPublicKeyResponse -> Text
sshPublicKeyId :: Prelude.Text,
    -- | A user name assigned to the @ServerID@ value that you specified.
    ImportSshPublicKeyResponse -> Text
userName :: Prelude.Text
  }
  deriving (ImportSshPublicKeyResponse -> ImportSshPublicKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSshPublicKeyResponse -> ImportSshPublicKeyResponse -> Bool
$c/= :: ImportSshPublicKeyResponse -> ImportSshPublicKeyResponse -> Bool
== :: ImportSshPublicKeyResponse -> ImportSshPublicKeyResponse -> Bool
$c== :: ImportSshPublicKeyResponse -> ImportSshPublicKeyResponse -> Bool
Prelude.Eq, ReadPrec [ImportSshPublicKeyResponse]
ReadPrec ImportSshPublicKeyResponse
Int -> ReadS ImportSshPublicKeyResponse
ReadS [ImportSshPublicKeyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportSshPublicKeyResponse]
$creadListPrec :: ReadPrec [ImportSshPublicKeyResponse]
readPrec :: ReadPrec ImportSshPublicKeyResponse
$creadPrec :: ReadPrec ImportSshPublicKeyResponse
readList :: ReadS [ImportSshPublicKeyResponse]
$creadList :: ReadS [ImportSshPublicKeyResponse]
readsPrec :: Int -> ReadS ImportSshPublicKeyResponse
$creadsPrec :: Int -> ReadS ImportSshPublicKeyResponse
Prelude.Read, Int -> ImportSshPublicKeyResponse -> ShowS
[ImportSshPublicKeyResponse] -> ShowS
ImportSshPublicKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportSshPublicKeyResponse] -> ShowS
$cshowList :: [ImportSshPublicKeyResponse] -> ShowS
show :: ImportSshPublicKeyResponse -> String
$cshow :: ImportSshPublicKeyResponse -> String
showsPrec :: Int -> ImportSshPublicKeyResponse -> ShowS
$cshowsPrec :: Int -> ImportSshPublicKeyResponse -> ShowS
Prelude.Show, forall x.
Rep ImportSshPublicKeyResponse x -> ImportSshPublicKeyResponse
forall x.
ImportSshPublicKeyResponse -> Rep ImportSshPublicKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ImportSshPublicKeyResponse x -> ImportSshPublicKeyResponse
$cfrom :: forall x.
ImportSshPublicKeyResponse -> Rep ImportSshPublicKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportSshPublicKeyResponse' 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:
--
-- 'httpStatus', 'importSshPublicKeyResponse_httpStatus' - The response's http status code.
--
-- 'serverId', 'importSshPublicKeyResponse_serverId' - A system-assigned unique identifier for a server.
--
-- 'sshPublicKeyId', 'importSshPublicKeyResponse_sshPublicKeyId' - The name given to a public key by the system that was imported.
--
-- 'userName', 'importSshPublicKeyResponse_userName' - A user name assigned to the @ServerID@ value that you specified.
newImportSshPublicKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'serverId'
  Prelude.Text ->
  -- | 'sshPublicKeyId'
  Prelude.Text ->
  -- | 'userName'
  Prelude.Text ->
  ImportSshPublicKeyResponse
newImportSshPublicKeyResponse :: Int -> Text -> Text -> Text -> ImportSshPublicKeyResponse
newImportSshPublicKeyResponse
  Int
pHttpStatus_
  Text
pServerId_
  Text
pSshPublicKeyId_
  Text
pUserName_ =
    ImportSshPublicKeyResponse'
      { $sel:httpStatus:ImportSshPublicKeyResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:serverId:ImportSshPublicKeyResponse' :: Text
serverId = Text
pServerId_,
        $sel:sshPublicKeyId:ImportSshPublicKeyResponse' :: Text
sshPublicKeyId = Text
pSshPublicKeyId_,
        $sel:userName:ImportSshPublicKeyResponse' :: Text
userName = Text
pUserName_
      }

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

-- | A system-assigned unique identifier for a server.
importSshPublicKeyResponse_serverId :: Lens.Lens' ImportSshPublicKeyResponse Prelude.Text
importSshPublicKeyResponse_serverId :: Lens' ImportSshPublicKeyResponse Text
importSshPublicKeyResponse_serverId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSshPublicKeyResponse' {Text
serverId :: Text
$sel:serverId:ImportSshPublicKeyResponse' :: ImportSshPublicKeyResponse -> Text
serverId} -> Text
serverId) (\s :: ImportSshPublicKeyResponse
s@ImportSshPublicKeyResponse' {} Text
a -> ImportSshPublicKeyResponse
s {$sel:serverId:ImportSshPublicKeyResponse' :: Text
serverId = Text
a} :: ImportSshPublicKeyResponse)

-- | The name given to a public key by the system that was imported.
importSshPublicKeyResponse_sshPublicKeyId :: Lens.Lens' ImportSshPublicKeyResponse Prelude.Text
importSshPublicKeyResponse_sshPublicKeyId :: Lens' ImportSshPublicKeyResponse Text
importSshPublicKeyResponse_sshPublicKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSshPublicKeyResponse' {Text
sshPublicKeyId :: Text
$sel:sshPublicKeyId:ImportSshPublicKeyResponse' :: ImportSshPublicKeyResponse -> Text
sshPublicKeyId} -> Text
sshPublicKeyId) (\s :: ImportSshPublicKeyResponse
s@ImportSshPublicKeyResponse' {} Text
a -> ImportSshPublicKeyResponse
s {$sel:sshPublicKeyId:ImportSshPublicKeyResponse' :: Text
sshPublicKeyId = Text
a} :: ImportSshPublicKeyResponse)

-- | A user name assigned to the @ServerID@ value that you specified.
importSshPublicKeyResponse_userName :: Lens.Lens' ImportSshPublicKeyResponse Prelude.Text
importSshPublicKeyResponse_userName :: Lens' ImportSshPublicKeyResponse Text
importSshPublicKeyResponse_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportSshPublicKeyResponse' {Text
userName :: Text
$sel:userName:ImportSshPublicKeyResponse' :: ImportSshPublicKeyResponse -> Text
userName} -> Text
userName) (\s :: ImportSshPublicKeyResponse
s@ImportSshPublicKeyResponse' {} Text
a -> ImportSshPublicKeyResponse
s {$sel:userName:ImportSshPublicKeyResponse' :: Text
userName = Text
a} :: ImportSshPublicKeyResponse)

instance Prelude.NFData ImportSshPublicKeyResponse where
  rnf :: ImportSshPublicKeyResponse -> ()
rnf ImportSshPublicKeyResponse' {Int
Text
userName :: Text
sshPublicKeyId :: Text
serverId :: Text
httpStatus :: Int
$sel:userName:ImportSshPublicKeyResponse' :: ImportSshPublicKeyResponse -> Text
$sel:sshPublicKeyId:ImportSshPublicKeyResponse' :: ImportSshPublicKeyResponse -> Text
$sel:serverId:ImportSshPublicKeyResponse' :: ImportSshPublicKeyResponse -> Text
$sel:httpStatus:ImportSshPublicKeyResponse' :: ImportSshPublicKeyResponse -> Int
..} =
    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
serverId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sshPublicKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userName