{-# 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.UpdateEntity
-- 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 an entity.
module Amazonka.IotTwinMaker.UpdateEntity
  ( -- * Creating a Request
    UpdateEntity (..),
    newUpdateEntity,

    -- * Request Lenses
    updateEntity_componentUpdates,
    updateEntity_description,
    updateEntity_entityName,
    updateEntity_parentEntityUpdate,
    updateEntity_workspaceId,
    updateEntity_entityId,

    -- * Destructuring the Response
    UpdateEntityResponse (..),
    newUpdateEntityResponse,

    -- * Response Lenses
    updateEntityResponse_httpStatus,
    updateEntityResponse_updateDateTime,
    updateEntityResponse_state,
  )
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:/ 'newUpdateEntity' smart constructor.
data UpdateEntity = UpdateEntity'
  { -- | An object that maps strings to the component updates in the request.
    -- Each string in the mapping must be unique to this object.
    UpdateEntity -> Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates :: Prelude.Maybe (Prelude.HashMap Prelude.Text ComponentUpdateRequest),
    -- | The description of the entity.
    UpdateEntity -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the entity.
    UpdateEntity -> Maybe Text
entityName :: Prelude.Maybe Prelude.Text,
    -- | An object that describes the update request for a parent entity.
    UpdateEntity -> Maybe ParentEntityUpdateRequest
parentEntityUpdate :: Prelude.Maybe ParentEntityUpdateRequest,
    -- | The ID of the workspace that contains the entity.
    UpdateEntity -> Text
workspaceId :: Prelude.Text,
    -- | The ID of the entity.
    UpdateEntity -> Text
entityId :: Prelude.Text
  }
  deriving (UpdateEntity -> UpdateEntity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEntity -> UpdateEntity -> Bool
$c/= :: UpdateEntity -> UpdateEntity -> Bool
== :: UpdateEntity -> UpdateEntity -> Bool
$c== :: UpdateEntity -> UpdateEntity -> Bool
Prelude.Eq, ReadPrec [UpdateEntity]
ReadPrec UpdateEntity
Int -> ReadS UpdateEntity
ReadS [UpdateEntity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEntity]
$creadListPrec :: ReadPrec [UpdateEntity]
readPrec :: ReadPrec UpdateEntity
$creadPrec :: ReadPrec UpdateEntity
readList :: ReadS [UpdateEntity]
$creadList :: ReadS [UpdateEntity]
readsPrec :: Int -> ReadS UpdateEntity
$creadsPrec :: Int -> ReadS UpdateEntity
Prelude.Read, Int -> UpdateEntity -> ShowS
[UpdateEntity] -> ShowS
UpdateEntity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEntity] -> ShowS
$cshowList :: [UpdateEntity] -> ShowS
show :: UpdateEntity -> String
$cshow :: UpdateEntity -> String
showsPrec :: Int -> UpdateEntity -> ShowS
$cshowsPrec :: Int -> UpdateEntity -> ShowS
Prelude.Show, forall x. Rep UpdateEntity x -> UpdateEntity
forall x. UpdateEntity -> Rep UpdateEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateEntity x -> UpdateEntity
$cfrom :: forall x. UpdateEntity -> Rep UpdateEntity x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEntity' 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:
--
-- 'componentUpdates', 'updateEntity_componentUpdates' - An object that maps strings to the component updates in the request.
-- Each string in the mapping must be unique to this object.
--
-- 'description', 'updateEntity_description' - The description of the entity.
--
-- 'entityName', 'updateEntity_entityName' - The name of the entity.
--
-- 'parentEntityUpdate', 'updateEntity_parentEntityUpdate' - An object that describes the update request for a parent entity.
--
-- 'workspaceId', 'updateEntity_workspaceId' - The ID of the workspace that contains the entity.
--
-- 'entityId', 'updateEntity_entityId' - The ID of the entity.
newUpdateEntity ::
  -- | 'workspaceId'
  Prelude.Text ->
  -- | 'entityId'
  Prelude.Text ->
  UpdateEntity
newUpdateEntity :: Text -> Text -> UpdateEntity
newUpdateEntity Text
pWorkspaceId_ Text
pEntityId_ =
  UpdateEntity'
    { $sel:componentUpdates:UpdateEntity' :: Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateEntity' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:entityName:UpdateEntity' :: Maybe Text
entityName = forall a. Maybe a
Prelude.Nothing,
      $sel:parentEntityUpdate:UpdateEntity' :: Maybe ParentEntityUpdateRequest
parentEntityUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:workspaceId:UpdateEntity' :: Text
workspaceId = Text
pWorkspaceId_,
      $sel:entityId:UpdateEntity' :: Text
entityId = Text
pEntityId_
    }

-- | An object that maps strings to the component updates in the request.
-- Each string in the mapping must be unique to this object.
updateEntity_componentUpdates :: Lens.Lens' UpdateEntity (Prelude.Maybe (Prelude.HashMap Prelude.Text ComponentUpdateRequest))
updateEntity_componentUpdates :: Lens' UpdateEntity (Maybe (HashMap Text ComponentUpdateRequest))
updateEntity_componentUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEntity' {Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates :: Maybe (HashMap Text ComponentUpdateRequest)
$sel:componentUpdates:UpdateEntity' :: UpdateEntity -> Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates} -> Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates) (\s :: UpdateEntity
s@UpdateEntity' {} Maybe (HashMap Text ComponentUpdateRequest)
a -> UpdateEntity
s {$sel:componentUpdates:UpdateEntity' :: Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates = Maybe (HashMap Text ComponentUpdateRequest)
a} :: UpdateEntity) 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 description of the entity.
updateEntity_description :: Lens.Lens' UpdateEntity (Prelude.Maybe Prelude.Text)
updateEntity_description :: Lens' UpdateEntity (Maybe Text)
updateEntity_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEntity' {Maybe Text
description :: Maybe Text
$sel:description:UpdateEntity' :: UpdateEntity -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateEntity
s@UpdateEntity' {} Maybe Text
a -> UpdateEntity
s {$sel:description:UpdateEntity' :: Maybe Text
description = Maybe Text
a} :: UpdateEntity)

-- | The name of the entity.
updateEntity_entityName :: Lens.Lens' UpdateEntity (Prelude.Maybe Prelude.Text)
updateEntity_entityName :: Lens' UpdateEntity (Maybe Text)
updateEntity_entityName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEntity' {Maybe Text
entityName :: Maybe Text
$sel:entityName:UpdateEntity' :: UpdateEntity -> Maybe Text
entityName} -> Maybe Text
entityName) (\s :: UpdateEntity
s@UpdateEntity' {} Maybe Text
a -> UpdateEntity
s {$sel:entityName:UpdateEntity' :: Maybe Text
entityName = Maybe Text
a} :: UpdateEntity)

-- | An object that describes the update request for a parent entity.
updateEntity_parentEntityUpdate :: Lens.Lens' UpdateEntity (Prelude.Maybe ParentEntityUpdateRequest)
updateEntity_parentEntityUpdate :: Lens' UpdateEntity (Maybe ParentEntityUpdateRequest)
updateEntity_parentEntityUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEntity' {Maybe ParentEntityUpdateRequest
parentEntityUpdate :: Maybe ParentEntityUpdateRequest
$sel:parentEntityUpdate:UpdateEntity' :: UpdateEntity -> Maybe ParentEntityUpdateRequest
parentEntityUpdate} -> Maybe ParentEntityUpdateRequest
parentEntityUpdate) (\s :: UpdateEntity
s@UpdateEntity' {} Maybe ParentEntityUpdateRequest
a -> UpdateEntity
s {$sel:parentEntityUpdate:UpdateEntity' :: Maybe ParentEntityUpdateRequest
parentEntityUpdate = Maybe ParentEntityUpdateRequest
a} :: UpdateEntity)

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

-- | The ID of the entity.
updateEntity_entityId :: Lens.Lens' UpdateEntity Prelude.Text
updateEntity_entityId :: Lens' UpdateEntity Text
updateEntity_entityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEntity' {Text
entityId :: Text
$sel:entityId:UpdateEntity' :: UpdateEntity -> Text
entityId} -> Text
entityId) (\s :: UpdateEntity
s@UpdateEntity' {} Text
a -> UpdateEntity
s {$sel:entityId:UpdateEntity' :: Text
entityId = Text
a} :: UpdateEntity)

instance Core.AWSRequest UpdateEntity where
  type AWSResponse UpdateEntity = UpdateEntityResponse
  request :: (Service -> Service) -> UpdateEntity -> Request UpdateEntity
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 UpdateEntity
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateEntity)))
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 -> POSIX -> State -> UpdateEntityResponse
UpdateEntityResponse'
            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
"updateDateTime")
            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
"state")
      )

instance Prelude.Hashable UpdateEntity where
  hashWithSalt :: Int -> UpdateEntity -> Int
hashWithSalt Int
_salt UpdateEntity' {Maybe Text
Maybe (HashMap Text ComponentUpdateRequest)
Maybe ParentEntityUpdateRequest
Text
entityId :: Text
workspaceId :: Text
parentEntityUpdate :: Maybe ParentEntityUpdateRequest
entityName :: Maybe Text
description :: Maybe Text
componentUpdates :: Maybe (HashMap Text ComponentUpdateRequest)
$sel:entityId:UpdateEntity' :: UpdateEntity -> Text
$sel:workspaceId:UpdateEntity' :: UpdateEntity -> Text
$sel:parentEntityUpdate:UpdateEntity' :: UpdateEntity -> Maybe ParentEntityUpdateRequest
$sel:entityName:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:description:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:componentUpdates:UpdateEntity' :: UpdateEntity -> Maybe (HashMap Text ComponentUpdateRequest)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
entityName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ParentEntityUpdateRequest
parentEntityUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
entityId

instance Prelude.NFData UpdateEntity where
  rnf :: UpdateEntity -> ()
rnf UpdateEntity' {Maybe Text
Maybe (HashMap Text ComponentUpdateRequest)
Maybe ParentEntityUpdateRequest
Text
entityId :: Text
workspaceId :: Text
parentEntityUpdate :: Maybe ParentEntityUpdateRequest
entityName :: Maybe Text
description :: Maybe Text
componentUpdates :: Maybe (HashMap Text ComponentUpdateRequest)
$sel:entityId:UpdateEntity' :: UpdateEntity -> Text
$sel:workspaceId:UpdateEntity' :: UpdateEntity -> Text
$sel:parentEntityUpdate:UpdateEntity' :: UpdateEntity -> Maybe ParentEntityUpdateRequest
$sel:entityName:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:description:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:componentUpdates:UpdateEntity' :: UpdateEntity -> Maybe (HashMap Text ComponentUpdateRequest)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text ComponentUpdateRequest)
componentUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
entityName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ParentEntityUpdateRequest
parentEntityUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
entityId

instance Data.ToHeaders UpdateEntity where
  toHeaders :: UpdateEntity -> 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 UpdateEntity where
  toJSON :: UpdateEntity -> Value
toJSON UpdateEntity' {Maybe Text
Maybe (HashMap Text ComponentUpdateRequest)
Maybe ParentEntityUpdateRequest
Text
entityId :: Text
workspaceId :: Text
parentEntityUpdate :: Maybe ParentEntityUpdateRequest
entityName :: Maybe Text
description :: Maybe Text
componentUpdates :: Maybe (HashMap Text ComponentUpdateRequest)
$sel:entityId:UpdateEntity' :: UpdateEntity -> Text
$sel:workspaceId:UpdateEntity' :: UpdateEntity -> Text
$sel:parentEntityUpdate:UpdateEntity' :: UpdateEntity -> Maybe ParentEntityUpdateRequest
$sel:entityName:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:description:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:componentUpdates:UpdateEntity' :: UpdateEntity -> Maybe (HashMap Text ComponentUpdateRequest)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"componentUpdates" 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 ComponentUpdateRequest)
componentUpdates,
            (Key
"description" 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
description,
            (Key
"entityName" 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
entityName,
            (Key
"parentEntityUpdate" 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 ParentEntityUpdateRequest
parentEntityUpdate
          ]
      )

instance Data.ToPath UpdateEntity where
  toPath :: UpdateEntity -> ByteString
toPath UpdateEntity' {Maybe Text
Maybe (HashMap Text ComponentUpdateRequest)
Maybe ParentEntityUpdateRequest
Text
entityId :: Text
workspaceId :: Text
parentEntityUpdate :: Maybe ParentEntityUpdateRequest
entityName :: Maybe Text
description :: Maybe Text
componentUpdates :: Maybe (HashMap Text ComponentUpdateRequest)
$sel:entityId:UpdateEntity' :: UpdateEntity -> Text
$sel:workspaceId:UpdateEntity' :: UpdateEntity -> Text
$sel:parentEntityUpdate:UpdateEntity' :: UpdateEntity -> Maybe ParentEntityUpdateRequest
$sel:entityName:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:description:UpdateEntity' :: UpdateEntity -> Maybe Text
$sel:componentUpdates:UpdateEntity' :: UpdateEntity -> Maybe (HashMap Text ComponentUpdateRequest)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workspaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId,
        ByteString
"/entities/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
entityId
      ]

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

-- | /See:/ 'newUpdateEntityResponse' smart constructor.
data UpdateEntityResponse = UpdateEntityResponse'
  { -- | The response's http status code.
    UpdateEntityResponse -> Int
httpStatus :: Prelude.Int,
    -- | The date and time when the entity was last updated.
    UpdateEntityResponse -> POSIX
updateDateTime :: Data.POSIX,
    -- | The current state of the entity update.
    UpdateEntityResponse -> State
state :: State
  }
  deriving (UpdateEntityResponse -> UpdateEntityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEntityResponse -> UpdateEntityResponse -> Bool
$c/= :: UpdateEntityResponse -> UpdateEntityResponse -> Bool
== :: UpdateEntityResponse -> UpdateEntityResponse -> Bool
$c== :: UpdateEntityResponse -> UpdateEntityResponse -> Bool
Prelude.Eq, ReadPrec [UpdateEntityResponse]
ReadPrec UpdateEntityResponse
Int -> ReadS UpdateEntityResponse
ReadS [UpdateEntityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEntityResponse]
$creadListPrec :: ReadPrec [UpdateEntityResponse]
readPrec :: ReadPrec UpdateEntityResponse
$creadPrec :: ReadPrec UpdateEntityResponse
readList :: ReadS [UpdateEntityResponse]
$creadList :: ReadS [UpdateEntityResponse]
readsPrec :: Int -> ReadS UpdateEntityResponse
$creadsPrec :: Int -> ReadS UpdateEntityResponse
Prelude.Read, Int -> UpdateEntityResponse -> ShowS
[UpdateEntityResponse] -> ShowS
UpdateEntityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEntityResponse] -> ShowS
$cshowList :: [UpdateEntityResponse] -> ShowS
show :: UpdateEntityResponse -> String
$cshow :: UpdateEntityResponse -> String
showsPrec :: Int -> UpdateEntityResponse -> ShowS
$cshowsPrec :: Int -> UpdateEntityResponse -> ShowS
Prelude.Show, forall x. Rep UpdateEntityResponse x -> UpdateEntityResponse
forall x. UpdateEntityResponse -> Rep UpdateEntityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateEntityResponse x -> UpdateEntityResponse
$cfrom :: forall x. UpdateEntityResponse -> Rep UpdateEntityResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEntityResponse' 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', 'updateEntityResponse_httpStatus' - The response's http status code.
--
-- 'updateDateTime', 'updateEntityResponse_updateDateTime' - The date and time when the entity was last updated.
--
-- 'state', 'updateEntityResponse_state' - The current state of the entity update.
newUpdateEntityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'updateDateTime'
  Prelude.UTCTime ->
  -- | 'state'
  State ->
  UpdateEntityResponse
newUpdateEntityResponse :: Int -> UTCTime -> State -> UpdateEntityResponse
newUpdateEntityResponse
  Int
pHttpStatus_
  UTCTime
pUpdateDateTime_
  State
pState_ =
    UpdateEntityResponse'
      { $sel:httpStatus:UpdateEntityResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:updateDateTime:UpdateEntityResponse' :: POSIX
updateDateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateDateTime_,
        $sel:state:UpdateEntityResponse' :: State
state = State
pState_
      }

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

-- | The date and time when the entity was last updated.
updateEntityResponse_updateDateTime :: Lens.Lens' UpdateEntityResponse Prelude.UTCTime
updateEntityResponse_updateDateTime :: Lens' UpdateEntityResponse UTCTime
updateEntityResponse_updateDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEntityResponse' {POSIX
updateDateTime :: POSIX
$sel:updateDateTime:UpdateEntityResponse' :: UpdateEntityResponse -> POSIX
updateDateTime} -> POSIX
updateDateTime) (\s :: UpdateEntityResponse
s@UpdateEntityResponse' {} POSIX
a -> UpdateEntityResponse
s {$sel:updateDateTime:UpdateEntityResponse' :: POSIX
updateDateTime = POSIX
a} :: UpdateEntityResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The current state of the entity update.
updateEntityResponse_state :: Lens.Lens' UpdateEntityResponse State
updateEntityResponse_state :: Lens' UpdateEntityResponse State
updateEntityResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEntityResponse' {State
state :: State
$sel:state:UpdateEntityResponse' :: UpdateEntityResponse -> State
state} -> State
state) (\s :: UpdateEntityResponse
s@UpdateEntityResponse' {} State
a -> UpdateEntityResponse
s {$sel:state:UpdateEntityResponse' :: State
state = State
a} :: UpdateEntityResponse)

instance Prelude.NFData UpdateEntityResponse where
  rnf :: UpdateEntityResponse -> ()
rnf UpdateEntityResponse' {Int
POSIX
State
state :: State
updateDateTime :: POSIX
httpStatus :: Int
$sel:state:UpdateEntityResponse' :: UpdateEntityResponse -> State
$sel:updateDateTime:UpdateEntityResponse' :: UpdateEntityResponse -> POSIX
$sel:httpStatus:UpdateEntityResponse' :: UpdateEntityResponse -> 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 POSIX
updateDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf State
state