{-# 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.CreateEntity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an entity.
module Amazonka.IotTwinMaker.CreateEntity
  ( -- * Creating a Request
    CreateEntity (..),
    newCreateEntity,

    -- * Request Lenses
    createEntity_components,
    createEntity_description,
    createEntity_entityId,
    createEntity_parentEntityId,
    createEntity_tags,
    createEntity_workspaceId,
    createEntity_entityName,

    -- * Destructuring the Response
    CreateEntityResponse (..),
    newCreateEntityResponse,

    -- * Response Lenses
    createEntityResponse_httpStatus,
    createEntityResponse_entityId,
    createEntityResponse_arn,
    createEntityResponse_creationDateTime,
    createEntityResponse_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:/ 'newCreateEntity' smart constructor.
data CreateEntity = CreateEntity'
  { -- | An object that maps strings to the components in the entity. Each string
    -- in the mapping must be unique to this object.
    CreateEntity -> Maybe (HashMap Text ComponentRequest)
components :: Prelude.Maybe (Prelude.HashMap Prelude.Text ComponentRequest),
    -- | The description of the entity.
    CreateEntity -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ID of the entity.
    CreateEntity -> Maybe Text
entityId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the entity\'s parent entity.
    CreateEntity -> Maybe Text
parentEntityId :: Prelude.Maybe Prelude.Text,
    -- | Metadata that you can use to manage the entity.
    CreateEntity -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ID of the workspace that contains the entity.
    CreateEntity -> Text
workspaceId :: Prelude.Text,
    -- | The name of the entity.
    CreateEntity -> Text
entityName :: Prelude.Text
  }
  deriving (CreateEntity -> CreateEntity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEntity -> CreateEntity -> Bool
$c/= :: CreateEntity -> CreateEntity -> Bool
== :: CreateEntity -> CreateEntity -> Bool
$c== :: CreateEntity -> CreateEntity -> Bool
Prelude.Eq, ReadPrec [CreateEntity]
ReadPrec CreateEntity
Int -> ReadS CreateEntity
ReadS [CreateEntity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEntity]
$creadListPrec :: ReadPrec [CreateEntity]
readPrec :: ReadPrec CreateEntity
$creadPrec :: ReadPrec CreateEntity
readList :: ReadS [CreateEntity]
$creadList :: ReadS [CreateEntity]
readsPrec :: Int -> ReadS CreateEntity
$creadsPrec :: Int -> ReadS CreateEntity
Prelude.Read, Int -> CreateEntity -> ShowS
[CreateEntity] -> ShowS
CreateEntity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEntity] -> ShowS
$cshowList :: [CreateEntity] -> ShowS
show :: CreateEntity -> String
$cshow :: CreateEntity -> String
showsPrec :: Int -> CreateEntity -> ShowS
$cshowsPrec :: Int -> CreateEntity -> ShowS
Prelude.Show, forall x. Rep CreateEntity x -> CreateEntity
forall x. CreateEntity -> Rep CreateEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEntity x -> CreateEntity
$cfrom :: forall x. CreateEntity -> Rep CreateEntity x
Prelude.Generic)

-- |
-- Create a value of 'CreateEntity' 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:
--
-- 'components', 'createEntity_components' - An object that maps strings to the components in the entity. Each string
-- in the mapping must be unique to this object.
--
-- 'description', 'createEntity_description' - The description of the entity.
--
-- 'entityId', 'createEntity_entityId' - The ID of the entity.
--
-- 'parentEntityId', 'createEntity_parentEntityId' - The ID of the entity\'s parent entity.
--
-- 'tags', 'createEntity_tags' - Metadata that you can use to manage the entity.
--
-- 'workspaceId', 'createEntity_workspaceId' - The ID of the workspace that contains the entity.
--
-- 'entityName', 'createEntity_entityName' - The name of the entity.
newCreateEntity ::
  -- | 'workspaceId'
  Prelude.Text ->
  -- | 'entityName'
  Prelude.Text ->
  CreateEntity
newCreateEntity :: Text -> Text -> CreateEntity
newCreateEntity Text
pWorkspaceId_ Text
pEntityName_ =
  CreateEntity'
    { $sel:components:CreateEntity' :: Maybe (HashMap Text ComponentRequest)
components = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateEntity' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:entityId:CreateEntity' :: Maybe Text
entityId = forall a. Maybe a
Prelude.Nothing,
      $sel:parentEntityId:CreateEntity' :: Maybe Text
parentEntityId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateEntity' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:workspaceId:CreateEntity' :: Text
workspaceId = Text
pWorkspaceId_,
      $sel:entityName:CreateEntity' :: Text
entityName = Text
pEntityName_
    }

-- | An object that maps strings to the components in the entity. Each string
-- in the mapping must be unique to this object.
createEntity_components :: Lens.Lens' CreateEntity (Prelude.Maybe (Prelude.HashMap Prelude.Text ComponentRequest))
createEntity_components :: Lens' CreateEntity (Maybe (HashMap Text ComponentRequest))
createEntity_components = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntity' {Maybe (HashMap Text ComponentRequest)
components :: Maybe (HashMap Text ComponentRequest)
$sel:components:CreateEntity' :: CreateEntity -> Maybe (HashMap Text ComponentRequest)
components} -> Maybe (HashMap Text ComponentRequest)
components) (\s :: CreateEntity
s@CreateEntity' {} Maybe (HashMap Text ComponentRequest)
a -> CreateEntity
s {$sel:components:CreateEntity' :: Maybe (HashMap Text ComponentRequest)
components = Maybe (HashMap Text ComponentRequest)
a} :: CreateEntity) 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.
createEntity_description :: Lens.Lens' CreateEntity (Prelude.Maybe Prelude.Text)
createEntity_description :: Lens' CreateEntity (Maybe Text)
createEntity_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntity' {Maybe Text
description :: Maybe Text
$sel:description:CreateEntity' :: CreateEntity -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateEntity
s@CreateEntity' {} Maybe Text
a -> CreateEntity
s {$sel:description:CreateEntity' :: Maybe Text
description = Maybe Text
a} :: CreateEntity)

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

