{-# 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.IoT1ClickProjects.UpdatePlacement
-- 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 placement with the given attributes. To clear an attribute,
-- pass an empty value (i.e., \"\").
module Amazonka.IoT1ClickProjects.UpdatePlacement
  ( -- * Creating a Request
    UpdatePlacement (..),
    newUpdatePlacement,

    -- * Request Lenses
    updatePlacement_attributes,
    updatePlacement_placementName,
    updatePlacement_projectName,

    -- * Destructuring the Response
    UpdatePlacementResponse (..),
    newUpdatePlacementResponse,

    -- * Response Lenses
    updatePlacementResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdatePlacement' smart constructor.
data UpdatePlacement = UpdatePlacement'
  { -- | The user-defined object of attributes used to update the placement. The
    -- maximum number of key\/value pairs is 50.
    UpdatePlacement -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the placement to update.
    UpdatePlacement -> Text
placementName :: Prelude.Text,
    -- | The name of the project containing the placement to be updated.
    UpdatePlacement -> Text
projectName :: Prelude.Text
  }
  deriving (UpdatePlacement -> UpdatePlacement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePlacement -> UpdatePlacement -> Bool
$c/= :: UpdatePlacement -> UpdatePlacement -> Bool
== :: UpdatePlacement -> UpdatePlacement -> Bool
$c== :: UpdatePlacement -> UpdatePlacement -> Bool
Prelude.Eq, ReadPrec [UpdatePlacement]
ReadPrec UpdatePlacement
Int -> ReadS UpdatePlacement
ReadS [UpdatePlacement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePlacement]
$creadListPrec :: ReadPrec [UpdatePlacement]
readPrec :: ReadPrec UpdatePlacement
$creadPrec :: ReadPrec UpdatePlacement
readList :: ReadS [UpdatePlacement]
$creadList :: ReadS [UpdatePlacement]
readsPrec :: Int -> ReadS UpdatePlacement
$creadsPrec :: Int -> ReadS UpdatePlacement
Prelude.Read, Int -> UpdatePlacement -> ShowS
[UpdatePlacement] -> ShowS
UpdatePlacement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePlacement] -> ShowS
$cshowList :: [UpdatePlacement] -> ShowS
show :: UpdatePlacement -> String
$cshow :: UpdatePlacement -> String
showsPrec :: Int -> UpdatePlacement -> ShowS
$cshowsPrec :: Int -> UpdatePlacement -> ShowS
Prelude.Show, forall x. Rep UpdatePlacement x -> UpdatePlacement
forall x. UpdatePlacement -> Rep UpdatePlacement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePlacement x -> UpdatePlacement
$cfrom :: forall x. UpdatePlacement -> Rep UpdatePlacement x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePlacement' 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:
--
-- 'attributes', 'updatePlacement_attributes' - The user-defined object of attributes used to update the placement. The
-- maximum number of key\/value pairs is 50.
--
-- 'placementName', 'updatePlacement_placementName' - The name of the placement to update.
--
-- 'projectName', 'updatePlacement_projectName' - The name of the project containing the placement to be updated.
newUpdatePlacement ::
  -- | 'placementName'
  Prelude.Text ->
  -- | 'projectName'
  Prelude.Text ->
  UpdatePlacement
newUpdatePlacement :: Text -> Text -> UpdatePlacement
newUpdatePlacement Text
pPlacementName_ Text
pProjectName_ =
  UpdatePlacement'
    { $sel:attributes:UpdatePlacement' :: Maybe (HashMap Text Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:placementName:UpdatePlacement' :: Text
placementName = Text
pPlacementName_,
      $sel:projectName:UpdatePlacement' :: Text
projectName = Text
pProjectName_
    }

-- | The user-defined object of attributes used to update the placement. The
-- maximum number of key\/value pairs is 50.
updatePlacement_attributes :: Lens.Lens' UpdatePlacement (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updatePlacement_attributes :: Lens' UpdatePlacement (Maybe (HashMap Text Text))
updatePlacement_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePlacement' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:UpdatePlacement' :: UpdatePlacement -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: UpdatePlacement
s@UpdatePlacement' {} Maybe (HashMap Text Text)
a -> UpdatePlacement
s {$sel:attributes:UpdatePlacement' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: UpdatePlacement) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the placement to update.
updatePlacement_placementName :: Lens.Lens' UpdatePlacement Prelude.Text
updatePlacement_placementName :: Lens' UpdatePlacement Text
updatePlacement_placementName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePlacement' {Text
placementName :: Text
$sel:placementName:UpdatePlacement' :: UpdatePlacement -> Text
placementName} -> Text
placementName) (\s :: UpdatePlacement
s@UpdatePlacement' {} Text
a -> UpdatePlacement
s {$sel:placementName:UpdatePlacement' :: Text
placementName = Text
a} :: UpdatePlacement)

-- | The name of the project containing the placement to be updated.
updatePlacement_projectName :: Lens.Lens' UpdatePlacement Prelude.Text
updatePlacement_projectName :: Lens' UpdatePlacement Text
updatePlacement_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePlacement' {Text
projectName :: Text
$sel:projectName:UpdatePlacement' :: UpdatePlacement -> Text
projectName} -> Text
projectName) (\s :: UpdatePlacement
s@UpdatePlacement' {} Text
a -> UpdatePlacement
s {$sel:projectName:UpdatePlacement' :: Text
projectName = Text
a} :: UpdatePlacement)

instance Core.AWSRequest UpdatePlacement where
  type
    AWSResponse UpdatePlacement =
      UpdatePlacementResponse
  request :: (Service -> Service) -> UpdatePlacement -> Request UpdatePlacement
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 UpdatePlacement
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePlacement)))
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 -> UpdatePlacementResponse
UpdatePlacementResponse'
            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 UpdatePlacement where
  hashWithSalt :: Int -> UpdatePlacement -> Int
hashWithSalt Int
_salt UpdatePlacement' {Maybe (HashMap Text Text)
Text
projectName :: Text
placementName :: Text
attributes :: Maybe (HashMap Text Text)
$sel:projectName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:placementName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:attributes:UpdatePlacement' :: UpdatePlacement -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
placementName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
projectName

instance Prelude.NFData UpdatePlacement where
  rnf :: UpdatePlacement -> ()
rnf UpdatePlacement' {Maybe (HashMap Text Text)
Text
projectName :: Text
placementName :: Text
attributes :: Maybe (HashMap Text Text)
$sel:projectName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:placementName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:attributes:UpdatePlacement' :: UpdatePlacement -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
placementName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
projectName

instance Data.ToHeaders UpdatePlacement where
  toHeaders :: UpdatePlacement -> 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 UpdatePlacement where
  toJSON :: UpdatePlacement -> Value
toJSON UpdatePlacement' {Maybe (HashMap Text Text)
Text
projectName :: Text
placementName :: Text
attributes :: Maybe (HashMap Text Text)
$sel:projectName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:placementName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:attributes:UpdatePlacement' :: UpdatePlacement -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"attributes" 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 (HashMap Text Text)
attributes]
      )

instance Data.ToPath UpdatePlacement where
  toPath :: UpdatePlacement -> ByteString
toPath UpdatePlacement' {Maybe (HashMap Text Text)
Text
projectName :: Text
placementName :: Text
attributes :: Maybe (HashMap Text Text)
$sel:projectName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:placementName:UpdatePlacement' :: UpdatePlacement -> Text
$sel:attributes:UpdatePlacement' :: UpdatePlacement -> Maybe (HashMap Text Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
projectName,
        ByteString
"/placements/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
placementName
      ]

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

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

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

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

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