{-# 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.CloudWatch.GetDashboard
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Displays the details of the dashboard that you specify.
--
-- To copy an existing dashboard, use @GetDashboard@, and then use the data
-- returned within @DashboardBody@ as the template for the new dashboard
-- when you call @PutDashboard@ to create the copy.
module Amazonka.CloudWatch.GetDashboard
  ( -- * Creating a Request
    GetDashboard (..),
    newGetDashboard,

    -- * Request Lenses
    getDashboard_dashboardName,

    -- * Destructuring the Response
    GetDashboardResponse (..),
    newGetDashboardResponse,

    -- * Response Lenses
    getDashboardResponse_dashboardArn,
    getDashboardResponse_dashboardBody,
    getDashboardResponse_dashboardName,
    getDashboardResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetDashboard' smart constructor.
data GetDashboard = GetDashboard'
  { -- | The name of the dashboard to be described.
    GetDashboard -> Text
dashboardName :: Prelude.Text
  }
  deriving (GetDashboard -> GetDashboard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDashboard -> GetDashboard -> Bool
$c/= :: GetDashboard -> GetDashboard -> Bool
== :: GetDashboard -> GetDashboard -> Bool
$c== :: GetDashboard -> GetDashboard -> Bool
Prelude.Eq, ReadPrec [GetDashboard]
ReadPrec GetDashboard
Int -> ReadS GetDashboard
ReadS [GetDashboard]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDashboard]
$creadListPrec :: ReadPrec [GetDashboard]
readPrec :: ReadPrec GetDashboard
$creadPrec :: ReadPrec GetDashboard
readList :: ReadS [GetDashboard]
$creadList :: ReadS [GetDashboard]
readsPrec :: Int -> ReadS GetDashboard
$creadsPrec :: Int -> ReadS GetDashboard
Prelude.Read, Int -> GetDashboard -> ShowS
[GetDashboard] -> ShowS
GetDashboard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDashboard] -> ShowS
$cshowList :: [GetDashboard] -> ShowS
show :: GetDashboard -> String
$cshow :: GetDashboard -> String
showsPrec :: Int -> GetDashboard -> ShowS
$cshowsPrec :: Int -> GetDashboard -> ShowS
Prelude.Show, forall x. Rep GetDashboard x -> GetDashboard
forall x. GetDashboard -> Rep GetDashboard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDashboard x -> GetDashboard
$cfrom :: forall x. GetDashboard -> Rep GetDashboard x
Prelude.Generic)

-- |
-- Create a value of 'GetDashboard' 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:
--
-- 'dashboardName', 'getDashboard_dashboardName' - The name of the dashboard to be described.
newGetDashboard ::
  -- | 'dashboardName'
  Prelude.Text ->
  GetDashboard
newGetDashboard :: Text -> GetDashboard
newGetDashboard Text
pDashboardName_ =
  GetDashboard' {$sel:dashboardName:GetDashboard' :: Text
dashboardName = Text
pDashboardName_}

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

instance Core.AWSRequest GetDashboard where
  type AWSResponse GetDashboard = GetDashboardResponse
  request :: (Service -> Service) -> GetDashboard -> Request GetDashboard
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetDashboard
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDashboard)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetDashboardResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe Text -> Maybe Text -> Int -> GetDashboardResponse
GetDashboardResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DashboardArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DashboardBody")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DashboardName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

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

instance Data.ToHeaders GetDashboard where
  toHeaders :: GetDashboard -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetDashboard where
  toQuery :: GetDashboard -> QueryString
toQuery GetDashboard' {Text
dashboardName :: Text
$sel:dashboardName:GetDashboard' :: GetDashboard -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetDashboard" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-08-01" :: Prelude.ByteString),
        ByteString
"DashboardName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dashboardName
      ]

-- | /See:/ 'newGetDashboardResponse' smart constructor.
data GetDashboardResponse = GetDashboardResponse'
  { -- | The Amazon Resource Name (ARN) of the dashboard.
    GetDashboardResponse -> Maybe Text
dashboardArn :: Prelude.Maybe Prelude.Text,
    -- | The detailed information about the dashboard, including what widgets are
    -- included and their location on the dashboard. For more information about
    -- the @DashboardBody@ syntax, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/CloudWatch-Dashboard-Body-Structure.html Dashboard Body Structure and Syntax>.
    GetDashboardResponse -> Maybe Text
dashboardBody :: Prelude.Maybe Prelude.Text,
    -- | The name of the dashboard.
    GetDashboardResponse -> Maybe Text
dashboardName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDashboardResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDashboardResponse -> GetDashboardResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDashboardResponse -> GetDashboardResponse -> Bool
$c/= :: GetDashboardResponse -> GetDashboardResponse -> Bool
== :: GetDashboardResponse -> GetDashboardResponse -> Bool
$c== :: GetDashboardResponse -> GetDashboardResponse -> Bool
Prelude.Eq, ReadPrec [GetDashboardResponse]
ReadPrec GetDashboardResponse
Int -> ReadS GetDashboardResponse
ReadS [GetDashboardResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDashboardResponse]
$creadListPrec :: ReadPrec [GetDashboardResponse]
readPrec :: ReadPrec GetDashboardResponse
$creadPrec :: ReadPrec GetDashboardResponse
readList :: ReadS [GetDashboardResponse]
$creadList :: ReadS [GetDashboardResponse]
readsPrec :: Int -> ReadS GetDashboardResponse
$creadsPrec :: Int -> ReadS GetDashboardResponse
Prelude.Read, Int -> GetDashboardResponse -> ShowS
[GetDashboardResponse] -> ShowS
GetDashboardResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDashboardResponse] -> ShowS
$cshowList :: [GetDashboardResponse] -> ShowS
show :: GetDashboardResponse -> String
$cshow :: GetDashboardResponse -> String
showsPrec :: Int -> GetDashboardResponse -> ShowS
$cshowsPrec :: Int -> GetDashboardResponse -> ShowS
Prelude.Show, forall x. Rep GetDashboardResponse x -> GetDashboardResponse
forall x. GetDashboardResponse -> Rep GetDashboardResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDashboardResponse x -> GetDashboardResponse
$cfrom :: forall x. GetDashboardResponse -> Rep GetDashboardResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDashboardResponse' 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:
--
-- 'dashboardArn', 'getDashboardResponse_dashboardArn' - The Amazon Resource Name (ARN) of the dashboard.
--
-- 'dashboardBody', 'getDashboardResponse_dashboardBody' - The detailed information about the dashboard, including what widgets are
-- included and their location on the dashboard. For more information about
-- the @DashboardBody@ syntax, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/CloudWatch-Dashboard-Body-Structure.html Dashboard Body Structure and Syntax>.
--
-- 'dashboardName', 'getDashboardResponse_dashboardName' - The name of the dashboard.
--
-- 'httpStatus', 'getDashboardResponse_httpStatus' - The response's http status code.
newGetDashboardResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDashboardResponse
newGetDashboardResponse :: Int -> GetDashboardResponse
newGetDashboardResponse Int
pHttpStatus_ =
  GetDashboardResponse'
    { $sel:dashboardArn:GetDashboardResponse' :: Maybe Text
dashboardArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dashboardBody:GetDashboardResponse' :: Maybe Text
dashboardBody = forall a. Maybe a
Prelude.Nothing,
      $sel:dashboardName:GetDashboardResponse' :: Maybe Text
dashboardName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDashboardResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the dashboard.
getDashboardResponse_dashboardArn :: Lens.Lens' GetDashboardResponse (Prelude.Maybe Prelude.Text)
getDashboardResponse_dashboardArn :: Lens' GetDashboardResponse (Maybe Text)
getDashboardResponse_dashboardArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardResponse' {Maybe Text
dashboardArn :: Maybe Text
$sel:dashboardArn:GetDashboardResponse' :: GetDashboardResponse -> Maybe Text
dashboardArn} -> Maybe Text
dashboardArn) (\s :: GetDashboardResponse
s@GetDashboardResponse' {} Maybe Text
a -> GetDashboardResponse
s {$sel:dashboardArn:GetDashboardResponse' :: Maybe Text
dashboardArn = Maybe Text
a} :: GetDashboardResponse)

-- | The detailed information about the dashboard, including what widgets are
-- included and their location on the dashboard. For more information about
-- the @DashboardBody@ syntax, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/APIReference/CloudWatch-Dashboard-Body-Structure.html Dashboard Body Structure and Syntax>.
getDashboardResponse_dashboardBody :: Lens.Lens' GetDashboardResponse (Prelude.Maybe Prelude.Text)
getDashboardResponse_dashboardBody :: Lens' GetDashboardResponse (Maybe Text)
getDashboardResponse_dashboardBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardResponse' {Maybe Text
dashboardBody :: Maybe Text
$sel:dashboardBody:GetDashboardResponse' :: GetDashboardResponse -> Maybe Text
dashboardBody} -> Maybe Text
dashboardBody) (\s :: GetDashboardResponse
s@GetDashboardResponse' {} Maybe Text
a -> GetDashboardResponse
s {$sel:dashboardBody:GetDashboardResponse' :: Maybe Text
dashboardBody = Maybe Text
a} :: GetDashboardResponse)

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

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

instance Prelude.NFData GetDashboardResponse where
  rnf :: GetDashboardResponse -> ()
rnf GetDashboardResponse' {Int
Maybe Text
httpStatus :: Int
dashboardName :: Maybe Text
dashboardBody :: Maybe Text
dashboardArn :: Maybe Text
$sel:httpStatus:GetDashboardResponse' :: GetDashboardResponse -> Int
$sel:dashboardName:GetDashboardResponse' :: GetDashboardResponse -> Maybe Text
$sel:dashboardBody:GetDashboardResponse' :: GetDashboardResponse -> Maybe Text
$sel:dashboardArn:GetDashboardResponse' :: GetDashboardResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dashboardArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dashboardBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dashboardName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus