{-# 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.QuickSight.GetDashboardEmbedUrl
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates a temporary session URL and authorization code(bearer token)
-- that you can use to embed an Amazon QuickSight read-only dashboard in
-- your website or application. Before you use this command, make sure that
-- you have configured the dashboards and permissions.
--
-- Currently, you can use @GetDashboardEmbedURL@ only from the server, not
-- from the user\'s browser. The following rules apply to the generated
-- URL:
--
-- -   They must be used together.
--
-- -   They can be used one time only.
--
-- -   They are valid for 5 minutes after you run this command.
--
-- -   You are charged only when the URL is used or there is interaction
--     with Amazon QuickSight.
--
-- -   The resulting user session is valid for 15 minutes (default) up to
--     10 hours (maximum). You can use the optional
--     @SessionLifetimeInMinutes@ parameter to customize session duration.
--
-- For more information, see
-- <https://docs.aws.amazon.com/quicksight/latest/user/embedded-analytics-deprecated.html Embedding Analytics Using GetDashboardEmbedUrl>
-- in the /Amazon QuickSight User Guide/.
--
-- For more information about the high-level steps for embedding and for an
-- interactive demo of the ways you can customize embedding, visit the
-- <https://docs.aws.amazon.com/quicksight/latest/user/quicksight-dev-portal.html Amazon QuickSight Developer Portal>.
module Amazonka.QuickSight.GetDashboardEmbedUrl
  ( -- * Creating a Request
    GetDashboardEmbedUrl (..),
    newGetDashboardEmbedUrl,

    -- * Request Lenses
    getDashboardEmbedUrl_additionalDashboardIds,
    getDashboardEmbedUrl_namespace,
    getDashboardEmbedUrl_resetDisabled,
    getDashboardEmbedUrl_sessionLifetimeInMinutes,
    getDashboardEmbedUrl_statePersistenceEnabled,
    getDashboardEmbedUrl_undoRedoDisabled,
    getDashboardEmbedUrl_userArn,
    getDashboardEmbedUrl_awsAccountId,
    getDashboardEmbedUrl_dashboardId,
    getDashboardEmbedUrl_identityType,

    -- * Destructuring the Response
    GetDashboardEmbedUrlResponse (..),
    newGetDashboardEmbedUrlResponse,

    -- * Response Lenses
    getDashboardEmbedUrlResponse_embedUrl,
    getDashboardEmbedUrlResponse_requestId,
    getDashboardEmbedUrlResponse_status,
  )
where

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 Amazonka.QuickSight.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetDashboardEmbedUrl' smart constructor.
data GetDashboardEmbedUrl = GetDashboardEmbedUrl'
  { -- | A list of one or more dashboard IDs that you want anonymous users to
    -- have tempporary access to. Currently, the @IdentityType@ parameter must
    -- be set to @ANONYMOUS@ because other identity types authenticate as
    -- Amazon QuickSight or IAM users. For example, if you set
    -- \"@--dashboard-id dash_id1 --dashboard-id dash_id2 dash_id3 identity-type ANONYMOUS@\",
    -- the session can access all three dashboards.
    GetDashboardEmbedUrl -> Maybe (NonEmpty Text)
additionalDashboardIds :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The Amazon QuickSight namespace that contains the dashboard IDs in this
    -- request. If you\'re not using a custom namespace, set
    -- @Namespace = default@.
    GetDashboardEmbedUrl -> Maybe Text
namespace :: Prelude.Maybe Prelude.Text,
    -- | Remove the reset button on the embedded dashboard. The default is FALSE,
    -- which enables the reset button.
    GetDashboardEmbedUrl -> Maybe Bool
resetDisabled :: Prelude.Maybe Prelude.Bool,
    -- | How many minutes the session is valid. The session lifetime must be
    -- 15-600 minutes.
    GetDashboardEmbedUrl -> Maybe Natural
sessionLifetimeInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | Adds persistence of state for the user session in an embedded dashboard.
    -- Persistence applies to the sheet and the parameter settings. These are
    -- control settings that the dashboard subscriber (Amazon QuickSight
    -- reader) chooses while viewing the dashboard. If this is set to @TRUE@,
    -- the settings are the same when the subscriber reopens the same dashboard
    -- URL. The state is stored in Amazon QuickSight, not in a browser cookie.
    -- If this is set to FALSE, the state of the user session is not persisted.
    -- The default is @FALSE@.
    GetDashboardEmbedUrl -> Maybe Bool
statePersistenceEnabled :: Prelude.Maybe Prelude.Bool,
    -- | Remove the undo\/redo button on the embedded dashboard. The default is
    -- FALSE, which enables the undo\/redo button.
    GetDashboardEmbedUrl -> Maybe Bool
undoRedoDisabled :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon QuickSight user\'s Amazon Resource Name (ARN), for use with
    -- @QUICKSIGHT@ identity type. You can use this for any Amazon QuickSight
    -- users in your account (readers, authors, or admins) authenticated as one
    -- of the following:
    --
    -- -   Active Directory (AD) users or group members
    --
    -- -   Invited nonfederated users
    --
    -- -   IAM users and IAM role-based sessions authenticated through
    --     Federated Single Sign-On using SAML, OpenID Connect, or IAM
    --     federation.
    --
    -- Omit this parameter for users in the third group – IAM users and IAM
    -- role-based sessions.
    GetDashboardEmbedUrl -> Maybe Text
userArn :: Prelude.Maybe Prelude.Text,
    -- | The ID for the Amazon Web Services account that contains the dashboard
    -- that you\'re embedding.
    GetDashboardEmbedUrl -> Text
awsAccountId :: Prelude.Text,
    -- | The ID for the dashboard, also added to the Identity and Access
    -- Management (IAM) policy.
    GetDashboardEmbedUrl -> Text
dashboardId :: Prelude.Text,
    -- | The authentication method that the user uses to sign in.
    GetDashboardEmbedUrl -> EmbeddingIdentityType
identityType :: EmbeddingIdentityType
  }
  deriving (GetDashboardEmbedUrl -> GetDashboardEmbedUrl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDashboardEmbedUrl -> GetDashboardEmbedUrl -> Bool
$c/= :: GetDashboardEmbedUrl -> GetDashboardEmbedUrl -> Bool
== :: GetDashboardEmbedUrl -> GetDashboardEmbedUrl -> Bool
$c== :: GetDashboardEmbedUrl -> GetDashboardEmbedUrl -> Bool
Prelude.Eq, ReadPrec [GetDashboardEmbedUrl]
ReadPrec GetDashboardEmbedUrl
Int -> ReadS GetDashboardEmbedUrl
ReadS [GetDashboardEmbedUrl]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDashboardEmbedUrl]
$creadListPrec :: ReadPrec [GetDashboardEmbedUrl]
readPrec :: ReadPrec GetDashboardEmbedUrl
$creadPrec :: ReadPrec GetDashboardEmbedUrl
readList :: ReadS [GetDashboardEmbedUrl]
$creadList :: ReadS [GetDashboardEmbedUrl]
readsPrec :: Int -> ReadS GetDashboardEmbedUrl
$creadsPrec :: Int -> ReadS GetDashboardEmbedUrl
Prelude.Read, Int -> GetDashboardEmbedUrl -> ShowS
[GetDashboardEmbedUrl] -> ShowS
GetDashboardEmbedUrl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDashboardEmbedUrl] -> ShowS
$cshowList :: [GetDashboardEmbedUrl] -> ShowS
show :: GetDashboardEmbedUrl -> String
$cshow :: GetDashboardEmbedUrl -> String
showsPrec :: Int -> GetDashboardEmbedUrl -> ShowS
$cshowsPrec :: Int -> GetDashboardEmbedUrl -> ShowS
Prelude.Show, forall x. Rep GetDashboardEmbedUrl x -> GetDashboardEmbedUrl
forall x. GetDashboardEmbedUrl -> Rep GetDashboardEmbedUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDashboardEmbedUrl x -> GetDashboardEmbedUrl
$cfrom :: forall x. GetDashboardEmbedUrl -> Rep GetDashboardEmbedUrl x
Prelude.Generic)

-- |
-- Create a value of 'GetDashboardEmbedUrl' 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:
--
-- 'additionalDashboardIds', 'getDashboardEmbedUrl_additionalDashboardIds' - A list of one or more dashboard IDs that you want anonymous users to
-- have tempporary access to. Currently, the @IdentityType@ parameter must
-- be set to @ANONYMOUS@ because other identity types authenticate as
-- Amazon QuickSight or IAM users. For example, if you set
-- \"@--dashboard-id dash_id1 --dashboard-id dash_id2 dash_id3 identity-type ANONYMOUS@\",
-- the session can access all three dashboards.
--
-- 'namespace', 'getDashboardEmbedUrl_namespace' - The Amazon QuickSight namespace that contains the dashboard IDs in this
-- request. If you\'re not using a custom namespace, set
-- @Namespace = default@.
--
-- 'resetDisabled', 'getDashboardEmbedUrl_resetDisabled' - Remove the reset button on the embedded dashboard. The default is FALSE,
-- which enables the reset button.
--
-- 'sessionLifetimeInMinutes', 'getDashboardEmbedUrl_sessionLifetimeInMinutes' - How many minutes the session is valid. The session lifetime must be
-- 15-600 minutes.
--
-- 'statePersistenceEnabled', 'getDashboardEmbedUrl_statePersistenceEnabled' - Adds persistence of state for the user session in an embedded dashboard.
-- Persistence applies to the sheet and the parameter settings. These are
-- control settings that the dashboard subscriber (Amazon QuickSight
-- reader) chooses while viewing the dashboard. If this is set to @TRUE@,
-- the settings are the same when the subscriber reopens the same dashboard
-- URL. The state is stored in Amazon QuickSight, not in a browser cookie.
-- If this is set to FALSE, the state of the user session is not persisted.
-- The default is @FALSE@.
--
-- 'undoRedoDisabled', 'getDashboardEmbedUrl_undoRedoDisabled' - Remove the undo\/redo button on the embedded dashboard. The default is
-- FALSE, which enables the undo\/redo button.
--
-- 'userArn', 'getDashboardEmbedUrl_userArn' - The Amazon QuickSight user\'s Amazon Resource Name (ARN), for use with
-- @QUICKSIGHT@ identity type. You can use this for any Amazon QuickSight
-- users in your account (readers, authors, or admins) authenticated as one
-- of the following:
--
-- -   Active Directory (AD) users or group members
--
-- -   Invited nonfederated users
--
-- -   IAM users and IAM role-based sessions authenticated through
--     Federated Single Sign-On using SAML, OpenID Connect, or IAM
--     federation.
--
-- Omit this parameter for users in the third group – IAM users and IAM
-- role-based sessions.
--
-- 'awsAccountId', 'getDashboardEmbedUrl_awsAccountId' - The ID for the Amazon Web Services account that contains the dashboard
-- that you\'re embedding.
--
-- 'dashboardId', 'getDashboardEmbedUrl_dashboardId' - The ID for the dashboard, also added to the Identity and Access
-- Management (IAM) policy.
--
-- 'identityType', 'getDashboardEmbedUrl_identityType' - The authentication method that the user uses to sign in.
newGetDashboardEmbedUrl ::
  -- | 'awsAccountId'
  Prelude.Text ->
  -- | 'dashboardId'
  Prelude.Text ->
  -- | 'identityType'
  EmbeddingIdentityType ->
  GetDashboardEmbedUrl
