{-# 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.IotTwinMaker.BatchPutPropertyValues
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets values for multiple time series properties.
module Amazonka.IotTwinMaker.BatchPutPropertyValues
  ( -- * Creating a Request
    BatchPutPropertyValues (..),
    newBatchPutPropertyValues,

    -- * Request Lenses
    batchPutPropertyValues_workspaceId,
    batchPutPropertyValues_entries,

    -- * Destructuring the Response
    BatchPutPropertyValuesResponse (..),
    newBatchPutPropertyValuesResponse,

    -- * Response Lenses
    batchPutPropertyValuesResponse_httpStatus,
    batchPutPropertyValuesResponse_errorEntries,
  )
where

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

-- | /See:/ 'newBatchPutPropertyValues' smart constructor.
data BatchPutPropertyValues = BatchPutPropertyValues'
  { -- | The ID of the workspace that contains the properties to set.
    BatchPutPropertyValues -> Text
workspaceId :: Prelude.Text,
    -- | An object that maps strings to the property value entries to set. Each
    -- string in the mapping must be unique to this object.
    BatchPutPropertyValues -> NonEmpty PropertyValueEntry
entries :: Prelude.NonEmpty PropertyValueEntry
  }
  deriving (BatchPutPropertyValues -> BatchPutPropertyValues -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPutPropertyValues -> BatchPutPropertyValues -> Bool
$c/= :: BatchPutPropertyValues -> BatchPutPropertyValues -> Bool
== :: BatchPutPropertyValues -> BatchPutPropertyValues -> Bool
$c== :: BatchPutPropertyValues -> BatchPutPropertyValues -> Bool
Prelude.Eq, ReadPrec [BatchPutPropertyValues]
ReadPrec BatchPutPropertyValues
Int -> ReadS BatchPutPropertyValues
ReadS [BatchPutPropertyValues]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchPutPropertyValues]
$creadListPrec :: ReadPrec [BatchPutPropertyValues]
readPrec :: ReadPrec BatchPutPropertyValues
$creadPrec :: ReadPrec BatchPutPropertyValues
readList :: ReadS [BatchPutPropertyValues]
$creadList :: ReadS [BatchPutPropertyValues]
readsPrec :: Int -> ReadS BatchPutPropertyValues
$creadsPrec :: Int -> ReadS BatchPutPropertyValues
Prelude.Read, Int -> BatchPutPropertyValues -> ShowS
[BatchPutPropertyValues] -> ShowS
BatchPutPropertyValues -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPutPropertyValues] -> ShowS
$cshowList :: [BatchPutPropertyValues] -> ShowS
show :: BatchPutPropertyValues -> String
$cshow :: BatchPutPropertyValues -> String
showsPrec :: Int -> BatchPutPropertyValues -> ShowS
$cshowsPrec :: Int -> BatchPutPropertyValues -> ShowS
Prelude.Show, forall x. Rep BatchPutPropertyValues x -> BatchPutPropertyValues
forall x. BatchPutPropertyValues -> Rep BatchPutPropertyValues x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchPutPropertyValues x -> BatchPutPropertyValues
$cfrom :: forall x. BatchPutPropertyValues -> Rep BatchPutPropertyValues x
Prelude.Generic)

-- |
-- Create a value of 'BatchPutPropertyValues' 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:
--
-- 'workspaceId', 'batchPutPropertyValues_workspaceId' - The ID of the workspace that contains the properties to set.
--
-- 'entries', 'batchPutPropertyValues_entries' - An object that maps strings to the property value entries to set. Each
-- string in the mapping must be unique to this object.
newBatchPutPropertyValues ::
  -- | 'workspaceId'
  Prelude.Text ->
  -- | 'entries'
  Prelude.NonEmpty PropertyValueEntry ->
  BatchPutPropertyValues
newBatchPutPropertyValues :: Text -> NonEmpty PropertyValueEntry -> BatchPutPropertyValues
newBatchPutPropertyValues Text
pWorkspaceId_ NonEmpty PropertyValueEntry
pEntries_ =
  BatchPutPropertyValues'
    { $sel:workspaceId:BatchPutPropertyValues' :: Text
workspaceId =
        Text
pWorkspaceId_,
      $sel:entries:BatchPutPropertyValues' :: NonEmpty PropertyValueEntry
entries = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty PropertyValueEntry
pEntries_
    }

-- | The ID of the workspace that contains the properties to set.
batchPutPropertyValues_workspaceId :: Lens.Lens' BatchPutPropertyValues Prelude.Text
batchPutPropertyValues_workspaceId :: Lens' BatchPutPropertyValues Text
batchPutPropertyValues_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutPropertyValues' {Text
workspaceId :: Text
$sel:workspaceId:BatchPutPropertyValues' :: BatchPutPropertyValues -> Text
workspaceId} -> Text
workspaceId) (\s :: BatchPutPropertyValues
s@BatchPutPropertyValues' {} Text
a -> BatchPutPropertyValues
s {$sel:workspaceId:BatchPutPropertyValues' :: Text
workspaceId = Text
a} :: BatchPutPropertyValues)

-- | An object that maps strings to the property value entries to set. Each
-- string in the mapping must be unique to this object.
batchPutPropertyValues_entries :: Lens.Lens' BatchPutPropertyValues (Prelude.NonEmpty PropertyValueEntry)
batchPutPropertyValues_entries :: Lens' BatchPutPropertyValues (NonEmpty PropertyValueEntry)
batchPutPropertyValues_entries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutPropertyValues' {NonEmpty PropertyValueEntry
entries :: NonEmpty PropertyValueEntry
$sel:entries:BatchPutPropertyValues' :: BatchPutPropertyValues -> NonEmpty PropertyValueEntry
entries} -> NonEmpty PropertyValueEntry
entries) (\s :: BatchPutPropertyValues
s@BatchPutPropertyValues' {} NonEmpty PropertyValueEntry
a -> BatchPutPropertyValues
s {$sel:entries:BatchPutPropertyValues' :: NonEmpty PropertyValueEntry
entries = NonEmpty PropertyValueEntry
a} :: BatchPutPropertyValues) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchPutPropertyValues where
  type
    AWSResponse BatchPutPropertyValues =
      BatchPutPropertyValuesResponse
  request :: (Service -> Service)
-> BatchPutPropertyValues -> Request BatchPutPropertyValues
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 BatchPutPropertyValues
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchPutPropertyValues)))
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
-> NonEmpty BatchPutPropertyErrorEntry
-> BatchPutPropertyValuesResponse
BatchPutPropertyValuesResponse'
            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
"errorEntries")
      )

instance Prelude.Hashable BatchPutPropertyValues where
  hashWithSalt :: Int -> BatchPutPropertyValues -> Int
hashWithSalt Int
_salt BatchPutPropertyValues' {NonEmpty PropertyValueEntry
Text
entries :: NonEmpty PropertyValueEntry
workspaceId :: Text
$sel:entries:BatchPutPropertyValues' :: BatchPutPropertyValues -> NonEmpty PropertyValueEntry
$sel:workspaceId:BatchPutPropertyValues' :: BatchPutPropertyValues -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty PropertyValueEntry
entries

instance Prelude.NFData BatchPutPropertyValues where
  rnf :: BatchPutPropertyValues -> ()
rnf BatchPutPropertyValues' {NonEmpty PropertyValueEntry
Text
entries :: NonEmpty PropertyValueEntry
workspaceId :: Text
$sel:entries:BatchPutPropertyValues' :: BatchPutPropertyValues -> NonEmpty PropertyValueEntry
$sel:workspaceId:BatchPutPropertyValues' :: BatchPutPropertyValues -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PropertyValueEntry
entries

instance Data.ToHeaders BatchPutPropertyValues where
  toHeaders :: BatchPutPropertyValues -> 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 BatchPutPropertyValues where
  toJSON :: BatchPutPropertyValues -> Value
toJSON BatchPutPropertyValues' {NonEmpty PropertyValueEntry
Text
entries :: NonEmpty PropertyValueEntry
workspaceId :: Text
$sel:entries:BatchPutPropertyValues' :: BatchPutPropertyValues -> NonEmpty PropertyValueEntry
$sel:workspaceId:BatchPutPropertyValues' :: BatchPutPropertyValues -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"entries" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty PropertyValueEntry
entries)]
      )

instance Data.ToPath BatchPutPropertyValues where
  toPath :: BatchPutPropertyValues -> ByteString
toPath BatchPutPropertyValues' {NonEmpty PropertyValueEntry
Text
entries :: NonEmpty PropertyValueEntry
workspaceId :: Text
$sel:entries:BatchPutPropertyValues' :: BatchPutPropertyValues -> NonEmpty PropertyValueEntry
$sel:workspaceId:BatchPutPropertyValues' :: BatchPutPropertyValues -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workspaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId,
        ByteString
"/entity-properties"
      ]

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

