{-# 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.MigrationHubStrategy.UpdateServerConfig
-- 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 configuration of the specified server.
module Amazonka.MigrationHubStrategy.UpdateServerConfig
  ( -- * Creating a Request
    UpdateServerConfig (..),
    newUpdateServerConfig,

    -- * Request Lenses
    updateServerConfig_strategyOption,
    updateServerConfig_serverId,

    -- * Destructuring the Response
    UpdateServerConfigResponse (..),
    newUpdateServerConfigResponse,

    -- * Response Lenses
    updateServerConfigResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateServerConfig' smart constructor.
data UpdateServerConfig = UpdateServerConfig'
  { -- | The preferred strategy options for the application component. See the
    -- response from GetServerStrategies.
    UpdateServerConfig -> Maybe StrategyOption
strategyOption :: Prelude.Maybe StrategyOption,
    -- | The ID of the server.
    UpdateServerConfig -> Text
serverId :: Prelude.Text
  }
  deriving (UpdateServerConfig -> UpdateServerConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServerConfig -> UpdateServerConfig -> Bool
$c/= :: UpdateServerConfig -> UpdateServerConfig -> Bool
== :: UpdateServerConfig -> UpdateServerConfig -> Bool
$c== :: UpdateServerConfig -> UpdateServerConfig -> Bool
Prelude.Eq, ReadPrec [UpdateServerConfig]
ReadPrec UpdateServerConfig
Int -> ReadS UpdateServerConfig
ReadS [UpdateServerConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateServerConfig]
$creadListPrec :: ReadPrec [UpdateServerConfig]
readPrec :: ReadPrec UpdateServerConfig
$creadPrec :: ReadPrec UpdateServerConfig
readList :: ReadS [UpdateServerConfig]
$creadList :: ReadS [UpdateServerConfig]
readsPrec :: Int -> ReadS UpdateServerConfig
$creadsPrec :: Int -> ReadS UpdateServerConfig
Prelude.Read, Int -> UpdateServerConfig -> ShowS
[UpdateServerConfig] -> ShowS
UpdateServerConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServerConfig] -> ShowS
$cshowList :: [UpdateServerConfig] -> ShowS
show :: UpdateServerConfig -> String
$cshow :: UpdateServerConfig -> String
showsPrec :: Int -> UpdateServerConfig -> ShowS
$cshowsPrec :: Int -> UpdateServerConfig -> ShowS
Prelude.Show, forall x. Rep UpdateServerConfig x -> UpdateServerConfig
forall x. UpdateServerConfig -> Rep UpdateServerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateServerConfig x -> UpdateServerConfig
$cfrom :: forall x. UpdateServerConfig -> Rep UpdateServerConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServerConfig' 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:
--
-- 'strategyOption', 'updateServerConfig_strategyOption' - The preferred strategy options for the application component. See the
-- response from GetServerStrategies.
--
-- 'serverId', 'updateServerConfig_serverId' - The ID of the server.
newUpdateServerConfig ::
  -- | 'serverId'
  Prelude.Text ->
  UpdateServerConfig
newUpdateServerConfig :: Text -> UpdateServerConfig
newUpdateServerConfig Text
pServerId_ =
  UpdateServerConfig'
    { $sel:strategyOption:UpdateServerConfig' :: Maybe StrategyOption
strategyOption =
        forall a. Maybe a
Prelude.Nothing,
      $sel:serverId:UpdateServerConfig' :: Text
serverId = Text
pServerId_
    }

-- | The preferred strategy options for the application component. See the
-- response from GetServerStrategies.
updateServerConfig_strategyOption :: Lens.Lens' UpdateServerConfig (Prelude.Maybe StrategyOption)
updateServerConfig_strategyOption :: Lens' UpdateServerConfig (Maybe StrategyOption)
updateServerConfig_strategyOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServerConfig' {Maybe StrategyOption
strategyOption :: Maybe StrategyOption
$sel:strategyOption:UpdateServerConfig' :: UpdateServerConfig -> Maybe StrategyOption
strategyOption} -> Maybe StrategyOption
strategyOption) (\s :: UpdateServerConfig
s@UpdateServerConfig' {} Maybe StrategyOption
a -> UpdateServerConfig
s {$sel:strategyOption:UpdateServerConfig' :: Maybe StrategyOption
strategyOption = Maybe StrategyOption
a} :: UpdateServerConfig)

-- | The ID of the server.
updateServerConfig_serverId :: Lens.Lens' UpdateServerConfig Prelude.Text
updateServerConfig_serverId :: Lens' UpdateServerConfig Text
updateServerConfig_serverId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServerConfig' {Text
serverId :: Text
$sel:serverId:UpdateServerConfig' :: UpdateServerConfig -> Text
serverId} -> Text
serverId) (\s :: UpdateServerConfig
s@UpdateServerConfig' {} Text
a -> UpdateServerConfig
s {$sel:serverId:UpdateServerConfig' :: Text
serverId = Text
a} :: UpdateServerConfig)

instance Core.AWSRequest UpdateServerConfig where
  type
    AWSResponse UpdateServerConfig =
      UpdateServerConfigResponse
  request :: (Service -> Service)
-> UpdateServerConfig -> Request UpdateServerConfig
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 UpdateServerConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateServerConfig)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateServerConfigResponse
UpdateServerConfigResponse'
            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))
      )

instance Prelude.Hashable UpdateServerConfig where
  hashWithSalt :: Int -> UpdateServerConfig -> Int
hashWithSalt Int
_salt UpdateServerConfig' {Maybe StrategyOption
Text
serverId :: Text
strategyOption :: Maybe StrategyOption
$sel:serverId:UpdateServerConfig' :: UpdateServerConfig -> Text
$sel:strategyOption:UpdateServerConfig' :: UpdateServerConfig -> Maybe StrategyOption
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StrategyOption
strategyOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverId

instance Prelude.NFData UpdateServerConfig where
  rnf :: UpdateServerConfig -> ()
rnf UpdateServerConfig' {Maybe StrategyOption
Text
serverId :: Text
strategyOption :: Maybe StrategyOption
$sel:serverId:UpdateServerConfig' :: UpdateServerConfig -> Text
$sel:strategyOption:UpdateServerConfig' :: UpdateServerConfig -> Maybe StrategyOption
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe StrategyOption
strategyOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serverId

instance Data.ToHeaders UpdateServerConfig where
  toHeaders :: UpdateServerConfig -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateServerConfig where
  toJSON :: UpdateServerConfig -> Value
toJSON UpdateServerConfig' {Maybe StrategyOption
Text
serverId :: Text
strategyOption :: Maybe StrategyOption
$sel:serverId:UpdateServerConfig' :: UpdateServerConfig -> Text
$sel:strategyOption:UpdateServerConfig' :: UpdateServerConfig -> Maybe StrategyOption
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"strategyOption" 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 StrategyOption
strategyOption,
            forall a. a -> Maybe a
Prelude.Just (Key
"serverId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serverId)
          ]
      )

instance Data.ToPath UpdateServerConfig where
  toPath :: UpdateServerConfig -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/update-server-config/"

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

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

-- |
-- Create a value of 'UpdateServerConfigResponse' 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', 'updateServerConfigResponse_httpStatus' - The response's http status code.
newUpdateServerConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateServerConfigResponse
newUpdateServerConfigResponse :: Int -> UpdateServerConfigResponse
newUpdateServerConfigResponse Int
pHttpStatus_ =
  UpdateServerConfigResponse'
    { $sel:httpStatus:UpdateServerConfigResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateServerConfigResponse where
  rnf :: UpdateServerConfigResponse -> ()
rnf UpdateServerConfigResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateServerConfigResponse' :: UpdateServerConfigResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus