{-# 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.CodeStarConnections.UpdateHost
-- 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 a specified host with the provided configurations.
module Amazonka.CodeStarConnections.UpdateHost
  ( -- * Creating a Request
    UpdateHost (..),
    newUpdateHost,

    -- * Request Lenses
    updateHost_providerEndpoint,
    updateHost_vpcConfiguration,
    updateHost_hostArn,

    -- * Destructuring the Response
    UpdateHostResponse (..),
    newUpdateHostResponse,

    -- * Response Lenses
    updateHostResponse_httpStatus,
  )
where

import Amazonka.CodeStarConnections.Types
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

-- | /See:/ 'newUpdateHost' smart constructor.
data UpdateHost = UpdateHost'
  { -- | The URL or endpoint of the host to be updated.
    UpdateHost -> Maybe Text
providerEndpoint :: Prelude.Maybe Prelude.Text,
    -- | The VPC configuration of the host to be updated. A VPC must be
    -- configured and the infrastructure to be represented by the host must
    -- already be connected to the VPC.
    UpdateHost -> Maybe VpcConfiguration
vpcConfiguration :: Prelude.Maybe VpcConfiguration,
    -- | The Amazon Resource Name (ARN) of the host to be updated.
    UpdateHost -> Text
hostArn :: Prelude.Text
  }
  deriving (UpdateHost -> UpdateHost -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateHost -> UpdateHost -> Bool
$c/= :: UpdateHost -> UpdateHost -> Bool
== :: UpdateHost -> UpdateHost -> Bool
$c== :: UpdateHost -> UpdateHost -> Bool
Prelude.Eq, ReadPrec [UpdateHost]
ReadPrec UpdateHost
Int -> ReadS UpdateHost
ReadS [UpdateHost]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateHost]
$creadListPrec :: ReadPrec [UpdateHost]
readPrec :: ReadPrec UpdateHost
$creadPrec :: ReadPrec UpdateHost
readList :: ReadS [UpdateHost]
$creadList :: ReadS [UpdateHost]
readsPrec :: Int -> ReadS UpdateHost
$creadsPrec :: Int -> ReadS UpdateHost
Prelude.Read, Int -> UpdateHost -> ShowS
[UpdateHost] -> ShowS
UpdateHost -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateHost] -> ShowS
$cshowList :: [UpdateHost] -> ShowS
show :: UpdateHost -> String
$cshow :: UpdateHost -> String
showsPrec :: Int -> UpdateHost -> ShowS
$cshowsPrec :: Int -> UpdateHost -> ShowS
Prelude.Show, forall x. Rep UpdateHost x -> UpdateHost
forall x. UpdateHost -> Rep UpdateHost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateHost x -> UpdateHost
$cfrom :: forall x. UpdateHost -> Rep UpdateHost x
Prelude.Generic)

-- |
-- Create a value of 'UpdateHost' 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:
--
-- 'providerEndpoint', 'updateHost_providerEndpoint' - The URL or endpoint of the host to be updated.
--
-- 'vpcConfiguration', 'updateHost_vpcConfiguration' - The VPC configuration of the host to be updated. A VPC must be
-- configured and the infrastructure to be represented by the host must
-- already be connected to the VPC.
--
-- 'hostArn', 'updateHost_hostArn' - The Amazon Resource Name (ARN) of the host to be updated.
newUpdateHost ::
  -- | 'hostArn'
  Prelude.Text ->
  UpdateHost
newUpdateHost :: Text -> UpdateHost
newUpdateHost Text
pHostArn_ =
  UpdateHost'
    { $sel:providerEndpoint:UpdateHost' :: Maybe Text
providerEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfiguration:UpdateHost' :: Maybe VpcConfiguration
vpcConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:hostArn:UpdateHost' :: Text
hostArn = Text
pHostArn_
    }

-- | The URL or endpoint of the host to be updated.
updateHost_providerEndpoint :: Lens.Lens' UpdateHost (Prelude.Maybe Prelude.Text)
updateHost_providerEndpoint :: Lens' UpdateHost (Maybe Text)
updateHost_providerEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateHost' {Maybe Text
providerEndpoint :: Maybe Text
$sel:providerEndpoint:UpdateHost' :: UpdateHost -> Maybe Text
providerEndpoint} -> Maybe Text
providerEndpoint) (\s :: UpdateHost
s@UpdateHost' {} Maybe Text
a -> UpdateHost
s {$sel:providerEndpoint:UpdateHost' :: Maybe Text
providerEndpoint = Maybe Text
a} :: UpdateHost)

-- | The VPC configuration of the host to be updated. A VPC must be
-- configured and the infrastructure to be represented by the host must
-- already be connected to the VPC.
updateHost_vpcConfiguration :: Lens.Lens' UpdateHost (Prelude.Maybe VpcConfiguration)
updateHost_vpcConfiguration :: Lens' UpdateHost (Maybe VpcConfiguration)
updateHost_vpcConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateHost' {Maybe VpcConfiguration
vpcConfiguration :: Maybe VpcConfiguration
$sel:vpcConfiguration:UpdateHost' :: UpdateHost -> Maybe VpcConfiguration
vpcConfiguration} -> Maybe VpcConfiguration
vpcConfiguration) (\s :: UpdateHost
s@UpdateHost' {} Maybe VpcConfiguration
a -> UpdateHost
s {$sel:vpcConfiguration:UpdateHost' :: Maybe VpcConfiguration
vpcConfiguration = Maybe VpcConfiguration
a} :: UpdateHost)

-- | The Amazon Resource Name (ARN) of the host to be updated.
updateHost_hostArn :: Lens.Lens' UpdateHost Prelude.Text
updateHost_hostArn :: Lens' UpdateHost Text
updateHost_hostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateHost' {Text
hostArn :: Text
$sel:hostArn:UpdateHost' :: UpdateHost -> Text
hostArn} -> Text
hostArn) (\s :: UpdateHost
s@UpdateHost' {} Text
a -> UpdateHost
s {$sel:hostArn:UpdateHost' :: Text
hostArn = Text
a} :: UpdateHost)

instance Core.AWSRequest UpdateHost where
  type AWSResponse UpdateHost = UpdateHostResponse
  request :: (Service -> Service) -> UpdateHost -> Request UpdateHost
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 UpdateHost
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateHost)))
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 -> UpdateHostResponse
UpdateHostResponse'
            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 UpdateHost where
  hashWithSalt :: Int -> UpdateHost -> Int
hashWithSalt Int
_salt UpdateHost' {Maybe Text
Maybe VpcConfiguration
Text
hostArn :: Text
vpcConfiguration :: Maybe VpcConfiguration
providerEndpoint :: Maybe Text
$sel:hostArn:UpdateHost' :: UpdateHost -> Text
$sel:vpcConfiguration:UpdateHost' :: UpdateHost -> Maybe VpcConfiguration
$sel:providerEndpoint:UpdateHost' :: UpdateHost -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
providerEndpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfiguration
vpcConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hostArn

instance Prelude.NFData UpdateHost where
  rnf :: UpdateHost -> ()
rnf UpdateHost' {Maybe Text
Maybe VpcConfiguration
Text
hostArn :: Text
vpcConfiguration :: Maybe VpcConfiguration
providerEndpoint :: Maybe Text
$sel:hostArn:UpdateHost' :: UpdateHost -> Text
$sel:vpcConfiguration:UpdateHost' :: UpdateHost -> Maybe VpcConfiguration
$sel:providerEndpoint:UpdateHost' :: UpdateHost -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
providerEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfiguration
vpcConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hostArn

instance Data.ToHeaders UpdateHost where
  toHeaders :: UpdateHost -> 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
"com.amazonaws.codestar.connections.CodeStar_connections_20191201.UpdateHost" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateHost where
  toJSON :: UpdateHost -> Value
toJSON UpdateHost' {Maybe Text
Maybe VpcConfiguration
Text
hostArn :: Text
vpcConfiguration :: Maybe VpcConfiguration
providerEndpoint :: Maybe Text
$sel:hostArn:UpdateHost' :: UpdateHost -> Text
$sel:vpcConfiguration:UpdateHost' :: UpdateHost -> Maybe VpcConfiguration
$sel:providerEndpoint:UpdateHost' :: UpdateHost -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ProviderEndpoint" 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
providerEndpoint,
            (Key
"VpcConfiguration" 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 VpcConfiguration
vpcConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"HostArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hostArn)
          ]
      )

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

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

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

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

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

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