-- | /See:/ 'newBatchPutPropertyValuesResponse' smart constructor.
data BatchPutPropertyValuesResponse = BatchPutPropertyValuesResponse'
  { -- | The response's http status code.
    BatchPutPropertyValuesResponse -> Int
httpStatus :: Prelude.Int,
    -- | Entries that caused errors in the batch put operation.
    BatchPutPropertyValuesResponse
-> NonEmpty BatchPutPropertyErrorEntry
errorEntries :: Prelude.NonEmpty BatchPutPropertyErrorEntry
  }
  deriving (BatchPutPropertyValuesResponse
-> BatchPutPropertyValuesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPutPropertyValuesResponse
-> BatchPutPropertyValuesResponse -> Bool
$c/= :: BatchPutPropertyValuesResponse
-> BatchPutPropertyValuesResponse -> Bool
== :: BatchPutPropertyValuesResponse
-> BatchPutPropertyValuesResponse -> Bool
$c== :: BatchPutPropertyValuesResponse
-> BatchPutPropertyValuesResponse -> Bool
Prelude.Eq, ReadPrec [BatchPutPropertyValuesResponse]
ReadPrec BatchPutPropertyValuesResponse
Int -> ReadS BatchPutPropertyValuesResponse
ReadS [BatchPutPropertyValuesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchPutPropertyValuesResponse]
$creadListPrec :: ReadPrec [BatchPutPropertyValuesResponse]
readPrec :: ReadPrec BatchPutPropertyValuesResponse
$creadPrec :: ReadPrec BatchPutPropertyValuesResponse
readList :: ReadS [BatchPutPropertyValuesResponse]
$creadList :: ReadS [BatchPutPropertyValuesResponse]
readsPrec :: Int -> ReadS BatchPutPropertyValuesResponse
$creadsPrec :: Int -> ReadS BatchPutPropertyValuesResponse
Prelude.Read, Int -> BatchPutPropertyValuesResponse -> ShowS
[BatchPutPropertyValuesResponse] -> ShowS
BatchPutPropertyValuesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPutPropertyValuesResponse] -> ShowS
$cshowList :: [BatchPutPropertyValuesResponse] -> ShowS
show :: BatchPutPropertyValuesResponse -> String
$cshow :: BatchPutPropertyValuesResponse -> String
showsPrec :: Int -> BatchPutPropertyValuesResponse -> ShowS
$cshowsPrec :: Int -> BatchPutPropertyValuesResponse -> ShowS
Prelude.Show, forall x.
Rep BatchPutPropertyValuesResponse x
-> BatchPutPropertyValuesResponse
forall x.
BatchPutPropertyValuesResponse
-> Rep BatchPutPropertyValuesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchPutPropertyValuesResponse x
-> BatchPutPropertyValuesResponse
$cfrom :: forall x.
BatchPutPropertyValuesResponse
-> Rep BatchPutPropertyValuesResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchPutPropertyValuesResponse' 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', 'batchPutPropertyValuesResponse_httpStatus' - The response's http status code.
--
-- 'errorEntries', 'batchPutPropertyValuesResponse_errorEntries' - Entries that caused errors in the batch put operation.
newBatchPutPropertyValuesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'errorEntries'
  Prelude.NonEmpty BatchPutPropertyErrorEntry ->
  BatchPutPropertyValuesResponse
newBatchPutPropertyValuesResponse :: Int
-> NonEmpty BatchPutPropertyErrorEntry
-> BatchPutPropertyValuesResponse
newBatchPutPropertyValuesResponse
  Int
pHttpStatus_
  NonEmpty BatchPutPropertyErrorEntry
pErrorEntries_ =
    BatchPutPropertyValuesResponse'
      { $sel:httpStatus:BatchPutPropertyValuesResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:errorEntries:BatchPutPropertyValuesResponse' :: NonEmpty BatchPutPropertyErrorEntry
errorEntries =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty BatchPutPropertyErrorEntry
pErrorEntries_
      }

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

-- | Entries that caused errors in the batch put operation.
batchPutPropertyValuesResponse_errorEntries :: Lens.Lens' BatchPutPropertyValuesResponse (Prelude.NonEmpty BatchPutPropertyErrorEntry)
batchPutPropertyValuesResponse_errorEntries :: Lens'
  BatchPutPropertyValuesResponse
  (NonEmpty BatchPutPropertyErrorEntry)
batchPutPropertyValuesResponse_errorEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutPropertyValuesResponse' {NonEmpty BatchPutPropertyErrorEntry
errorEntries :: NonEmpty BatchPutPropertyErrorEntry
$sel:errorEntries:BatchPutPropertyValuesResponse' :: BatchPutPropertyValuesResponse
-> NonEmpty BatchPutPropertyErrorEntry
errorEntries} -> NonEmpty BatchPutPropertyErrorEntry
errorEntries) (\s :: BatchPutPropertyValuesResponse
s@BatchPutPropertyValuesResponse' {} NonEmpty BatchPutPropertyErrorEntry
a -> BatchPutPropertyValuesResponse
s {$sel:errorEntries:BatchPutPropertyValuesResponse' :: NonEmpty BatchPutPropertyErrorEntry
errorEntries = NonEmpty BatchPutPropertyErrorEntry
a} :: BatchPutPropertyValuesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Prelude.NFData
    BatchPutPropertyValuesResponse
  where
  rnf :: BatchPutPropertyValuesResponse -> ()
rnf BatchPutPropertyValuesResponse' {Int
NonEmpty BatchPutPropertyErrorEntry
errorEntries :: NonEmpty BatchPutPropertyErrorEntry
httpStatus :: Int
$sel:errorEntries:BatchPutPropertyValuesResponse' :: BatchPutPropertyValuesResponse
-> NonEmpty BatchPutPropertyErrorEntry
$sel:httpStatus:BatchPutPropertyValuesResponse' :: BatchPutPropertyValuesResponse -> 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 NonEmpty BatchPutPropertyErrorEntry
errorEntries