{-# 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.DescribeDashboard
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about a dashboard.
module Amazonka.IoTSiteWise.DescribeDashboard
  ( -- * Creating a Request
    DescribeDashboard (..),
    newDescribeDashboard,

    -- * Request Lenses
    describeDashboard_dashboardId,

    -- * Destructuring the Response
    DescribeDashboardResponse (..),
    newDescribeDashboardResponse,

    -- * Response Lenses
    describeDashboardResponse_dashboardDescription,
    describeDashboardResponse_httpStatus,
    describeDashboardResponse_dashboardId,
    describeDashboardResponse_dashboardArn,
    describeDashboardResponse_dashboardName,
    describeDashboardResponse_projectId,
    describeDashboardResponse_dashboardDefinition,
    describeDashboardResponse_dashboardCreationDate,
    describeDashboardResponse_dashboardLastUpdateDate,
  )
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:/ 'newDescribeDashboard' smart constructor.
data DescribeDashboard = DescribeDashboard'
  { -- | The ID of the dashboard.
    DescribeDashboard -> Text
dashboardId :: Prelude.Text
  }
  deriving (DescribeDashboard -> DescribeDashboard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDashboard -> DescribeDashboard -> Bool
$c/= :: DescribeDashboard -> DescribeDashboard -> Bool
== :: DescribeDashboard -> DescribeDashboard -> Bool
$c== :: DescribeDashboard -> DescribeDashboard -> Bool
Prelude.Eq, ReadPrec [DescribeDashboard]
ReadPrec DescribeDashboard
Int -> ReadS DescribeDashboard
ReadS [DescribeDashboard]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDashboard]
$creadListPrec :: ReadPrec [DescribeDashboard]
readPrec :: ReadPrec DescribeDashboard
$creadPrec :: ReadPrec DescribeDashboard
readList :: ReadS [DescribeDashboard]
$creadList :: ReadS [DescribeDashboard]
readsPrec :: Int -> ReadS DescribeDashboard
$creadsPrec :: Int -> ReadS DescribeDashboard
Prelude.Read, Int -> DescribeDashboard -> ShowS
[DescribeDashboard] -> ShowS
DescribeDashboard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDashboard] -> ShowS
$cshowList :: [DescribeDashboard] -> ShowS
show :: DescribeDashboard -> String
$cshow :: DescribeDashboard -> String
showsPrec :: Int -> DescribeDashboard -> ShowS
$cshowsPrec :: Int -> DescribeDashboard -> ShowS
Prelude.Show, forall x. Rep DescribeDashboard x -> DescribeDashboard
forall x. DescribeDashboard -> Rep DescribeDashboard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeDashboard x -> DescribeDashboard
$cfrom :: forall x. DescribeDashboard -> Rep DescribeDashboard x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDashboard' 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:
--
-- 'dashboardId', 'describeDashboard_dashboardId' - The ID of the dashboard.
newDescribeDashboard ::
  -- | 'dashboardId'
  Prelude.Text ->
  DescribeDashboard
newDescribeDashboard :: Text -> DescribeDashboard
newDescribeDashboard Text
pDashboardId_ =
  DescribeDashboard' {$sel:dashboardId:DescribeDashboard' :: Text
dashboardId = Text
pDashboardId_}

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

instance Core.AWSRequest DescribeDashboard where
  type
    AWSResponse DescribeDashboard =
      DescribeDashboardResponse
  request :: (Service -> Service)
-> DescribeDashboard -> Request DescribeDashboard
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeDashboard
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeDashboard)))
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 Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> POSIX
-> POSIX
-> DescribeDashboardResponse
DescribeDashboardResponse'
            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
"dashboardDescription")
            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))
            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")
            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
"dashboardName")
            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
"projectId")
            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
"dashboardDefinition")
            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
"dashboardCreationDate")
            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
"dashboardLastUpdateDate")
      )

instance Prelude.Hashable DescribeDashboard where
  hashWithSalt :: Int -> DescribeDashboard -> Int
hashWithSalt Int
_salt DescribeDashboard' {Text
dashboardId :: Text
$sel:dashboardId:DescribeDashboard' :: DescribeDashboard -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dashboardId

instance Prelude.NFData DescribeDashboard where
  rnf :: DescribeDashboard -> ()
rnf DescribeDashboard' {Text
dashboardId :: Text
$sel:dashboardId:DescribeDashboard' :: DescribeDashboard -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
dashboardId

instance Data.ToHeaders DescribeDashboard where
  toHeaders :: DescribeDashboard -> 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.ToPath DescribeDashboard where
  toPath :: DescribeDashboard -> ByteString
toPath DescribeDashboard' {Text
dashboardId :: Text
$sel:dashboardId:DescribeDashboard' :: DescribeDashboard -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/dashboards/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
dashboardId]

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

-- | /See:/ 'newDescribeDashboardResponse' smart constructor.
data DescribeDashboardResponse = DescribeDashboardResponse'
  { -- | The dashboard\'s description.
    DescribeDashboardResponse -> Maybe Text
dashboardDescription :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeDashboardResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the dashboard.
    DescribeDashboardResponse -> 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}@
    DescribeDashboardResponse -> Text
dashboardArn :: Prelude.Text,
    -- | The name of the dashboard.
    DescribeDashboardResponse -> Text
dashboardName :: Prelude.Text,
    -- | The ID of the project that the dashboard is in.
    DescribeDashboardResponse -> Text
projectId :: Prelude.Text,
    -- | The dashboard\'s definition 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/.
    DescribeDashboardResponse -> Text
dashboardDefinition :: Prelude.Text,
    -- | The date the dashboard was created, in Unix epoch time.
    DescribeDashboardResponse -> POSIX
dashboardCreationDate :: Data.POSIX,
    -- | The date the dashboard was last updated, in Unix epoch time.
    DescribeDashboardResponse -> POSIX
dashboardLastUpdateDate :: Data.POSIX
  }
  deriving (DescribeDashboardResponse -> DescribeDashboardResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDashboardResponse -> DescribeDashboardResponse -> Bool
$c/= :: DescribeDashboardResponse -> DescribeDashboardResponse -> Bool
== :: DescribeDashboardResponse -> DescribeDashboardResponse -> Bool
$c== :: DescribeDashboardResponse -> DescribeDashboardResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDashboardResponse]
ReadPrec DescribeDashboardResponse
Int -> ReadS DescribeDashboardResponse
ReadS [DescribeDashboardResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDashboardResponse]
$creadListPrec :: ReadPrec [DescribeDashboardResponse]
readPrec :: ReadPrec DescribeDashboardResponse
$creadPrec :: ReadPrec DescribeDashboardResponse
readList :: ReadS [DescribeDashboardResponse]
$creadList :: ReadS [DescribeDashboardResponse]
readsPrec :: Int -> ReadS DescribeDashboardResponse
$creadsPrec :: Int -> ReadS DescribeDashboardResponse
Prelude.Read, Int -> DescribeDashboardResponse -> ShowS
[DescribeDashboardResponse] -> ShowS
DescribeDashboardResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDashboardResponse] -> ShowS
$cshowList :: [DescribeDashboardResponse] -> ShowS
show :: DescribeDashboardResponse -> String
$cshow :: DescribeDashboardResponse -> String
showsPrec :: Int -> DescribeDashboardResponse -> ShowS
$cshowsPrec :: Int -> DescribeDashboardResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDashboardResponse x -> DescribeDashboardResponse
forall x.
DescribeDashboardResponse -> Rep DescribeDashboardResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDashboardResponse x -> DescribeDashboardResponse
$cfrom :: forall x.
DescribeDashboardResponse -> Rep DescribeDashboardResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDashboardResponse' 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:
--
-- 'dashboardDescription', 'describeDashboardResponse_dashboardDescription' - The dashboard\'s description.
--
-- 'httpStatus', 'describeDashboardResponse_httpStatus' - The response's http status code.
--
-- 'dashboardId', 'describeDashboardResponse_dashboardId' - The ID of the dashboard.
--
-- 'dashboardArn', 'describeDashboardResponse_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}@
--
-- 'dashboardName', 'describeDashboardResponse_dashboardName' - The name of the dashboard.
--
-- 'projectId', 'describeDashboardResponse_projectId' - The ID of the project that the dashboard is in.
--
-- 'dashboardDefinition', 'describeDashboardResponse_dashboardDefinition' - The dashboard\'s definition 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/.
--
-- 'dashboardCreationDate', 'describeDashboardResponse_dashboardCreationDate' - The date the dashboard was created, in Unix epoch time.
--
-- 'dashboardLastUpdateDate', 'describeDashboardResponse_dashboardLastUpdateDate' - The date the dashboard was last updated, in Unix epoch time.
newDescribeDashboardResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'dashboardId'
  Prelude.Text ->
  -- | 'dashboardArn'
  Prelude.Text ->
  -- | 'dashboardName'
  Prelude.Text ->
  -- | 'projectId'
  Prelude.Text ->
  -- | 'dashboardDefinition'
  Prelude.Text ->
  -- | 'dashboardCreationDate'
  Prelude.UTCTime ->
  -- | 'dashboardLastUpdateDate'
  Prelude.UTCTime ->
  DescribeDashboardResponse
newDescribeDashboardResponse :: Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> UTCTime
-> UTCTime
-> DescribeDashboardResponse
newDescribeDashboardResponse
  Int
pHttpStatus_
  Text
pDashboardId_
  Text
pDashboardArn_
  Text
pDashboardName_
  Text
pProjectId_
  Text
pDashboardDefinition_
  UTCTime
pDashboardCreationDate_
  UTCTime
pDashboardLastUpdateDate_ =
    DescribeDashboardResponse'
      { $sel:dashboardDescription:DescribeDashboardResponse' :: Maybe Text
dashboardDescription =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeDashboardResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:dashboardId:DescribeDashboardResponse' :: Text
dashboardId = Text
pDashboardId_,
        $sel:dashboardArn:DescribeDashboardResponse' :: Text
dashboardArn = Text
pDashboardArn_,
        $sel:dashboardName:DescribeDashboardResponse' :: Text
dashboardName = Text
pDashboardName_,
        $sel:projectId:DescribeDashboardResponse' :: Text
projectId = Text
pProjectId_,
        $sel:dashboardDefinition:DescribeDashboardResponse' :: Text
dashboardDefinition = Text
pDashboardDefinition_,
        $sel:dashboardCreationDate:DescribeDashboardResponse' :: POSIX
dashboardCreationDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pDashboardCreationDate_,
        $sel:dashboardLastUpdateDate:DescribeDashboardResponse' :: POSIX
dashboardLastUpdateDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pDashboardLastUpdateDate_
      }

-- | The dashboard\'s description.
describeDashboardResponse_dashboardDescription :: Lens.Lens' DescribeDashboardResponse (Prelude.Maybe Prelude.Text)
describeDashboardResponse_dashboardDescription :: Lens' DescribeDashboardResponse (Maybe Text)
describeDashboardResponse_dashboardDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDashboardResponse' {Maybe Text
dashboardDescription :: Maybe Text
$sel:dashboardDescription:DescribeDashboardResponse' :: DescribeDashboardResponse -> Maybe Text
dashboardDescription} -> Maybe Text
dashboardDescription) (\s :: DescribeDashboardResponse
s@DescribeDashboardResponse' {} Maybe Text
a -> DescribeDashboardResponse
s {$sel:dashboardDescription:DescribeDashboardResponse' :: Maybe Text
dashboardDescription = Maybe Text
a} :: DescribeDashboardResponse)

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

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

-- | 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}@
describeDashboardResponse_dashboardArn :: Lens.Lens' DescribeDashboardResponse Prelude.Text
describeDashboardResponse_dashboardArn :: Lens' DescribeDashboardResponse Text
describeDashboardResponse_dashboardArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDashboardResponse' {Text
dashboardArn :: Text
$sel:dashboardArn:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
dashboardArn} -> Text
dashboardArn) (\s :: DescribeDashboardResponse
s@DescribeDashboardResponse' {} Text
a -> DescribeDashboardResponse
s {$sel:dashboardArn:DescribeDashboardResponse' :: Text
dashboardArn = Text
a} :: DescribeDashboardResponse)

-- | The name of the dashboard.
describeDashboardResponse_dashboardName :: Lens.Lens' DescribeDashboardResponse Prelude.Text
describeDashboardResponse_dashboardName :: Lens' DescribeDashboardResponse Text
describeDashboardResponse_dashboardName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDashboardResponse' {Text
dashboardName :: Text
$sel:dashboardName:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
dashboardName} -> Text
dashboardName) (\s :: DescribeDashboardResponse
s@DescribeDashboardResponse' {} Text
a -> DescribeDashboardResponse
s {$sel:dashboardName:DescribeDashboardResponse' :: Text
dashboardName = Text
a} :: DescribeDashboardResponse)

-- | The ID of the project that the dashboard is in.
describeDashboardResponse_projectId :: Lens.Lens' DescribeDashboardResponse Prelude.Text
describeDashboardResponse_projectId :: Lens' DescribeDashboardResponse Text
describeDashboardResponse_projectId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDashboardResponse' {Text
projectId :: Text
$sel:projectId:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
projectId} -> Text
projectId) (\s :: DescribeDashboardResponse
s@DescribeDashboardResponse' {} Text
a -> DescribeDashboardResponse
s {$sel:projectId:DescribeDashboardResponse' :: Text
projectId = Text
a} :: DescribeDashboardResponse)

-- | The dashboard\'s definition 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/.
describeDashboardResponse_dashboardDefinition :: Lens.Lens' DescribeDashboardResponse Prelude.Text
describeDashboardResponse_dashboardDefinition :: Lens' DescribeDashboardResponse Text
describeDashboardResponse_dashboardDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDashboardResponse' {Text
dashboardDefinition :: Text
$sel:dashboardDefinition:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
dashboardDefinition} -> Text
dashboardDefinition) (\s :: DescribeDashboardResponse
s@DescribeDashboardResponse' {} Text
a -> DescribeDashboardResponse
s {$sel:dashboardDefinition:DescribeDashboardResponse' :: Text
dashboardDefinition = Text
a} :: DescribeDashboardResponse)

-- | The date the dashboard was created, in Unix epoch time.
describeDashboardResponse_dashboardCreationDate :: Lens.Lens' DescribeDashboardResponse Prelude.UTCTime
describeDashboardResponse_dashboardCreationDate :: Lens' DescribeDashboardResponse UTCTime
describeDashboardResponse_dashboardCreationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDashboardResponse' {POSIX
dashboardCreationDate :: POSIX
$sel:dashboardCreationDate:DescribeDashboardResponse' :: DescribeDashboardResponse -> POSIX
dashboardCreationDate} -> POSIX
dashboardCreationDate) (\s :: DescribeDashboardResponse
s@DescribeDashboardResponse' {} POSIX
a -> DescribeDashboardResponse
s {$sel:dashboardCreationDate:DescribeDashboardResponse' :: POSIX
dashboardCreationDate = POSIX
a} :: DescribeDashboardResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date the dashboard was last updated, in Unix epoch time.
describeDashboardResponse_dashboardLastUpdateDate :: Lens.Lens' DescribeDashboardResponse Prelude.UTCTime
describeDashboardResponse_dashboardLastUpdateDate :: Lens' DescribeDashboardResponse UTCTime
describeDashboardResponse_dashboardLastUpdateDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDashboardResponse' {POSIX
dashboardLastUpdateDate :: POSIX
$sel:dashboardLastUpdateDate:DescribeDashboardResponse' :: DescribeDashboardResponse -> POSIX
dashboardLastUpdateDate} -> POSIX
dashboardLastUpdateDate) (\s :: DescribeDashboardResponse
s@DescribeDashboardResponse' {} POSIX
a -> DescribeDashboardResponse
s {$sel:dashboardLastUpdateDate:DescribeDashboardResponse' :: POSIX
dashboardLastUpdateDate = POSIX
a} :: DescribeDashboardResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData DescribeDashboardResponse where
  rnf :: DescribeDashboardResponse -> ()
rnf DescribeDashboardResponse' {Int
Maybe Text
Text
POSIX
dashboardLastUpdateDate :: POSIX
dashboardCreationDate :: POSIX
dashboardDefinition :: Text
projectId :: Text
dashboardName :: Text
dashboardArn :: Text
dashboardId :: Text
httpStatus :: Int
dashboardDescription :: Maybe Text
$sel:dashboardLastUpdateDate:DescribeDashboardResponse' :: DescribeDashboardResponse -> POSIX
$sel:dashboardCreationDate:DescribeDashboardResponse' :: DescribeDashboardResponse -> POSIX
$sel:dashboardDefinition:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
$sel:projectId:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
$sel:dashboardName:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
$sel:dashboardArn:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
$sel:dashboardId:DescribeDashboardResponse' :: DescribeDashboardResponse -> Text
$sel:httpStatus:DescribeDashboardResponse' :: DescribeDashboardResponse -> Int
$sel:dashboardDescription:DescribeDashboardResponse' :: DescribeDashboardResponse -> Maybe Text
..} =
    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 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
      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
projectId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dashboardDefinition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
dashboardCreationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
dashboardLastUpdateDate