-- | The ID of the entity\'s parent entity.
createEntity_parentEntityId :: Lens.Lens' CreateEntity (Prelude.Maybe Prelude.Text)
createEntity_parentEntityId :: Lens' CreateEntity (Maybe Text)
createEntity_parentEntityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntity' {Maybe Text
parentEntityId :: Maybe Text
$sel:parentEntityId:CreateEntity' :: CreateEntity -> Maybe Text
parentEntityId} -> Maybe Text
parentEntityId) (\s :: CreateEntity
s@CreateEntity' {} Maybe Text
a -> CreateEntity
s {$sel:parentEntityId:CreateEntity' :: Maybe Text
parentEntityId = Maybe Text
a} :: CreateEntity)

-- | Metadata that you can use to manage the entity.
createEntity_tags :: Lens.Lens' CreateEntity (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createEntity_tags :: Lens' CreateEntity (Maybe (HashMap Text Text))
createEntity_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntity' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateEntity' :: CreateEntity -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateEntity
s@CreateEntity' {} Maybe (HashMap Text Text)
a -> CreateEntity
s {$sel:tags:CreateEntity' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateEntity) 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 ID of the workspace that contains the entity.
createEntity_workspaceId :: Lens.Lens' CreateEntity Prelude.Text
createEntity_workspaceId :: Lens' CreateEntity Text
createEntity_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntity' {Text
workspaceId :: Text
$sel:workspaceId:CreateEntity' :: CreateEntity -> Text
workspaceId} -> Text
workspaceId) (\s :: CreateEntity
s@CreateEntity' {} Text
a -> CreateEntity
s {$sel:workspaceId:CreateEntity' :: Text
workspaceId = Text
a} :: CreateEntity)

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

instance Core.AWSRequest CreateEntity where
  type AWSResponse CreateEntity = CreateEntityResponse
  request :: (Service -> Service) -> CreateEntity -> Request CreateEntity
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 CreateEntity
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateEntity)))
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 -> Text -> Text -> POSIX -> State -> CreateEntityResponse
CreateEntityResponse'
            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
"entityId")
            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
"arn")
            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
"creationDateTime")
            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 CreateEntity where
  hashWithSalt :: Int -> CreateEntity -> Int
hashWithSalt Int
_salt CreateEntity' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ComponentRequest)
Text
entityName :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
parentEntityId :: Maybe Text
entityId :: Maybe Text
description :: Maybe Text
components :: Maybe (HashMap Text ComponentRequest)
$sel:entityName:CreateEntity' :: CreateEntity -> Text
$sel:workspaceId:CreateEntity' :: CreateEntity -> Text
$sel:tags:CreateEntity' :: CreateEntity -> Maybe (HashMap Text Text)
$sel:parentEntityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:entityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:description:CreateEntity' :: CreateEntity -> Maybe Text
$sel:components:CreateEntity' :: CreateEntity -> Maybe (HashMap Text ComponentRequest)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text ComponentRequest)
components
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
entityId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parentEntityId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
entityName

instance Prelude.NFData CreateEntity where
  rnf :: CreateEntity -> ()
rnf CreateEntity' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ComponentRequest)
Text
entityName :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
parentEntityId :: Maybe Text
entityId :: Maybe Text
description :: Maybe Text
components :: Maybe (HashMap Text ComponentRequest)
$sel:entityName:CreateEntity' :: CreateEntity -> Text
$sel:workspaceId:CreateEntity' :: CreateEntity -> Text
$sel:tags:CreateEntity' :: CreateEntity -> Maybe (HashMap Text Text)
$sel:parentEntityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:entityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:description:CreateEntity' :: CreateEntity -> Maybe Text
$sel:components:CreateEntity' :: CreateEntity -> Maybe (HashMap Text ComponentRequest)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text ComponentRequest)
components
      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
entityId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentEntityId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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
entityName

instance Data.ToHeaders CreateEntity where
  toHeaders :: CreateEntity -> 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 CreateEntity where
  toJSON :: CreateEntity -> Value
toJSON CreateEntity' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ComponentRequest)
Text
entityName :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
parentEntityId :: Maybe Text
entityId :: Maybe Text
description :: Maybe Text
components :: Maybe (HashMap Text ComponentRequest)
$sel:entityName:CreateEntity' :: CreateEntity -> Text
$sel:workspaceId:CreateEntity' :: CreateEntity -> Text
$sel:tags:CreateEntity' :: CreateEntity -> Maybe (HashMap Text Text)
$sel:parentEntityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:entityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:description:CreateEntity' :: CreateEntity -> Maybe Text
$sel:components:CreateEntity' :: CreateEntity -> Maybe (HashMap Text ComponentRequest)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"components" 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 ComponentRequest)
components,
            (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
"entityId" 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
entityId,
            (Key
"parentEntityId" 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
parentEntityId,
            (Key
"tags" 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)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"entityName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
entityName)
          ]
      )

instance Data.ToPath CreateEntity where
  toPath :: CreateEntity -> ByteString
toPath CreateEntity' {Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap Text ComponentRequest)
Text
entityName :: Text
workspaceId :: Text
tags :: Maybe (HashMap Text Text)
parentEntityId :: Maybe Text
entityId :: Maybe Text
description :: Maybe Text
components :: Maybe (HashMap Text ComponentRequest)
$sel:entityName:CreateEntity' :: CreateEntity -> Text
$sel:workspaceId:CreateEntity' :: CreateEntity -> Text
$sel:tags:CreateEntity' :: CreateEntity -> Maybe (HashMap Text Text)
$sel:parentEntityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:entityId:CreateEntity' :: CreateEntity -> Maybe Text
$sel:description:CreateEntity' :: CreateEntity -> Maybe Text
$sel:components:CreateEntity' :: CreateEntity -> Maybe (HashMap Text ComponentRequest)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/workspaces/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId, ByteString
"/entities"]

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

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

-- |
-- Create a value of 'CreateEntityResponse' 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', 'createEntityResponse_httpStatus' - The response's http status code.
--
-- 'entityId', 'createEntityResponse_entityId' - The ID of the entity.
--
-- 'arn', 'createEntityResponse_arn' - The ARN of the entity.
--
-- 'creationDateTime', 'createEntityResponse_creationDateTime' - The date and time when the entity was created.
--
-- 'state', 'createEntityResponse_state' - The current state of the entity.
newCreateEntityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'entityId'
  Prelude.Text ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'creationDateTime'
  Prelude.UTCTime ->
  -- | 'state'
  State ->
  CreateEntityResponse
newCreateEntityResponse :: Int -> Text -> Text -> UTCTime -> State -> CreateEntityResponse
newCreateEntityResponse
  Int
pHttpStatus_
  Text
pEntityId_
  Text
pArn_
  UTCTime
pCreationDateTime_
  State
pState_ =
    CreateEntityResponse'
      { $sel:httpStatus:CreateEntityResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:entityId:CreateEntityResponse' :: Text
entityId = Text
pEntityId_,
        $sel:arn:CreateEntityResponse' :: Text
arn = Text
pArn_,
        $sel:creationDateTime:CreateEntityResponse' :: POSIX
creationDateTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationDateTime_,
        $sel:state:CreateEntityResponse' :: State
state = State
pState_
      }

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

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

-- | The ARN of the entity.
createEntityResponse_arn :: Lens.Lens' CreateEntityResponse Prelude.Text
createEntityResponse_arn :: Lens' CreateEntityResponse Text
createEntityResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntityResponse' {Text
arn :: Text
$sel:arn:CreateEntityResponse' :: CreateEntityResponse -> Text
arn} -> Text
arn) (\s :: CreateEntityResponse
s@CreateEntityResponse' {} Text
a -> CreateEntityResponse
s {$sel:arn:CreateEntityResponse' :: Text
arn = Text
a} :: CreateEntityResponse)

-- | The date and time when the entity was created.
createEntityResponse_creationDateTime :: Lens.Lens' CreateEntityResponse Prelude.UTCTime
createEntityResponse_creationDateTime :: Lens' CreateEntityResponse UTCTime
createEntityResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntityResponse' {POSIX
creationDateTime :: POSIX
$sel:creationDateTime:CreateEntityResponse' :: CreateEntityResponse -> POSIX
creationDateTime} -> POSIX
creationDateTime) (\s :: CreateEntityResponse
s@CreateEntityResponse' {} POSIX
a -> CreateEntityResponse
s {$sel:creationDateTime:CreateEntityResponse' :: POSIX
creationDateTime = POSIX
a} :: CreateEntityResponse) 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.
createEntityResponse_state :: Lens.Lens' CreateEntityResponse State
createEntityResponse_state :: Lens' CreateEntityResponse State
createEntityResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEntityResponse' {State
state :: State
$sel:state:CreateEntityResponse' :: CreateEntityResponse -> State
state} -> State
state) (\s :: CreateEntityResponse
s@CreateEntityResponse' {} State
a -> CreateEntityResponse
s {$sel:state:CreateEntityResponse' :: State
state = State
a} :: CreateEntityResponse)

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