newGetDashboardEmbedUrl :: Text -> Text -> EmbeddingIdentityType -> GetDashboardEmbedUrl
newGetDashboardEmbedUrl
  Text
pAwsAccountId_
  Text
pDashboardId_
  EmbeddingIdentityType
pIdentityType_ =
    GetDashboardEmbedUrl'
      { $sel:additionalDashboardIds:GetDashboardEmbedUrl' :: Maybe (NonEmpty Text)
additionalDashboardIds =
          forall a. Maybe a
Prelude.Nothing,
        $sel:namespace:GetDashboardEmbedUrl' :: Maybe Text
namespace = forall a. Maybe a
Prelude.Nothing,
        $sel:resetDisabled:GetDashboardEmbedUrl' :: Maybe Bool
resetDisabled = forall a. Maybe a
Prelude.Nothing,
        $sel:sessionLifetimeInMinutes:GetDashboardEmbedUrl' :: Maybe Natural
sessionLifetimeInMinutes = forall a. Maybe a
Prelude.Nothing,
        $sel:statePersistenceEnabled:GetDashboardEmbedUrl' :: Maybe Bool
statePersistenceEnabled = forall a. Maybe a
Prelude.Nothing,
        $sel:undoRedoDisabled:GetDashboardEmbedUrl' :: Maybe Bool
undoRedoDisabled = forall a. Maybe a
Prelude.Nothing,
        $sel:userArn:GetDashboardEmbedUrl' :: Maybe Text
userArn = forall a. Maybe a
Prelude.Nothing,
        $sel:awsAccountId:GetDashboardEmbedUrl' :: Text
awsAccountId = Text
pAwsAccountId_,
        $sel:dashboardId:GetDashboardEmbedUrl' :: Text
dashboardId = Text
pDashboardId_,
        $sel:identityType:GetDashboardEmbedUrl' :: EmbeddingIdentityType
identityType = EmbeddingIdentityType
pIdentityType_
      }

-- | A list of one or more dashboard IDs that you want anonymous users to
-- have tempporary access to. Currently, the @IdentityType@ parameter must
-- be set to @ANONYMOUS@ because other identity types authenticate as
-- Amazon QuickSight or IAM users. For example, if you set
-- \"@--dashboard-id dash_id1 --dashboard-id dash_id2 dash_id3 identity-type ANONYMOUS@\",
-- the session can access all three dashboards.
getDashboardEmbedUrl_additionalDashboardIds :: Lens.Lens' GetDashboardEmbedUrl (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getDashboardEmbedUrl_additionalDashboardIds :: Lens' GetDashboardEmbedUrl (Maybe (NonEmpty Text))
getDashboardEmbedUrl_additionalDashboardIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Maybe (NonEmpty Text)
additionalDashboardIds :: Maybe (NonEmpty Text)
$sel:additionalDashboardIds:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe (NonEmpty Text)
additionalDashboardIds} -> Maybe (NonEmpty Text)
additionalDashboardIds) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Maybe (NonEmpty Text)
a -> GetDashboardEmbedUrl
s {$sel:additionalDashboardIds:GetDashboardEmbedUrl' :: Maybe (NonEmpty Text)
additionalDashboardIds = Maybe (NonEmpty Text)
a} :: GetDashboardEmbedUrl) 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 Amazon QuickSight namespace that contains the dashboard IDs in this
-- request. If you\'re not using a custom namespace, set
-- @Namespace = default@.
getDashboardEmbedUrl_namespace :: Lens.Lens' GetDashboardEmbedUrl (Prelude.Maybe Prelude.Text)
getDashboardEmbedUrl_namespace :: Lens' GetDashboardEmbedUrl (Maybe Text)
getDashboardEmbedUrl_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Maybe Text
namespace :: Maybe Text
$sel:namespace:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
namespace} -> Maybe Text
namespace) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Maybe Text
a -> GetDashboardEmbedUrl
s {$sel:namespace:GetDashboardEmbedUrl' :: Maybe Text
namespace = Maybe Text
a} :: GetDashboardEmbedUrl)

-- | Remove the reset button on the embedded dashboard. The default is FALSE,
-- which enables the reset button.
getDashboardEmbedUrl_resetDisabled :: Lens.Lens' GetDashboardEmbedUrl (Prelude.Maybe Prelude.Bool)
getDashboardEmbedUrl_resetDisabled :: Lens' GetDashboardEmbedUrl (Maybe Bool)
getDashboardEmbedUrl_resetDisabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Maybe Bool
resetDisabled :: Maybe Bool
$sel:resetDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
resetDisabled} -> Maybe Bool
resetDisabled) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Maybe Bool
a -> GetDashboardEmbedUrl
s {$sel:resetDisabled:GetDashboardEmbedUrl' :: Maybe Bool
resetDisabled = Maybe Bool
a} :: GetDashboardEmbedUrl)

-- | How many minutes the session is valid. The session lifetime must be
-- 15-600 minutes.
getDashboardEmbedUrl_sessionLifetimeInMinutes :: Lens.Lens' GetDashboardEmbedUrl (Prelude.Maybe Prelude.Natural)
getDashboardEmbedUrl_sessionLifetimeInMinutes :: Lens' GetDashboardEmbedUrl (Maybe Natural)
getDashboardEmbedUrl_sessionLifetimeInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Maybe Natural
sessionLifetimeInMinutes :: Maybe Natural
$sel:sessionLifetimeInMinutes:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Natural
sessionLifetimeInMinutes} -> Maybe Natural
sessionLifetimeInMinutes) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Maybe Natural
a -> GetDashboardEmbedUrl
s {$sel:sessionLifetimeInMinutes:GetDashboardEmbedUrl' :: Maybe Natural
sessionLifetimeInMinutes = Maybe Natural
a} :: GetDashboardEmbedUrl)

