{-# 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.CognitoSync.UpdateRecords
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Posts updates to records and adds and deletes records for a dataset and
-- user.
--
-- The sync count in the record patch is your last known sync count for
-- that record. The server will reject an UpdateRecords request with a
-- ResourceConflictException if you try to patch a record with a new value
-- but a stale sync count.
--
-- For example, if the sync count on the server is 5 for a key called
-- highScore and you try and submit a new highScore with sync count of 4,
-- the request will be rejected. To obtain the current sync count for a
-- record, call ListRecords. On a successful update of the record, the
-- response returns the new sync count for that record. You should present
-- that sync count the next time you try to update that same record. When
-- the record does not exist, specify the sync count as 0.
--
-- This API can be called with temporary user credentials provided by
-- Cognito Identity or with developer credentials.
module Amazonka.CognitoSync.UpdateRecords
  ( -- * Creating a Request
    UpdateRecords (..),
    newUpdateRecords,

    -- * Request Lenses
    updateRecords_clientContext,
    updateRecords_deviceId,
    updateRecords_recordPatches,
    updateRecords_identityPoolId,
    updateRecords_identityId,
    updateRecords_datasetName,
    updateRecords_syncSessionToken,

    -- * Destructuring the Response
    UpdateRecordsResponse (..),
    newUpdateRecordsResponse,

    -- * Response Lenses
    updateRecordsResponse_records,
    updateRecordsResponse_httpStatus,
  )
where

import Amazonka.CognitoSync.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

-- | A request to post updates to records or add and delete records for a
-- dataset and user.
--
-- /See:/ 'newUpdateRecords' smart constructor.
data UpdateRecords = UpdateRecords'
  { -- | Intended to supply a device ID that will populate the lastModifiedBy
    -- field referenced in other methods. The ClientContext field is not yet
    -- implemented.
    UpdateRecords -> Maybe Text
clientContext :: Prelude.Maybe Prelude.Text,
    -- | The unique ID generated for this device by Cognito.
    UpdateRecords -> Maybe Text
deviceId :: Prelude.Maybe Prelude.Text,
    -- | A list of patch operations.
    UpdateRecords -> Maybe [RecordPatch]
recordPatches :: Prelude.Maybe [RecordPatch],
    -- | A name-spaced GUID (for example,
    -- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
    -- Cognito. GUID generation is unique within a region.
    UpdateRecords -> Text
identityPoolId :: Prelude.Text,
    -- | A name-spaced GUID (for example,
    -- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
    -- Cognito. GUID generation is unique within a region.
    UpdateRecords -> Text
identityId :: Prelude.Text,
    -- | A string of up to 128 characters. Allowed characters are a-z, A-Z, 0-9,
    -- \'_\' (underscore), \'-\' (dash), and \'.\' (dot).
    UpdateRecords -> Text
datasetName :: Prelude.Text,
    -- | The SyncSessionToken returned by a previous call to ListRecords for this
    -- dataset and identity.
    UpdateRecords -> Text
syncSessionToken :: Prelude.Text
  }
  deriving (UpdateRecords -> UpdateRecords -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRecords -> UpdateRecords -> Bool
$c/= :: UpdateRecords -> UpdateRecords -> Bool
== :: UpdateRecords -> UpdateRecords -> Bool
$c== :: UpdateRecords -> UpdateRecords -> Bool
Prelude.Eq, ReadPrec [UpdateRecords]
ReadPrec UpdateRecords
Int -> ReadS UpdateRecords
ReadS [UpdateRecords]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRecords]
$creadListPrec :: ReadPrec [UpdateRecords]
readPrec :: ReadPrec UpdateRecords
$creadPrec :: ReadPrec UpdateRecords
readList :: ReadS [UpdateRecords]
$creadList :: ReadS [UpdateRecords]
readsPrec :: Int -> ReadS UpdateRecords
$creadsPrec :: Int -> ReadS UpdateRecords
Prelude.Read, Int -> UpdateRecords -> ShowS
[UpdateRecords] -> ShowS
UpdateRecords -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRecords] -> ShowS
$cshowList :: [UpdateRecords] -> ShowS
show :: UpdateRecords -> String
$cshow :: UpdateRecords -> String
showsPrec :: Int -> UpdateRecords -> ShowS
$cshowsPrec :: Int -> UpdateRecords -> ShowS
Prelude.Show, forall x. Rep UpdateRecords x -> UpdateRecords
forall x. UpdateRecords -> Rep UpdateRecords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRecords x -> UpdateRecords
$cfrom :: forall x. UpdateRecords -> Rep UpdateRecords x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRecords' 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:
--
-- 'clientContext', 'updateRecords_clientContext' - Intended to supply a device ID that will populate the lastModifiedBy
-- field referenced in other methods. The ClientContext field is not yet
-- implemented.
--
-- 'deviceId', 'updateRecords_deviceId' - The unique ID generated for this device by Cognito.
--
-- 'recordPatches', 'updateRecords_recordPatches' - A list of patch operations.
--
-- 'identityPoolId', 'updateRecords_identityPoolId' - A name-spaced GUID (for example,
-- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
-- Cognito. GUID generation is unique within a region.
--
-- 'identityId', 'updateRecords_identityId' - A name-spaced GUID (for example,
-- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
-- Cognito. GUID generation is unique within a region.
--
-- 'datasetName', 'updateRecords_datasetName' - A string of up to 128 characters. Allowed characters are a-z, A-Z, 0-9,
-- \'_\' (underscore), \'-\' (dash), and \'.\' (dot).
--
-- 'syncSessionToken', 'updateRecords_syncSessionToken' - The SyncSessionToken returned by a previous call to ListRecords for this
-- dataset and identity.
newUpdateRecords ::
  -- | 'identityPoolId'
  Prelude.Text ->
  -- | 'identityId'
  Prelude.Text ->
  -- | 'datasetName'
  Prelude.Text ->
  -- | 'syncSessionToken'
  Prelude.Text ->
  UpdateRecords
newUpdateRecords :: Text -> Text -> Text -> Text -> UpdateRecords
newUpdateRecords
  Text
pIdentityPoolId_
  Text
pIdentityId_
  Text
pDatasetName_
  Text
pSyncSessionToken_ =
    UpdateRecords'
      { $sel:clientContext:UpdateRecords' :: Maybe Text
clientContext = forall a. Maybe a
Prelude.Nothing,
        $sel:deviceId:UpdateRecords' :: Maybe Text
deviceId = forall a. Maybe a
Prelude.Nothing,
        $sel:recordPatches:UpdateRecords' :: Maybe [RecordPatch]
recordPatches = forall a. Maybe a
Prelude.Nothing,
        $sel:identityPoolId:UpdateRecords' :: Text
identityPoolId = Text
pIdentityPoolId_,
        $sel:identityId:UpdateRecords' :: Text
identityId = Text
pIdentityId_,
        $sel:datasetName:UpdateRecords' :: Text
datasetName = Text
pDatasetName_,
        $sel:syncSessionToken:UpdateRecords' :: Text
syncSessionToken = Text
pSyncSessionToken_
      }

-- | Intended to supply a device ID that will populate the lastModifiedBy
-- field referenced in other methods. The ClientContext field is not yet
-- implemented.
updateRecords_clientContext :: Lens.Lens' UpdateRecords (Prelude.Maybe Prelude.Text)
updateRecords_clientContext :: Lens' UpdateRecords (Maybe Text)
updateRecords_clientContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecords' {Maybe Text
clientContext :: Maybe Text
$sel:clientContext:UpdateRecords' :: UpdateRecords -> Maybe Text
clientContext} -> Maybe Text
clientContext) (\s :: UpdateRecords
s@UpdateRecords' {} Maybe Text
a -> UpdateRecords
s {$sel:clientContext:UpdateRecords' :: Maybe Text
clientContext = Maybe Text
a} :: UpdateRecords)

-- | The unique ID generated for this device by Cognito.
updateRecords_deviceId :: Lens.Lens' UpdateRecords (Prelude.Maybe Prelude.Text)
updateRecords_deviceId :: Lens' UpdateRecords (Maybe Text)
updateRecords_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecords' {Maybe Text
deviceId :: Maybe Text
$sel:deviceId:UpdateRecords' :: UpdateRecords -> Maybe Text
deviceId} -> Maybe Text
deviceId) (\s :: UpdateRecords
s@UpdateRecords' {} Maybe Text
a -> UpdateRecords
s {$sel:deviceId:UpdateRecords' :: Maybe Text
deviceId = Maybe Text
a} :: UpdateRecords)

-- | A list of patch operations.
updateRecords_recordPatches :: Lens.Lens' UpdateRecords (Prelude.Maybe [RecordPatch])
updateRecords_recordPatches :: Lens' UpdateRecords (Maybe [RecordPatch])
updateRecords_recordPatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecords' {Maybe [RecordPatch]
recordPatches :: Maybe [RecordPatch]
$sel:recordPatches:UpdateRecords' :: UpdateRecords -> Maybe [RecordPatch]
recordPatches} -> Maybe [RecordPatch]
recordPatches) (\s :: UpdateRecords
s@UpdateRecords' {} Maybe [RecordPatch]
a -> UpdateRecords
s {$sel:recordPatches:UpdateRecords' :: Maybe [RecordPatch]
recordPatches = Maybe [RecordPatch]
a} :: UpdateRecords) 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

-- | A name-spaced GUID (for example,
-- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
-- Cognito. GUID generation is unique within a region.
updateRecords_identityPoolId :: Lens.Lens' UpdateRecords Prelude.Text
updateRecords_identityPoolId :: Lens' UpdateRecords Text
updateRecords_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecords' {Text
identityPoolId :: Text
$sel:identityPoolId:UpdateRecords' :: UpdateRecords -> Text
identityPoolId} -> Text
identityPoolId) (\s :: UpdateRecords
s@UpdateRecords' {} Text
a -> UpdateRecords
s {$sel:identityPoolId:UpdateRecords' :: Text
identityPoolId = Text
a} :: UpdateRecords)

-- | A name-spaced GUID (for example,
-- us-east-1:23EC4050-6AEA-7089-A2DD-08002EXAMPLE) created by Amazon
-- Cognito. GUID generation is unique within a region.
updateRecords_identityId :: Lens.Lens' UpdateRecords Prelude.Text
updateRecords_identityId :: Lens' UpdateRecords Text
updateRecords_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecords' {Text
identityId :: Text
$sel:identityId:UpdateRecords' :: UpdateRecords -> Text
identityId} -> Text
identityId) (\s :: UpdateRecords
s@UpdateRecords' {} Text
a -> UpdateRecords
s {$sel:identityId:UpdateRecords' :: Text
identityId = Text
a} :: UpdateRecords)

-- | A string of up to 128 characters. Allowed characters are a-z, A-Z, 0-9,
-- \'_\' (underscore), \'-\' (dash), and \'.\' (dot).
updateRecords_datasetName :: Lens.Lens' UpdateRecords Prelude.Text
updateRecords_datasetName :: Lens' UpdateRecords Text
updateRecords_datasetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecords' {Text
datasetName :: Text
$sel:datasetName:UpdateRecords' :: UpdateRecords -> Text
datasetName} -> Text
datasetName) (\s :: UpdateRecords
s@UpdateRecords' {} Text
a -> UpdateRecords
s {$sel:datasetName:UpdateRecords' :: Text
datasetName = Text
a} :: UpdateRecords)

-- | The SyncSessionToken returned by a previous call to ListRecords for this
-- dataset and identity.
updateRecords_syncSessionToken :: Lens.Lens' UpdateRecords Prelude.Text
updateRecords_syncSessionToken :: Lens' UpdateRecords Text
updateRecords_syncSessionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecords' {Text
syncSessionToken :: Text
$sel:syncSessionToken:UpdateRecords' :: UpdateRecords -> Text
syncSessionToken} -> Text
syncSessionToken) (\s :: UpdateRecords
s@UpdateRecords' {} Text
a -> UpdateRecords
s {$sel:syncSessionToken:UpdateRecords' :: Text
syncSessionToken = Text
a} :: UpdateRecords)

instance Core.AWSRequest UpdateRecords where
  type
    AWSResponse UpdateRecords =
      UpdateRecordsResponse
  request :: (Service -> Service) -> UpdateRecords -> Request UpdateRecords
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 UpdateRecords
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateRecords)))
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 ->
          Maybe [Record] -> Int -> UpdateRecordsResponse
UpdateRecordsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Records" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => 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 UpdateRecords where
  hashWithSalt :: Int -> UpdateRecords -> Int
hashWithSalt Int
_salt UpdateRecords' {Maybe [RecordPatch]
Maybe Text
Text
syncSessionToken :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
recordPatches :: Maybe [RecordPatch]
deviceId :: Maybe Text
clientContext :: Maybe Text
$sel:syncSessionToken:UpdateRecords' :: UpdateRecords -> Text
$sel:datasetName:UpdateRecords' :: UpdateRecords -> Text
$sel:identityId:UpdateRecords' :: UpdateRecords -> Text
$sel:identityPoolId:UpdateRecords' :: UpdateRecords -> Text
$sel:recordPatches:UpdateRecords' :: UpdateRecords -> Maybe [RecordPatch]
$sel:deviceId:UpdateRecords' :: UpdateRecords -> Maybe Text
$sel:clientContext:UpdateRecords' :: UpdateRecords -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deviceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RecordPatch]
recordPatches
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
syncSessionToken

instance Prelude.NFData UpdateRecords where
  rnf :: UpdateRecords -> ()
rnf UpdateRecords' {Maybe [RecordPatch]
Maybe Text
Text
syncSessionToken :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
recordPatches :: Maybe [RecordPatch]
deviceId :: Maybe Text
clientContext :: Maybe Text
$sel:syncSessionToken:UpdateRecords' :: UpdateRecords -> Text
$sel:datasetName:UpdateRecords' :: UpdateRecords -> Text
$sel:identityId:UpdateRecords' :: UpdateRecords -> Text
$sel:identityPoolId:UpdateRecords' :: UpdateRecords -> Text
$sel:recordPatches:UpdateRecords' :: UpdateRecords -> Maybe [RecordPatch]
$sel:deviceId:UpdateRecords' :: UpdateRecords -> Maybe Text
$sel:clientContext:UpdateRecords' :: UpdateRecords -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RecordPatch]
recordPatches
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
syncSessionToken

instance Data.ToHeaders UpdateRecords where
  toHeaders :: UpdateRecords -> ResponseHeaders
toHeaders UpdateRecords' {Maybe [RecordPatch]
Maybe Text
Text
syncSessionToken :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
recordPatches :: Maybe [RecordPatch]
deviceId :: Maybe Text
clientContext :: Maybe Text
$sel:syncSessionToken:UpdateRecords' :: UpdateRecords -> Text
$sel:datasetName:UpdateRecords' :: UpdateRecords -> Text
$sel:identityId:UpdateRecords' :: UpdateRecords -> Text
$sel:identityPoolId:UpdateRecords' :: UpdateRecords -> Text
$sel:recordPatches:UpdateRecords' :: UpdateRecords -> Maybe [RecordPatch]
$sel:deviceId:UpdateRecords' :: UpdateRecords -> Maybe Text
$sel:clientContext:UpdateRecords' :: UpdateRecords -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-Client-Context" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
clientContext,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON UpdateRecords where
  toJSON :: UpdateRecords -> Value
toJSON UpdateRecords' {Maybe [RecordPatch]
Maybe Text
Text
syncSessionToken :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
recordPatches :: Maybe [RecordPatch]
deviceId :: Maybe Text
clientContext :: Maybe Text
$sel:syncSessionToken:UpdateRecords' :: UpdateRecords -> Text
$sel:datasetName:UpdateRecords' :: UpdateRecords -> Text
$sel:identityId:UpdateRecords' :: UpdateRecords -> Text
$sel:identityPoolId:UpdateRecords' :: UpdateRecords -> Text
$sel:recordPatches:UpdateRecords' :: UpdateRecords -> Maybe [RecordPatch]
$sel:deviceId:UpdateRecords' :: UpdateRecords -> Maybe Text
$sel:clientContext:UpdateRecords' :: UpdateRecords -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeviceId" 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
deviceId,
            (Key
"RecordPatches" 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 [RecordPatch]
recordPatches,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SyncSessionToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
syncSessionToken)
          ]
      )

instance Data.ToPath UpdateRecords where
  toPath :: UpdateRecords -> ByteString
toPath UpdateRecords' {Maybe [RecordPatch]
Maybe Text
Text
syncSessionToken :: Text
datasetName :: Text
identityId :: Text
identityPoolId :: Text
recordPatches :: Maybe [RecordPatch]
deviceId :: Maybe Text
clientContext :: Maybe Text
$sel:syncSessionToken:UpdateRecords' :: UpdateRecords -> Text
$sel:datasetName:UpdateRecords' :: UpdateRecords -> Text
$sel:identityId:UpdateRecords' :: UpdateRecords -> Text
$sel:identityPoolId:UpdateRecords' :: UpdateRecords -> Text
$sel:recordPatches:UpdateRecords' :: UpdateRecords -> Maybe [RecordPatch]
$sel:deviceId:UpdateRecords' :: UpdateRecords -> Maybe Text
$sel:clientContext:UpdateRecords' :: UpdateRecords -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/identitypools/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
identityPoolId,
        ByteString
"/identities/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
identityId,
        ByteString
"/datasets/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
datasetName
      ]

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

-- | Returned for a successful UpdateRecordsRequest.
--
-- /See:/ 'newUpdateRecordsResponse' smart constructor.
data UpdateRecordsResponse = UpdateRecordsResponse'
  { -- | A list of records that have been updated.
    UpdateRecordsResponse -> Maybe [Record]
records :: Prelude.Maybe [Record],
    -- | The response's http status code.
    UpdateRecordsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateRecordsResponse -> UpdateRecordsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRecordsResponse -> UpdateRecordsResponse -> Bool
$c/= :: UpdateRecordsResponse -> UpdateRecordsResponse -> Bool
== :: UpdateRecordsResponse -> UpdateRecordsResponse -> Bool
$c== :: UpdateRecordsResponse -> UpdateRecordsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateRecordsResponse]
ReadPrec UpdateRecordsResponse
Int -> ReadS UpdateRecordsResponse
ReadS [UpdateRecordsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRecordsResponse]
$creadListPrec :: ReadPrec [UpdateRecordsResponse]
readPrec :: ReadPrec UpdateRecordsResponse
$creadPrec :: ReadPrec UpdateRecordsResponse
readList :: ReadS [UpdateRecordsResponse]
$creadList :: ReadS [UpdateRecordsResponse]
readsPrec :: Int -> ReadS UpdateRecordsResponse
$creadsPrec :: Int -> ReadS UpdateRecordsResponse
Prelude.Read, Int -> UpdateRecordsResponse -> ShowS
[UpdateRecordsResponse] -> ShowS
UpdateRecordsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRecordsResponse] -> ShowS
$cshowList :: [UpdateRecordsResponse] -> ShowS
show :: UpdateRecordsResponse -> String
$cshow :: UpdateRecordsResponse -> String
showsPrec :: Int -> UpdateRecordsResponse -> ShowS
$cshowsPrec :: Int -> UpdateRecordsResponse -> ShowS
Prelude.Show, forall x. Rep UpdateRecordsResponse x -> UpdateRecordsResponse
forall x. UpdateRecordsResponse -> Rep UpdateRecordsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRecordsResponse x -> UpdateRecordsResponse
$cfrom :: forall x. UpdateRecordsResponse -> Rep UpdateRecordsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRecordsResponse' 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:
--
-- 'records', 'updateRecordsResponse_records' - A list of records that have been updated.
--
-- 'httpStatus', 'updateRecordsResponse_httpStatus' - The response's http status code.
newUpdateRecordsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateRecordsResponse
newUpdateRecordsResponse :: Int -> UpdateRecordsResponse
newUpdateRecordsResponse Int
pHttpStatus_ =
  UpdateRecordsResponse'
    { $sel:records:UpdateRecordsResponse' :: Maybe [Record]
records = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateRecordsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of records that have been updated.
updateRecordsResponse_records :: Lens.Lens' UpdateRecordsResponse (Prelude.Maybe [Record])
updateRecordsResponse_records :: Lens' UpdateRecordsResponse (Maybe [Record])
updateRecordsResponse_records = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecordsResponse' {Maybe [Record]
records :: Maybe [Record]
$sel:records:UpdateRecordsResponse' :: UpdateRecordsResponse -> Maybe [Record]
records} -> Maybe [Record]
records) (\s :: UpdateRecordsResponse
s@UpdateRecordsResponse' {} Maybe [Record]
a -> UpdateRecordsResponse
s {$sel:records:UpdateRecordsResponse' :: Maybe [Record]
records = Maybe [Record]
a} :: UpdateRecordsResponse) 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 response's http status code.
updateRecordsResponse_httpStatus :: Lens.Lens' UpdateRecordsResponse Prelude.Int
updateRecordsResponse_httpStatus :: Lens' UpdateRecordsResponse Int
updateRecordsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRecordsResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateRecordsResponse' :: UpdateRecordsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateRecordsResponse
s@UpdateRecordsResponse' {} Int
a -> UpdateRecordsResponse
s {$sel:httpStatus:UpdateRecordsResponse' :: Int
httpStatus = Int
a} :: UpdateRecordsResponse)

instance Prelude.NFData UpdateRecordsResponse where
  rnf :: UpdateRecordsResponse -> ()
rnf UpdateRecordsResponse' {Int
Maybe [Record]
httpStatus :: Int
records :: Maybe [Record]
$sel:httpStatus:UpdateRecordsResponse' :: UpdateRecordsResponse -> Int
$sel:records:UpdateRecordsResponse' :: UpdateRecordsResponse -> Maybe [Record]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Record]
records
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus