{-# 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.DescribeHostKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the details of the host key that\'s specified by the @HostKeyId@
-- and @ServerId@.
module Amazonka.Transfer.DescribeHostKey
  ( -- * Creating a Request
    DescribeHostKey (..),
    newDescribeHostKey,

    -- * Request Lenses
    describeHostKey_serverId,
    describeHostKey_hostKeyId,

    -- * Destructuring the Response
    DescribeHostKeyResponse (..),
    newDescribeHostKeyResponse,

    -- * Response Lenses
    describeHostKeyResponse_httpStatus,
    describeHostKeyResponse_hostKey,
  )
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:/ 'newDescribeHostKey' smart constructor.
data DescribeHostKey = DescribeHostKey'
  { -- | The identifier of the server that contains the host key that you want
    -- described.
    DescribeHostKey -> Text
serverId :: Prelude.Text,
    -- | The identifier of the host key that you want described.
    DescribeHostKey -> Text
hostKeyId :: Prelude.Text
  }
  deriving (DescribeHostKey -> DescribeHostKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeHostKey -> DescribeHostKey -> Bool
$c/= :: DescribeHostKey -> DescribeHostKey -> Bool
== :: DescribeHostKey -> DescribeHostKey -> Bool
$c== :: DescribeHostKey -> DescribeHostKey -> Bool
Prelude.Eq, ReadPrec [DescribeHostKey]
ReadPrec DescribeHostKey
Int -> ReadS DescribeHostKey
ReadS [DescribeHostKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeHostKey]
$creadListPrec :: ReadPrec [DescribeHostKey]
readPrec :: ReadPrec DescribeHostKey
$creadPrec :: ReadPrec DescribeHostKey
readList :: ReadS [DescribeHostKey]
$creadList :: ReadS [DescribeHostKey]
readsPrec :: Int -> ReadS DescribeHostKey
$creadsPrec :: Int -> ReadS DescribeHostKey
Prelude.Read, Int -> DescribeHostKey -> ShowS
[DescribeHostKey] -> ShowS
DescribeHostKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeHostKey] -> ShowS
$cshowList :: [DescribeHostKey] -> ShowS
show :: DescribeHostKey -> String
$cshow :: DescribeHostKey -> String
showsPrec :: Int -> DescribeHostKey -> ShowS
$cshowsPrec :: Int -> DescribeHostKey -> ShowS
Prelude.Show, forall x. Rep DescribeHostKey x -> DescribeHostKey
forall x. DescribeHostKey -> Rep DescribeHostKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeHostKey x -> DescribeHostKey
$cfrom :: forall x. DescribeHostKey -> Rep DescribeHostKey x
Prelude.Generic)

-- |
-- Create a value of 'DescribeHostKey' 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', 'describeHostKey_serverId' - The identifier of the server that contains the host key that you want
-- described.
--
-- 'hostKeyId', 'describeHostKey_hostKeyId' - The identifier of the host key that you want described.
newDescribeHostKey ::
  -- | 'serverId'
  Prelude.Text ->
  -- | 'hostKeyId'
  Prelude.Text ->
  DescribeHostKey
newDescribeHostKey :: Text -> Text -> DescribeHostKey
newDescribeHostKey Text
pServerId_ Text
pHostKeyId_ =
  DescribeHostKey'
    { $sel:serverId:DescribeHostKey' :: Text
serverId = Text
pServerId_,
      $sel:hostKeyId:DescribeHostKey' :: Text
hostKeyId = Text
pHostKeyId_
    }

-- | The identifier of the server that contains the host key that you want
-- described.
describeHostKey_serverId :: Lens.Lens' DescribeHostKey Prelude.Text
describeHostKey_serverId :: Lens' DescribeHostKey Text
describeHostKey_serverId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeHostKey' {Text
serverId :: Text
$sel:serverId:DescribeHostKey' :: DescribeHostKey -> Text
serverId} -> Text
serverId) (\s :: DescribeHostKey
s@DescribeHostKey' {} Text
a -> DescribeHostKey
s {$sel:serverId:DescribeHostKey' :: Text
serverId = Text
a} :: DescribeHostKey)

-- | The identifier of the host key that you want described.
describeHostKey_hostKeyId :: Lens.Lens' DescribeHostKey Prelude.Text
describeHostKey_hostKeyId :: Lens' DescribeHostKey Text
describeHostKey_hostKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeHostKey' {Text
hostKeyId :: Text
$sel:hostKeyId:DescribeHostKey' :: DescribeHostKey -> Text
hostKeyId} -> Text
hostKeyId) (\s :: DescribeHostKey
s@DescribeHostKey' {} Text
a -> DescribeHostKey
s {$sel:hostKeyId:DescribeHostKey' :: Text
hostKeyId = Text
a} :: DescribeHostKey)

instance Core.AWSRequest DescribeHostKey where
  type
    AWSResponse DescribeHostKey =
      DescribeHostKeyResponse
  request :: (Service -> Service) -> DescribeHostKey -> Request DescribeHostKey
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 DescribeHostKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeHostKey)))
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 -> DescribedHostKey -> DescribeHostKeyResponse
DescribeHostKeyResponse'
            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
"HostKey")
      )

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

instance Prelude.NFData DescribeHostKey where
  rnf :: DescribeHostKey -> ()
rnf DescribeHostKey' {Text
hostKeyId :: Text
serverId :: Text
$sel:hostKeyId:DescribeHostKey' :: DescribeHostKey -> Text
$sel:serverId:DescribeHostKey' :: DescribeHostKey -> 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
hostKeyId

instance Data.ToHeaders DescribeHostKey where
  toHeaders :: DescribeHostKey -> 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.DescribeHostKey" ::
                          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 DescribeHostKey where
  toJSON :: DescribeHostKey -> Value
toJSON DescribeHostKey' {Text
hostKeyId :: Text
serverId :: Text
$sel:hostKeyId:DescribeHostKey' :: DescribeHostKey -> Text
$sel:serverId:DescribeHostKey' :: DescribeHostKey -> 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
"HostKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hostKeyId)
          ]
      )

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

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

-- | /See:/ 'newDescribeHostKeyResponse' smart constructor.
data DescribeHostKeyResponse = DescribeHostKeyResponse'
  { -- | The response's http status code.
    DescribeHostKeyResponse -> Int
httpStatus :: Prelude.Int,
    -- | Returns the details for the specified host key.
    DescribeHostKeyResponse -> DescribedHostKey
hostKey :: DescribedHostKey
  }
  deriving (DescribeHostKeyResponse -> DescribeHostKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeHostKeyResponse -> DescribeHostKeyResponse -> Bool
$c/= :: DescribeHostKeyResponse -> DescribeHostKeyResponse -> Bool
== :: DescribeHostKeyResponse -> DescribeHostKeyResponse -> Bool
$c== :: DescribeHostKeyResponse -> DescribeHostKeyResponse -> Bool
Prelude.Eq, ReadPrec [DescribeHostKeyResponse]
ReadPrec DescribeHostKeyResponse
Int -> ReadS DescribeHostKeyResponse
ReadS [DescribeHostKeyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeHostKeyResponse]
$creadListPrec :: ReadPrec [DescribeHostKeyResponse]
readPrec :: ReadPrec DescribeHostKeyResponse
$creadPrec :: ReadPrec DescribeHostKeyResponse
readList :: ReadS [DescribeHostKeyResponse]
$creadList :: ReadS [DescribeHostKeyResponse]
readsPrec :: Int -> ReadS DescribeHostKeyResponse
$creadsPrec :: Int -> ReadS DescribeHostKeyResponse
Prelude.Read, Int -> DescribeHostKeyResponse -> ShowS
[DescribeHostKeyResponse] -> ShowS
DescribeHostKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeHostKeyResponse] -> ShowS
$cshowList :: [DescribeHostKeyResponse] -> ShowS
show :: DescribeHostKeyResponse -> String
$cshow :: DescribeHostKeyResponse -> String
showsPrec :: Int -> DescribeHostKeyResponse -> ShowS
$cshowsPrec :: Int -> DescribeHostKeyResponse -> ShowS
Prelude.Show, forall x. Rep DescribeHostKeyResponse x -> DescribeHostKeyResponse
forall x. DescribeHostKeyResponse -> Rep DescribeHostKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeHostKeyResponse x -> DescribeHostKeyResponse
$cfrom :: forall x. DescribeHostKeyResponse -> Rep DescribeHostKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeHostKeyResponse' 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', 'describeHostKeyResponse_httpStatus' - The response's http status code.
--
-- 'hostKey', 'describeHostKeyResponse_hostKey' - Returns the details for the specified host key.
newDescribeHostKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'hostKey'
  DescribedHostKey ->
  DescribeHostKeyResponse
newDescribeHostKeyResponse :: Int -> DescribedHostKey -> DescribeHostKeyResponse
newDescribeHostKeyResponse Int
pHttpStatus_ DescribedHostKey
pHostKey_ =
  DescribeHostKeyResponse'
    { $sel:httpStatus:DescribeHostKeyResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:hostKey:DescribeHostKeyResponse' :: DescribedHostKey
hostKey = DescribedHostKey
pHostKey_
    }

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

-- | Returns the details for the specified host key.
describeHostKeyResponse_hostKey :: Lens.Lens' DescribeHostKeyResponse DescribedHostKey
describeHostKeyResponse_hostKey :: Lens' DescribeHostKeyResponse DescribedHostKey
describeHostKeyResponse_hostKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeHostKeyResponse' {DescribedHostKey
hostKey :: DescribedHostKey
$sel:hostKey:DescribeHostKeyResponse' :: DescribeHostKeyResponse -> DescribedHostKey
hostKey} -> DescribedHostKey
hostKey) (\s :: DescribeHostKeyResponse
s@DescribeHostKeyResponse' {} DescribedHostKey
a -> DescribeHostKeyResponse
s {$sel:hostKey:DescribeHostKeyResponse' :: DescribedHostKey
hostKey = DescribedHostKey
a} :: DescribeHostKeyResponse)

instance Prelude.NFData DescribeHostKeyResponse where
  rnf :: DescribeHostKeyResponse -> ()
rnf DescribeHostKeyResponse' {Int
DescribedHostKey
hostKey :: DescribedHostKey
httpStatus :: Int
$sel:hostKey:DescribeHostKeyResponse' :: DescribeHostKeyResponse -> DescribedHostKey
$sel:httpStatus:DescribeHostKeyResponse' :: DescribeHostKeyResponse -> 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 DescribedHostKey
hostKey