-- | Adds persistence of state for the user session in an embedded dashboard.
-- Persistence applies to the sheet and the parameter settings. These are
-- control settings that the dashboard subscriber (Amazon QuickSight
-- reader) chooses while viewing the dashboard. If this is set to @TRUE@,
-- the settings are the same when the subscriber reopens the same dashboard
-- URL. The state is stored in Amazon QuickSight, not in a browser cookie.
-- If this is set to FALSE, the state of the user session is not persisted.
-- The default is @FALSE@.
getDashboardEmbedUrl_statePersistenceEnabled :: Lens.Lens' GetDashboardEmbedUrl (Prelude.Maybe Prelude.Bool)
getDashboardEmbedUrl_statePersistenceEnabled :: Lens' GetDashboardEmbedUrl (Maybe Bool)
getDashboardEmbedUrl_statePersistenceEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Maybe Bool
statePersistenceEnabled :: Maybe Bool
$sel:statePersistenceEnabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
statePersistenceEnabled} -> Maybe Bool
statePersistenceEnabled) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Maybe Bool
a -> GetDashboardEmbedUrl
s {$sel:statePersistenceEnabled:GetDashboardEmbedUrl' :: Maybe Bool
statePersistenceEnabled = Maybe Bool
a} :: GetDashboardEmbedUrl)

-- | Remove the undo\/redo button on the embedded dashboard. The default is
-- FALSE, which enables the undo\/redo button.
getDashboardEmbedUrl_undoRedoDisabled :: Lens.Lens' GetDashboardEmbedUrl (Prelude.Maybe Prelude.Bool)
getDashboardEmbedUrl_undoRedoDisabled :: Lens' GetDashboardEmbedUrl (Maybe Bool)
getDashboardEmbedUrl_undoRedoDisabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Maybe Bool
undoRedoDisabled :: Maybe Bool
$sel:undoRedoDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
undoRedoDisabled} -> Maybe Bool
undoRedoDisabled) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Maybe Bool
a -> GetDashboardEmbedUrl
s {$sel:undoRedoDisabled:GetDashboardEmbedUrl' :: Maybe Bool
undoRedoDisabled = Maybe Bool
a} :: GetDashboardEmbedUrl)

-- | The Amazon QuickSight user\'s Amazon Resource Name (ARN), for use with
-- @QUICKSIGHT@ identity type. You can use this for any Amazon QuickSight
-- users in your account (readers, authors, or admins) authenticated as one
-- of the following:
--
-- -   Active Directory (AD) users or group members
--
-- -   Invited nonfederated users
--
-- -   IAM users and IAM role-based sessions authenticated through
--     Federated Single Sign-On using SAML, OpenID Connect, or IAM
--     federation.
--
-- Omit this parameter for users in the third group – IAM users and IAM
-- role-based sessions.
getDashboardEmbedUrl_userArn :: Lens.Lens' GetDashboardEmbedUrl (Prelude.Maybe Prelude.Text)
getDashboardEmbedUrl_userArn :: Lens' GetDashboardEmbedUrl (Maybe Text)
getDashboardEmbedUrl_userArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Maybe Text
userArn :: Maybe Text
$sel:userArn:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
userArn} -> Maybe Text
userArn) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Maybe Text
a -> GetDashboardEmbedUrl
s {$sel:userArn:GetDashboardEmbedUrl' :: Maybe Text
userArn = Maybe Text
a} :: GetDashboardEmbedUrl)

-- | The ID for the Amazon Web Services account that contains the dashboard
-- that you\'re embedding.
getDashboardEmbedUrl_awsAccountId :: Lens.Lens' GetDashboardEmbedUrl Prelude.Text
getDashboardEmbedUrl_awsAccountId :: Lens' GetDashboardEmbedUrl Text
getDashboardEmbedUrl_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Text
awsAccountId :: Text
$sel:awsAccountId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
awsAccountId} -> Text
awsAccountId) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Text
a -> GetDashboardEmbedUrl
s {$sel:awsAccountId:GetDashboardEmbedUrl' :: Text
awsAccountId = Text
a} :: GetDashboardEmbedUrl)

-- | The ID for the dashboard, also added to the Identity and Access
-- Management (IAM) policy.
getDashboardEmbedUrl_dashboardId :: Lens.Lens' GetDashboardEmbedUrl Prelude.Text
getDashboardEmbedUrl_dashboardId :: Lens' GetDashboardEmbedUrl Text
getDashboardEmbedUrl_dashboardId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {Text
dashboardId :: Text
$sel:dashboardId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
dashboardId} -> Text
dashboardId) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} Text
a -> GetDashboardEmbedUrl
s {$sel:dashboardId:GetDashboardEmbedUrl' :: Text
dashboardId = Text
a} :: GetDashboardEmbedUrl)

-- | The authentication method that the user uses to sign in.
getDashboardEmbedUrl_identityType :: Lens.Lens' GetDashboardEmbedUrl EmbeddingIdentityType
getDashboardEmbedUrl_identityType :: Lens' GetDashboardEmbedUrl EmbeddingIdentityType
getDashboardEmbedUrl_identityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrl' {EmbeddingIdentityType
identityType :: EmbeddingIdentityType
$sel:identityType:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> EmbeddingIdentityType
identityType} -> EmbeddingIdentityType
identityType) (\s :: GetDashboardEmbedUrl
s@GetDashboardEmbedUrl' {} EmbeddingIdentityType
a -> GetDashboardEmbedUrl
s {$sel:identityType:GetDashboardEmbedUrl' :: EmbeddingIdentityType
identityType = EmbeddingIdentityType
a} :: GetDashboardEmbedUrl)

instance Core.AWSRequest GetDashboardEmbedUrl where
  type
    AWSResponse GetDashboardEmbedUrl =
      GetDashboardEmbedUrlResponse
  request :: (Service -> Service)
-> GetDashboardEmbedUrl -> Request GetDashboardEmbedUrl
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 GetDashboardEmbedUrl
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDashboardEmbedUrl)))
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 (Sensitive Text)
-> Maybe Text -> Int -> GetDashboardEmbedUrlResponse
GetDashboardEmbedUrlResponse'
            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
"EmbedUrl")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RequestId")
            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 GetDashboardEmbedUrl where
  hashWithSalt :: Int -> GetDashboardEmbedUrl -> Int
hashWithSalt Int
_salt GetDashboardEmbedUrl' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
EmbeddingIdentityType
identityType :: EmbeddingIdentityType
dashboardId :: Text
awsAccountId :: Text
userArn :: Maybe Text
undoRedoDisabled :: Maybe Bool
statePersistenceEnabled :: Maybe Bool
sessionLifetimeInMinutes :: Maybe Natural
resetDisabled :: Maybe Bool
namespace :: Maybe Text
additionalDashboardIds :: Maybe (NonEmpty Text)
$sel:identityType:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> EmbeddingIdentityType
$sel:dashboardId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:awsAccountId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:userArn:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:undoRedoDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:statePersistenceEnabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:sessionLifetimeInMinutes:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Natural
$sel:resetDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:namespace:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:additionalDashboardIds:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
additionalDashboardIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespace
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
resetDisabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
sessionLifetimeInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
statePersistenceEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
undoRedoDisabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dashboardId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EmbeddingIdentityType
identityType

instance Prelude.NFData GetDashboardEmbedUrl where
  rnf :: GetDashboardEmbedUrl -> ()
rnf GetDashboardEmbedUrl' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
EmbeddingIdentityType
identityType :: EmbeddingIdentityType
dashboardId :: Text
awsAccountId :: Text
userArn :: Maybe Text
undoRedoDisabled :: Maybe Bool
statePersistenceEnabled :: Maybe Bool
sessionLifetimeInMinutes :: Maybe Natural
resetDisabled :: Maybe Bool
namespace :: Maybe Text
additionalDashboardIds :: Maybe (NonEmpty Text)
$sel:identityType:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> EmbeddingIdentityType
$sel:dashboardId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:awsAccountId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:userArn:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:undoRedoDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:statePersistenceEnabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:sessionLifetimeInMinutes:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Natural
$sel:resetDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:namespace:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:additionalDashboardIds:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
additionalDashboardIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
resetDisabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
sessionLifetimeInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
statePersistenceEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
undoRedoDisabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId
      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 EmbeddingIdentityType
identityType

instance Data.ToHeaders GetDashboardEmbedUrl where
  toHeaders :: GetDashboardEmbedUrl -> 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.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetDashboardEmbedUrl where
  toPath :: GetDashboardEmbedUrl -> ByteString
toPath GetDashboardEmbedUrl' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
EmbeddingIdentityType
identityType :: EmbeddingIdentityType
dashboardId :: Text
awsAccountId :: Text
userArn :: Maybe Text
undoRedoDisabled :: Maybe Bool
statePersistenceEnabled :: Maybe Bool
sessionLifetimeInMinutes :: Maybe Natural
resetDisabled :: Maybe Bool
namespace :: Maybe Text
additionalDashboardIds :: Maybe (NonEmpty Text)
$sel:identityType:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> EmbeddingIdentityType
$sel:dashboardId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:awsAccountId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:userArn:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:undoRedoDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:statePersistenceEnabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:sessionLifetimeInMinutes:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Natural
$sel:resetDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:namespace:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:additionalDashboardIds:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe (NonEmpty Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
awsAccountId,
        ByteString
"/dashboards/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
dashboardId,
        ByteString
"/embed-url"
      ]

instance Data.ToQuery GetDashboardEmbedUrl where
  toQuery :: GetDashboardEmbedUrl -> QueryString
toQuery GetDashboardEmbedUrl' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
Text
EmbeddingIdentityType
identityType :: EmbeddingIdentityType
dashboardId :: Text
awsAccountId :: Text
userArn :: Maybe Text
undoRedoDisabled :: Maybe Bool
statePersistenceEnabled :: Maybe Bool
sessionLifetimeInMinutes :: Maybe Natural
resetDisabled :: Maybe Bool
namespace :: Maybe Text
additionalDashboardIds :: Maybe (NonEmpty Text)
$sel:identityType:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> EmbeddingIdentityType
$sel:dashboardId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:awsAccountId:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Text
$sel:userArn:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:undoRedoDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:statePersistenceEnabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:sessionLifetimeInMinutes:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Natural
$sel:resetDisabled:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Bool
$sel:namespace:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe Text
$sel:additionalDashboardIds:GetDashboardEmbedUrl' :: GetDashboardEmbedUrl -> Maybe (NonEmpty Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"additional-dashboard-ids"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
additionalDashboardIds
            ),
        ByteString
"namespace" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namespace,
        ByteString
"reset-disabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
resetDisabled,
        ByteString
"session-lifetime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
sessionLifetimeInMinutes,
        ByteString
"state-persistence-enabled"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
statePersistenceEnabled,
        ByteString
"undo-redo-disabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
undoRedoDisabled,
        ByteString
"user-arn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
userArn,
        ByteString
"creds-type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: EmbeddingIdentityType
identityType
      ]

-- | Output returned from the @GetDashboardEmbedUrl@ operation.
--
-- /See:/ 'newGetDashboardEmbedUrlResponse' smart constructor.
data GetDashboardEmbedUrlResponse = GetDashboardEmbedUrlResponse'
  { -- | A single-use URL that you can put into your server-side webpage to embed
    -- your dashboard. This URL is valid for 5 minutes. The API operation
    -- provides the URL with an @auth_code@ value that enables one (and only
    -- one) sign-on to a user session that is valid for 10 hours.
    GetDashboardEmbedUrlResponse -> Maybe (Sensitive Text)
embedUrl :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Web Services request ID for this operation.
    GetDashboardEmbedUrlResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The HTTP status of the request.
    GetDashboardEmbedUrlResponse -> Int
status :: Prelude.Int
  }
  deriving (GetDashboardEmbedUrlResponse
-> GetDashboardEmbedUrlResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDashboardEmbedUrlResponse
-> GetDashboardEmbedUrlResponse -> Bool
$c/= :: GetDashboardEmbedUrlResponse
-> GetDashboardEmbedUrlResponse -> Bool
== :: GetDashboardEmbedUrlResponse
-> GetDashboardEmbedUrlResponse -> Bool
$c== :: GetDashboardEmbedUrlResponse
-> GetDashboardEmbedUrlResponse -> Bool
Prelude.Eq, Int -> GetDashboardEmbedUrlResponse -> ShowS
[GetDashboardEmbedUrlResponse] -> ShowS
GetDashboardEmbedUrlResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDashboardEmbedUrlResponse] -> ShowS
$cshowList :: [GetDashboardEmbedUrlResponse] -> ShowS
show :: GetDashboardEmbedUrlResponse -> String
$cshow :: GetDashboardEmbedUrlResponse -> String
showsPrec :: Int -> GetDashboardEmbedUrlResponse -> ShowS
$cshowsPrec :: Int -> GetDashboardEmbedUrlResponse -> ShowS
Prelude.Show, forall x.
Rep GetDashboardEmbedUrlResponse x -> GetDashboardEmbedUrlResponse
forall x.
GetDashboardEmbedUrlResponse -> Rep GetDashboardEmbedUrlResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDashboardEmbedUrlResponse x -> GetDashboardEmbedUrlResponse
$cfrom :: forall x.
GetDashboardEmbedUrlResponse -> Rep GetDashboardEmbedUrlResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDashboardEmbedUrlResponse' 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:
--
-- 'embedUrl', 'getDashboardEmbedUrlResponse_embedUrl' - A single-use URL that you can put into your server-side webpage to embed
-- your dashboard. This URL is valid for 5 minutes. The API operation
-- provides the URL with an @auth_code@ value that enables one (and only
-- one) sign-on to a user session that is valid for 10 hours.
--
-- 'requestId', 'getDashboardEmbedUrlResponse_requestId' - The Amazon Web Services request ID for this operation.
--
-- 'status', 'getDashboardEmbedUrlResponse_status' - The HTTP status of the request.
newGetDashboardEmbedUrlResponse ::
  -- | 'status'
  Prelude.Int ->
  GetDashboardEmbedUrlResponse
newGetDashboardEmbedUrlResponse :: Int -> GetDashboardEmbedUrlResponse
newGetDashboardEmbedUrlResponse Int
pStatus_ =
  GetDashboardEmbedUrlResponse'
    { $sel:embedUrl:GetDashboardEmbedUrlResponse' :: Maybe (Sensitive Text)
embedUrl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:GetDashboardEmbedUrlResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetDashboardEmbedUrlResponse' :: Int
status = Int
pStatus_
    }

-- | A single-use URL that you can put into your server-side webpage to embed
-- your dashboard. This URL is valid for 5 minutes. The API operation
-- provides the URL with an @auth_code@ value that enables one (and only
-- one) sign-on to a user session that is valid for 10 hours.
getDashboardEmbedUrlResponse_embedUrl :: Lens.Lens' GetDashboardEmbedUrlResponse (Prelude.Maybe Prelude.Text)
getDashboardEmbedUrlResponse_embedUrl :: Lens' GetDashboardEmbedUrlResponse (Maybe Text)
getDashboardEmbedUrlResponse_embedUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrlResponse' {Maybe (Sensitive Text)
embedUrl :: Maybe (Sensitive Text)
$sel:embedUrl:GetDashboardEmbedUrlResponse' :: GetDashboardEmbedUrlResponse -> Maybe (Sensitive Text)
embedUrl} -> Maybe (Sensitive Text)
embedUrl) (\s :: GetDashboardEmbedUrlResponse
s@GetDashboardEmbedUrlResponse' {} Maybe (Sensitive Text)
a -> GetDashboardEmbedUrlResponse
s {$sel:embedUrl:GetDashboardEmbedUrlResponse' :: Maybe (Sensitive Text)
embedUrl = Maybe (Sensitive Text)
a} :: GetDashboardEmbedUrlResponse) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The Amazon Web Services request ID for this operation.
getDashboardEmbedUrlResponse_requestId :: Lens.Lens' GetDashboardEmbedUrlResponse (Prelude.Maybe Prelude.Text)
getDashboardEmbedUrlResponse_requestId :: Lens' GetDashboardEmbedUrlResponse (Maybe Text)
getDashboardEmbedUrlResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrlResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:GetDashboardEmbedUrlResponse' :: GetDashboardEmbedUrlResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: GetDashboardEmbedUrlResponse
s@GetDashboardEmbedUrlResponse' {} Maybe Text
a -> GetDashboardEmbedUrlResponse
s {$sel:requestId:GetDashboardEmbedUrlResponse' :: Maybe Text
requestId = Maybe Text
a} :: GetDashboardEmbedUrlResponse)

-- | The HTTP status of the request.
getDashboardEmbedUrlResponse_status :: Lens.Lens' GetDashboardEmbedUrlResponse Prelude.Int
getDashboardEmbedUrlResponse_status :: Lens' GetDashboardEmbedUrlResponse Int
getDashboardEmbedUrlResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDashboardEmbedUrlResponse' {Int
status :: Int
$sel:status:GetDashboardEmbedUrlResponse' :: GetDashboardEmbedUrlResponse -> Int
status} -> Int
status) (\s :: GetDashboardEmbedUrlResponse
s@GetDashboardEmbedUrlResponse' {} Int
a -> GetDashboardEmbedUrlResponse
s {$sel:status:GetDashboardEmbedUrlResponse' :: Int
status = Int
a} :: GetDashboardEmbedUrlResponse)

instance Prelude.NFData GetDashboardEmbedUrlResponse where
  rnf :: GetDashboardEmbedUrlResponse -> ()
rnf GetDashboardEmbedUrlResponse' {Int
Maybe Text
Maybe (Sensitive Text)
status :: Int
requestId :: Maybe Text
embedUrl :: Maybe (Sensitive Text)
$sel:status:GetDashboardEmbedUrlResponse' :: GetDashboardEmbedUrlResponse -> Int
$sel:requestId:GetDashboardEmbedUrlResponse' :: GetDashboardEmbedUrlResponse -> Maybe Text
$sel:embedUrl:GetDashboardEmbedUrlResponse' :: GetDashboardEmbedUrlResponse -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
embedUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
status