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

    -- * Request Lenses
    updateHostKey_serverId,
    updateHostKey_hostKeyId,
    updateHostKey_description,

    -- * Destructuring the Response
    UpdateHostKeyResponse (..),
    newUpdateHostKeyResponse,

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

-- |
-- Create a value of 'UpdateHostKey' 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', 'updateHostKey_serverId' - The identifier of the server that contains the host key that you are
-- updating.
--
-- 'hostKeyId', 'updateHostKey_hostKeyId' - The identifier of the host key that you are updating.
--
-- 'description', 'updateHostKey_description' - An updated description for the host key.
newUpdateHostKey ::
  -- | 'serverId'
  Prelude.Text ->
  -- | 'hostKeyId'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  UpdateHostKey
newUpdateHostKey :: Text -> Text -> Text -> UpdateHostKey
newUpdateHostKey Text
pServerId_ Text
pHostKeyId_ Text
pDescription_ =
  UpdateHostKey'
    { $sel:serverId:UpdateHostKey' :: Text
serverId = Text
pServerId_,
      $sel:hostKeyId:UpdateHostKey' :: Text
hostKeyId = Text
pHostKeyId_,
      $sel:description:UpdateHostKey' :: Text
description = Text
pDescription_
    }

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

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

-- | An updated description for the host key.
updateHostKey_description :: Lens.Lens' UpdateHostKey Prelude.Text
updateHostKey_description :: Lens' UpdateHostKey Text
updateHostKey_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateHostKey' {Text
description :: Text
$sel:description:UpdateHostKey' :: UpdateHostKey -> Text
description} -> Text
description) (\s :: UpdateHostKey
s@UpdateHostKey' {} Text
a -> UpdateHostKey
s {$sel:description:UpdateHostKey' :: Text
description = Text
a} :: UpdateHostKey)

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

instance Prelude.Hashable UpdateHostKey where
  hashWithSalt :: Int -> UpdateHostKey -> Int
hashWithSalt Int
_salt UpdateHostKey' {Text
description :: Text
hostKeyId :: Text
serverId :: Text
$sel:description:UpdateHostKey' :: UpdateHostKey -> Text
$sel:hostKeyId:UpdateHostKey' :: UpdateHostKey -> Text
$sel:serverId:UpdateHostKey' :: UpdateHostKey -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description

instance Prelude.NFData UpdateHostKey where
  rnf :: UpdateHostKey -> ()
rnf UpdateHostKey' {Text
description :: Text
hostKeyId :: Text
serverId :: Text
$sel:description:UpdateHostKey' :: UpdateHostKey -> Text
$sel:hostKeyId:UpdateHostKey' :: UpdateHostKey -> Text
$sel:serverId:UpdateHostKey' :: UpdateHostKey -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description

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

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

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

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

-- |
-- Create a value of 'UpdateHostKeyResponse' 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', 'updateHostKeyResponse_httpStatus' - The response's http status code.
--
-- 'serverId', 'updateHostKeyResponse_serverId' - Returns the server identifier for the server that contains the updated
-- host key.
--
-- 'hostKeyId', 'updateHostKeyResponse_hostKeyId' - Returns the host key identifier for the updated host key.
newUpdateHostKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'serverId'
  Prelude.Text ->
  -- | 'hostKeyId'
  Prelude.Text ->
  UpdateHostKeyResponse
newUpdateHostKeyResponse :: Int -> Text -> Text -> UpdateHostKeyResponse
newUpdateHostKeyResponse
  Int
pHttpStatus_
  Text
pServerId_
  Text
pHostKeyId_ =
    UpdateHostKeyResponse'
      { $sel:httpStatus:UpdateHostKeyResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:serverId:UpdateHostKeyResponse' :: Text
serverId = Text
pServerId_,
        $sel:hostKeyId:UpdateHostKeyResponse' :: Text
hostKeyId = Text
pHostKeyId_
      }

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

-- | Returns the server identifier for the server that contains the updated
-- host key.
updateHostKeyResponse_serverId :: Lens.Lens' UpdateHostKeyResponse Prelude.Text
updateHostKeyResponse_serverId :: Lens' UpdateHostKeyResponse Text
updateHostKeyResponse_serverId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateHostKeyResponse' {Text
serverId :: Text
$sel:serverId:UpdateHostKeyResponse' :: UpdateHostKeyResponse -> Text
serverId} -> Text
serverId) (\s :: UpdateHostKeyResponse
s@UpdateHostKeyResponse' {} Text
a -> UpdateHostKeyResponse
s {$sel:serverId:UpdateHostKeyResponse' :: Text
serverId = Text
a} :: UpdateHostKeyResponse)

-- | Returns the host key identifier for the updated host key.
updateHostKeyResponse_hostKeyId :: Lens.Lens' UpdateHostKeyResponse Prelude.Text
updateHostKeyResponse_hostKeyId :: Lens' UpdateHostKeyResponse Text
updateHostKeyResponse_hostKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateHostKeyResponse' {Text
hostKeyId :: Text
$sel:hostKeyId:UpdateHostKeyResponse' :: UpdateHostKeyResponse -> Text
hostKeyId} -> Text
hostKeyId) (\s :: UpdateHostKeyResponse
s@UpdateHostKeyResponse' {} Text
a -> UpdateHostKeyResponse
s {$sel:hostKeyId:UpdateHostKeyResponse' :: Text
hostKeyId = Text
a} :: UpdateHostKeyResponse)

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