{-# 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.IoTSiteWise.UpdateGateway
-- 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 gateway\'s name.
module Amazonka.IoTSiteWise.UpdateGateway
  ( -- * Creating a Request
    UpdateGateway (..),
    newUpdateGateway,

    -- * Request Lenses
    updateGateway_gatewayId,
    updateGateway_gatewayName,

    -- * Destructuring the Response
    UpdateGatewayResponse (..),
    newUpdateGatewayResponse,
  )
where

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

-- | /See:/ 'newUpdateGateway' smart constructor.
data UpdateGateway = UpdateGateway'
  { -- | The ID of the gateway to update.
    UpdateGateway -> Text
gatewayId :: Prelude.Text,
    -- | A unique, friendly name for the gateway.
    UpdateGateway -> Text
gatewayName :: Prelude.Text
  }
  deriving (UpdateGateway -> UpdateGateway -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateGateway -> UpdateGateway -> Bool
$c/= :: UpdateGateway -> UpdateGateway -> Bool
== :: UpdateGateway -> UpdateGateway -> Bool
$c== :: UpdateGateway -> UpdateGateway -> Bool
Prelude.Eq, ReadPrec [UpdateGateway]
ReadPrec UpdateGateway
Int -> ReadS UpdateGateway
ReadS [UpdateGateway]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateGateway]
$creadListPrec :: ReadPrec [UpdateGateway]
readPrec :: ReadPrec UpdateGateway
$creadPrec :: ReadPrec UpdateGateway
readList :: ReadS [UpdateGateway]
$creadList :: ReadS [UpdateGateway]
readsPrec :: Int -> ReadS UpdateGateway
$creadsPrec :: Int -> ReadS UpdateGateway
Prelude.Read, Int -> UpdateGateway -> ShowS
[UpdateGateway] -> ShowS
UpdateGateway -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateGateway] -> ShowS
$cshowList :: [UpdateGateway] -> ShowS
show :: UpdateGateway -> String
$cshow :: UpdateGateway -> String
showsPrec :: Int -> UpdateGateway -> ShowS
$cshowsPrec :: Int -> UpdateGateway -> ShowS
Prelude.Show, forall x. Rep UpdateGateway x -> UpdateGateway
forall x. UpdateGateway -> Rep UpdateGateway x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateGateway x -> UpdateGateway
$cfrom :: forall x. UpdateGateway -> Rep UpdateGateway x
Prelude.Generic)

-- |
-- Create a value of 'UpdateGateway' 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:
--
-- 'gatewayId', 'updateGateway_gatewayId' - The ID of the gateway to update.
--
-- 'gatewayName', 'updateGateway_gatewayName' - A unique, friendly name for the gateway.
newUpdateGateway ::
  -- | 'gatewayId'
  Prelude.Text ->
  -- | 'gatewayName'
  Prelude.Text ->
  UpdateGateway
newUpdateGateway :: Text -> Text -> UpdateGateway
newUpdateGateway Text
pGatewayId_ Text
pGatewayName_ =
  UpdateGateway'
    { $sel:gatewayId:UpdateGateway' :: Text
gatewayId = Text
pGatewayId_,
      $sel:gatewayName:UpdateGateway' :: Text
gatewayName = Text
pGatewayName_
    }

-- | The ID of the gateway to update.
updateGateway_gatewayId :: Lens.Lens' UpdateGateway Prelude.Text
updateGateway_gatewayId :: Lens' UpdateGateway Text
updateGateway_gatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGateway' {Text
gatewayId :: Text
$sel:gatewayId:UpdateGateway' :: UpdateGateway -> Text
gatewayId} -> Text
gatewayId) (\s :: UpdateGateway
s@UpdateGateway' {} Text
a -> UpdateGateway
s {$sel:gatewayId:UpdateGateway' :: Text
gatewayId = Text
a} :: UpdateGateway)

-- | A unique, friendly name for the gateway.
updateGateway_gatewayName :: Lens.Lens' UpdateGateway Prelude.Text
updateGateway_gatewayName :: Lens' UpdateGateway Text
updateGateway_gatewayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGateway' {Text
gatewayName :: Text
$sel:gatewayName:UpdateGateway' :: UpdateGateway -> Text
gatewayName} -> Text
gatewayName) (\s :: UpdateGateway
s@UpdateGateway' {} Text
a -> UpdateGateway
s {$sel:gatewayName:UpdateGateway' :: Text
gatewayName = Text
a} :: UpdateGateway)

instance Core.AWSRequest UpdateGateway where
  type
    AWSResponse UpdateGateway =
      UpdateGatewayResponse
  request :: (Service -> Service) -> UpdateGateway -> Request UpdateGateway
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateGateway
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateGateway)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateGatewayResponse
UpdateGatewayResponse'

instance Prelude.Hashable UpdateGateway where
  hashWithSalt :: Int -> UpdateGateway -> Int
hashWithSalt Int
_salt UpdateGateway' {Text
gatewayName :: Text
gatewayId :: Text
$sel:gatewayName:UpdateGateway' :: UpdateGateway -> Text
$sel:gatewayId:UpdateGateway' :: UpdateGateway -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayName

instance Prelude.NFData UpdateGateway where
  rnf :: UpdateGateway -> ()
rnf UpdateGateway' {Text
gatewayName :: Text
gatewayId :: Text
$sel:gatewayName:UpdateGateway' :: UpdateGateway -> Text
$sel:gatewayId:UpdateGateway' :: UpdateGateway -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayName

instance Data.ToHeaders UpdateGateway where
  toHeaders :: UpdateGateway -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateGateway where
  toJSON :: UpdateGateway -> Value
toJSON UpdateGateway' {Text
gatewayName :: Text
gatewayId :: Text
$sel:gatewayName:UpdateGateway' :: UpdateGateway -> Text
$sel:gatewayId:UpdateGateway' :: UpdateGateway -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"gatewayName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayName)]
      )

instance Data.ToPath UpdateGateway where
  toPath :: UpdateGateway -> ByteString
toPath UpdateGateway' {Text
gatewayName :: Text
gatewayId :: Text
$sel:gatewayName:UpdateGateway' :: UpdateGateway -> Text
$sel:gatewayId:UpdateGateway' :: UpdateGateway -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/20200301/gateways/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
gatewayId]

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

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

-- |
-- Create a value of 'UpdateGatewayResponse' 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.
newUpdateGatewayResponse ::
  UpdateGatewayResponse
newUpdateGatewayResponse :: UpdateGatewayResponse
newUpdateGatewayResponse = UpdateGatewayResponse
UpdateGatewayResponse'

instance Prelude.NFData UpdateGatewayResponse where
  rnf :: UpdateGatewayResponse -> ()
rnf UpdateGatewayResponse
_ = ()