{-# 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.IoTSiteWise.CreateDashboard
-- 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 a dashboard in an IoT SiteWise Monitor project.
module Amazonka.IoTSiteWise.CreateDashboard
  ( -- * Creating a Request
    CreateDashboard (..),
    newCreateDashboard,

    -- * Request Lenses
    createDashboard_clientToken,
    createDashboard_dashboardDescription,
    createDashboard_tags,
    createDashboard_projectId,
    createDashboard_dashboardName,
    createDashboard_dashboardDefinition,

    -- * Destructuring the Response
    CreateDashboardResponse (..),
    newCreateDashboardResponse,

    -- * Response Lenses
    createDashboardResponse_httpStatus,
    createDashboardResponse_dashboardId,
    createDashboardResponse_dashboardArn,
  )
where

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

-- | /See:/ 'newCreateDashboard' smart constructor.
data CreateDashboard = CreateDashboard'
  { -- | A unique case-sensitive identifier that you can provide to ensure the
    -- idempotency of the request. Don\'t reuse this client token if a new
    -- idempotent request is required.
    CreateDashboard -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the dashboard.
    CreateDashboard -> Maybe Text
dashboardDescription :: Prelude.Maybe Prelude.Text,
    -- | A list of key-value pairs that contain metadata for the dashboard. For
    -- more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
    -- in the /IoT SiteWise User Guide/.
    CreateDashboard -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ID of the project in which to create the dashboard.
    CreateDashboard -> Text
projectId :: Prelude.Text,
    -- | A friendly name for the dashboard.
    CreateDashboard -> Text
dashboardName :: Prelude.Text,
    -- | The dashboard definition specified in a JSON literal. For detailed
    -- information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/create-dashboards-using-aws-cli.html Creating dashboards (CLI)>
    -- in the /IoT SiteWise User Guide/.
    CreateDashboard -> Text
dashboardDefinition :: Prelude.Text
  }
  deriving (CreateDashboard -> CreateDashboard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDashboard -> CreateDashboard -> Bool
$c/= :: CreateDashboard -> CreateDashboard -> Bool
== :: CreateDashboard -> CreateDashboard -> Bool
$c== :: CreateDashboard -> CreateDashboard -> Bool
Prelude.Eq, ReadPrec [CreateDashboard]
ReadPrec CreateDashboard
Int -> ReadS CreateDashboard
ReadS [CreateDashboard]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDashboard]
$creadListPrec :: ReadPrec [CreateDashboard]
readPrec :: ReadPrec CreateDashboard
$creadPrec :: ReadPrec CreateDashboard
readList :: ReadS [CreateDashboard]
$creadList :: ReadS [CreateDashboard]
readsPrec :: Int -> ReadS CreateDashboard
$creadsPrec :: Int -> ReadS CreateDashboard
Prelude.Read, Int -> CreateDashboard -> ShowS
[CreateDashboard] -> ShowS
CreateDashboard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDashboard] -> ShowS
$cshowList :: [CreateDashboard] -> ShowS
show :: CreateDashboard -> String
$cshow :: CreateDashboard -> String
showsPrec :: Int -> CreateDashboard -> ShowS
$cshowsPrec :: Int -> CreateDashboard -> ShowS
Prelude.Show, forall x. Rep CreateDashboard x -> CreateDashboard
forall x. CreateDashboard -> Rep CreateDashboard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDashboard x -> CreateDashboard
$cfrom :: forall x. CreateDashboard -> Rep CreateDashboard x
Prelude.Generic)

-- |
-- Create a value of 'CreateDashboard' 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:
--
-- 'clientToken', 'createDashboard_clientToken' - A unique case-sensitive identifier that you can provide to ensure the
-- idempotency of the request. Don\'t reuse this client token if a new
-- idempotent request is required.
--
-- 'dashboardDescription', 'createDashboard_dashboardDescription' - A description for the dashboard.
--
-- 'tags', 'createDashboard_tags' - A list of key-value pairs that contain metadata for the dashboard. For
-- more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
-- in the /IoT SiteWise User Guide/.
--
-- 'projectId', 'createDashboard_projectId' - The ID of the project in which to create the dashboard.
--
-- 'dashboardName', 'createDashboard_dashboardName' - A friendly name for the dashboard.
--
-- 'dashboardDefinition', 'createDashboard_dashboardDefinition' - The dashboard definition specified in a JSON literal. For detailed
-- information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/create-dashboards-using-aws-cli.html Creating dashboards (CLI)>
-- in the /IoT SiteWise User Guide/.
newCreateDashboard ::
  -- | 'projectId'
  Prelude.Text ->
  -- | 'dashboardName'
  Prelude.Text ->
  -- | 'dashboardDefinition'
  Prelude.Text ->
  CreateDashboard
newCreateDashboard :: Text -> Text -> Text -> CreateDashboard
newCreateDashboard
  Text
pProjectId_
  Text
pDashboardName_
  Text
pDashboardDefinition_ =
    CreateDashboard'
      { $sel:clientToken:CreateDashboard' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:dashboardDescription:CreateDashboard' :: Maybe Text
dashboardDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDashboard' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:projectId:CreateDashboard' :: Text
projectId = Text
pProjectId_,
        $sel:dashboardName:CreateDashboard' :: Text
dashboardName = Text
pDashboardName_,
        $sel:dashboardDefinition:CreateDashboard' :: Text
dashboardDefinition = Text
pDashboardDefinition_
      }

-- | A unique case-sensitive identifier that you can provide to ensure the
-- idempotency of the request. Don\'t reuse this client token if a new
-- idempotent request is required.
createDashboard_clientToken :: Lens.Lens' CreateDashboard (Prelude.Maybe Prelude.Text)
createDashboard_clientToken :: Lens' CreateDashboard (Maybe Text)
createDashboard_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboard' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateDashboard' :: CreateDashboard -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateDashboard
s@CreateDashboard' {} Maybe Text
a -> CreateDashboard
s {$sel:clientToken:CreateDashboard' :: Maybe Text
clientToken = Maybe Text
a} :: CreateDashboard)

-- | A description for the dashboard.
createDashboard_dashboardDescription :: Lens.Lens' CreateDashboard (Prelude.Maybe Prelude.Text)
createDashboard_dashboardDescription :: Lens' CreateDashboard (Maybe Text)
createDashboard_dashboardDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboard' {Maybe Text
dashboardDescription :: Maybe Text
$sel:dashboardDescription:CreateDashboard' :: CreateDashboard -> Maybe Text
dashboardDescription} -> Maybe Text
dashboardDescription) (\s :: CreateDashboard
s@CreateDashboard' {} Maybe Text
a -> CreateDashboard
s {$sel:dashboardDescription:CreateDashboard' :: Maybe Text
dashboardDescription = Maybe Text
a} :: CreateDashboard)

-- | A list of key-value pairs that contain metadata for the dashboard. For
-- more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
-- in the /IoT SiteWise User Guide/.
createDashboard_tags :: Lens.Lens' CreateDashboard (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createDashboard_tags :: Lens' CreateDashboard (Maybe (HashMap Text Text))
createDashboard_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboard' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateDashboard' :: CreateDashboard -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateDashboard
s@CreateDashboard' {} Maybe (HashMap Text Text)
a -> CreateDashboard
s {$sel:tags:CreateDashboard' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateDashboard) 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 project in which to create the dashboard.
createDashboard_projectId :: Lens.Lens' CreateDashboard Prelude.Text
createDashboard_projectId :: Lens' CreateDashboard Text
createDashboard_projectId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboard' {Text
projectId :: Text
$sel:projectId:CreateDashboard' :: CreateDashboard -> Text
projectId} -> Text
projectId) (\s :: CreateDashboard
s@CreateDashboard' {} Text
a -> CreateDashboard
s {$sel:projectId:CreateDashboard' :: Text
projectId = Text
a} :: CreateDashboard)

-- | A friendly name for the dashboard.
createDashboard_dashboardName :: Lens.Lens' CreateDashboard Prelude.Text
createDashboard_dashboardName :: Lens' CreateDashboard Text
createDashboard_dashboardName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboard' {Text
dashboardName :: Text
$sel:dashboardName:CreateDashboard' :: CreateDashboard -> Text
dashboardName} -> Text
dashboardName) (\s :: CreateDashboard
s@CreateDashboard' {} Text
a -> CreateDashboard
s {$sel:dashboardName:CreateDashboard' :: Text
dashboardName = Text
a} :: CreateDashboard)

-- | The dashboard definition specified in a JSON literal. For detailed
-- information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/create-dashboards-using-aws-cli.html Creating dashboards (CLI)>
-- in the /IoT SiteWise User Guide/.
createDashboard_dashboardDefinition :: Lens.Lens' CreateDashboard Prelude.Text
createDashboard_dashboardDefinition :: Lens' CreateDashboard Text
createDashboard_dashboardDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboard' {Text
dashboardDefinition :: Text
$sel:dashboardDefinition:CreateDashboard' :: CreateDashboard -> Text
dashboardDefinition} -> Text
dashboardDefinition) (\s :: CreateDashboard
s@CreateDashboard' {} Text
a -> CreateDashboard
s {$sel:dashboardDefinition:CreateDashboard' :: Text
dashboardDefinition = Text
a} :: CreateDashboard)

instance Core.AWSRequest CreateDashboard where
  type
    AWSResponse CreateDashboard =
      CreateDashboardResponse
  request :: (Service -> Service) -> CreateDashboard -> Request CreateDashboard
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 CreateDashboard
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDashboard)))
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 -> CreateDashboardResponse
CreateDashboardResponse'
            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
"dashboardId")
            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
"dashboardArn")
      )

instance Prelude.Hashable CreateDashboard where
  hashWithSalt :: Int -> CreateDashboard -> Int
hashWithSalt Int
_salt CreateDashboard' {Maybe Text
Maybe (HashMap Text Text)
Text
dashboardDefinition :: Text
dashboardName :: Text
projectId :: Text
tags :: Maybe (HashMap Text Text)
dashboardDescription :: Maybe Text
clientToken :: Maybe Text
$sel:dashboardDefinition:CreateDashboard' :: CreateDashboard -> Text
$sel:dashboardName:CreateDashboard' :: CreateDashboard -> Text
$sel:projectId:CreateDashboard' :: CreateDashboard -> Text
$sel:tags:CreateDashboard' :: CreateDashboard -> Maybe (HashMap Text Text)
$sel:dashboardDescription:CreateDashboard' :: CreateDashboard -> Maybe Text
$sel:clientToken:CreateDashboard' :: CreateDashboard -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dashboardDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
projectId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dashboardName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dashboardDefinition

instance Prelude.NFData CreateDashboard where
  rnf :: CreateDashboard -> ()
rnf CreateDashboard' {Maybe Text
Maybe (HashMap Text Text)
Text
dashboardDefinition :: Text
dashboardName :: Text
projectId :: Text
tags :: Maybe (HashMap Text Text)
dashboardDescription :: Maybe Text
clientToken :: Maybe Text
$sel:dashboardDefinition:CreateDashboard' :: CreateDashboard -> Text
$sel:dashboardName:CreateDashboard' :: CreateDashboard -> Text
$sel:projectId:CreateDashboard' :: CreateDashboard -> Text
$sel:tags:CreateDashboard' :: CreateDashboard -> Maybe (HashMap Text Text)
$sel:dashboardDescription:CreateDashboard' :: CreateDashboard -> Maybe Text
$sel:clientToken:CreateDashboard' :: CreateDashboard -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dashboardDescription
      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
projectId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dashboardName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dashboardDefinition

instance Data.ToHeaders CreateDashboard where
  toHeaders :: CreateDashboard -> 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 CreateDashboard where
  toJSON :: CreateDashboard -> Value
toJSON CreateDashboard' {Maybe Text
Maybe (HashMap Text Text)
Text
dashboardDefinition :: Text
dashboardName :: Text
projectId :: Text
tags :: Maybe (HashMap Text Text)
dashboardDescription :: Maybe Text
clientToken :: Maybe Text
$sel:dashboardDefinition:CreateDashboard' :: CreateDashboard -> Text
$sel:dashboardName:CreateDashboard' :: CreateDashboard -> Text
$sel:projectId:CreateDashboard' :: CreateDashboard -> Text
$sel:tags:CreateDashboard' :: CreateDashboard -> Maybe (HashMap Text Text)
$sel:dashboardDescription:CreateDashboard' :: CreateDashboard -> Maybe Text
$sel:clientToken:CreateDashboard' :: CreateDashboard -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"dashboardDescription" 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
dashboardDescription,
            (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
"projectId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
projectId),
            forall a. a -> Maybe a
Prelude.Just (Key
"dashboardName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dashboardName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"dashboardDefinition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dashboardDefinition)
          ]
      )

instance Data.ToPath CreateDashboard where
  toPath :: CreateDashboard -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/dashboards"

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

-- | /See:/ 'newCreateDashboardResponse' smart constructor.
data CreateDashboardResponse = CreateDashboardResponse'
  { -- | The response's http status code.
    CreateDashboardResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the dashboard.
    CreateDashboardResponse -> Text
dashboardId :: Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the dashboard, which has the following format.
    --
    -- @arn:${Partition}:iotsitewise:${Region}:${Account}:dashboard\/${DashboardId}@
    CreateDashboardResponse -> Text
dashboardArn :: Prelude.Text
  }
  deriving (CreateDashboardResponse -> CreateDashboardResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDashboardResponse -> CreateDashboardResponse -> Bool
$c/= :: CreateDashboardResponse -> CreateDashboardResponse -> Bool
== :: CreateDashboardResponse -> CreateDashboardResponse -> Bool
$c== :: CreateDashboardResponse -> CreateDashboardResponse -> Bool
Prelude.Eq, ReadPrec [CreateDashboardResponse]
ReadPrec CreateDashboardResponse
Int -> ReadS CreateDashboardResponse
ReadS [CreateDashboardResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDashboardResponse]
$creadListPrec :: ReadPrec [CreateDashboardResponse]
readPrec :: ReadPrec CreateDashboardResponse
$creadPrec :: ReadPrec CreateDashboardResponse
readList :: ReadS [CreateDashboardResponse]
$creadList :: ReadS [CreateDashboardResponse]
readsPrec :: Int -> ReadS CreateDashboardResponse
$creadsPrec :: Int -> ReadS CreateDashboardResponse
Prelude.Read, Int -> CreateDashboardResponse -> ShowS
[CreateDashboardResponse] -> ShowS
CreateDashboardResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDashboardResponse] -> ShowS
$cshowList :: [CreateDashboardResponse] -> ShowS
show :: CreateDashboardResponse -> String
$cshow :: CreateDashboardResponse -> String
showsPrec :: Int -> CreateDashboardResponse -> ShowS
$cshowsPrec :: Int -> CreateDashboardResponse -> ShowS
Prelude.Show, forall x. Rep CreateDashboardResponse x -> CreateDashboardResponse
forall x. CreateDashboardResponse -> Rep CreateDashboardResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDashboardResponse x -> CreateDashboardResponse
$cfrom :: forall x. CreateDashboardResponse -> Rep CreateDashboardResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDashboardResponse' 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', 'createDashboardResponse_httpStatus' - The response's http status code.
--
-- 'dashboardId', 'createDashboardResponse_dashboardId' - The ID of the dashboard.
--
-- 'dashboardArn', 'createDashboardResponse_dashboardArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the dashboard, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:dashboard\/${DashboardId}@
newCreateDashboardResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'dashboardId'
  Prelude.Text ->
  -- | 'dashboardArn'
  Prelude.Text ->
  CreateDashboardResponse
newCreateDashboardResponse :: Int -> Text -> Text -> CreateDashboardResponse
newCreateDashboardResponse
  Int
pHttpStatus_
  Text
pDashboardId_
  Text
pDashboardArn_ =
    CreateDashboardResponse'
      { $sel:httpStatus:CreateDashboardResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:dashboardId:CreateDashboardResponse' :: Text
dashboardId = Text
pDashboardId_,
        $sel:dashboardArn:CreateDashboardResponse' :: Text
dashboardArn = Text
pDashboardArn_
      }

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

-- | The ID of the dashboard.
createDashboardResponse_dashboardId :: Lens.Lens' CreateDashboardResponse Prelude.Text
createDashboardResponse_dashboardId :: Lens' CreateDashboardResponse Text
createDashboardResponse_dashboardId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboardResponse' {Text
dashboardId :: Text
$sel:dashboardId:CreateDashboardResponse' :: CreateDashboardResponse -> Text
dashboardId} -> Text
dashboardId) (\s :: CreateDashboardResponse
s@CreateDashboardResponse' {} Text
a -> CreateDashboardResponse
s {$sel:dashboardId:CreateDashboardResponse' :: Text
dashboardId = Text
a} :: CreateDashboardResponse)

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the dashboard, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:dashboard\/${DashboardId}@
createDashboardResponse_dashboardArn :: Lens.Lens' CreateDashboardResponse Prelude.Text
createDashboardResponse_dashboardArn :: Lens' CreateDashboardResponse Text
createDashboardResponse_dashboardArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDashboardResponse' {Text
dashboardArn :: Text
$sel:dashboardArn:CreateDashboardResponse' :: CreateDashboardResponse -> Text
dashboardArn} -> Text
dashboardArn) (\s :: CreateDashboardResponse
s@CreateDashboardResponse' {} Text
a -> CreateDashboardResponse
s {$sel:dashboardArn:CreateDashboardResponse' :: Text
dashboardArn = Text
a} :: CreateDashboardResponse)

instance Prelude.NFData CreateDashboardResponse where
  rnf :: CreateDashboardResponse -> ()
rnf CreateDashboardResponse' {Int
Text
dashboardArn :: Text
dashboardId :: Text
httpStatus :: Int
$sel:dashboardArn:CreateDashboardResponse' :: CreateDashboardResponse -> Text
$sel:dashboardId:CreateDashboardResponse' :: CreateDashboardResponse -> Text
$sel:httpStatus:CreateDashboardResponse' :: CreateDashboardResponse -> 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
dashboardId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dashboardArn