{-# 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.GenerateEmbedUrlForAnonymousUser
-- 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 an embed URL that you can use to embed an Amazon QuickSight
-- dashboard or visual in your website, without having to register any
-- reader users. Before you use this action, make sure that you have
-- configured the dashboards and permissions.
--
-- The following rules apply to the generated URL:
--
-- -   It contains a temporary bearer token. It is valid for 5 minutes
--     after it is generated. Once redeemed within this period, it cannot
--     be re-used again.
--
-- -   The URL validity period should not be confused with the actual
--     session lifetime that can be customized using the
--     @ @<https://docs.aws.amazon.com/quicksight/latest/APIReference/API_GenerateEmbedUrlForAnonymousUser.html#QS-GenerateEmbedUrlForAnonymousUser-request-SessionLifetimeInMinutes SessionLifetimeInMinutes>@ @
--     parameter. The resulting user session is valid for 15 minutes
--     (minimum) to 10 hours (maximum). The default session duration is 10
--     hours.
--
-- -   You are charged only when the URL is used or there is interaction
--     with Amazon QuickSight.
--
-- For more information, see
-- <https://docs.aws.amazon.com/quicksight/latest/user/embedded-analytics.html Embedded Analytics>
-- 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.GenerateEmbedUrlForAnonymousUser
  ( -- * Creating a Request
    GenerateEmbedUrlForAnonymousUser (..),
    newGenerateEmbedUrlForAnonymousUser,

    -- * Request Lenses
    generateEmbedUrlForAnonymousUser_allowedDomains,
    generateEmbedUrlForAnonymousUser_sessionLifetimeInMinutes,
    generateEmbedUrlForAnonymousUser_sessionTags,
    generateEmbedUrlForAnonymousUser_awsAccountId,
    generateEmbedUrlForAnonymousUser_namespace,
    generateEmbedUrlForAnonymousUser_authorizedResourceArns,
    generateEmbedUrlForAnonymousUser_experienceConfiguration,

    -- * Destructuring the Response
    GenerateEmbedUrlForAnonymousUserResponse (..),
    newGenerateEmbedUrlForAnonymousUserResponse,

    -- * Response Lenses
    generateEmbedUrlForAnonymousUserResponse_status,
    generateEmbedUrlForAnonymousUserResponse_embedUrl,
    generateEmbedUrlForAnonymousUserResponse_requestId,
    generateEmbedUrlForAnonymousUserResponse_anonymousUserArn,
  )
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:/ 'newGenerateEmbedUrlForAnonymousUser' smart constructor.
data GenerateEmbedUrlForAnonymousUser = GenerateEmbedUrlForAnonymousUser'
  { -- | The domains that you want to add to the allow list for access to the
    -- generated URL that is then embedded. This optional parameter overrides
    -- the static domains that are configured in the Manage QuickSight menu in
    -- the Amazon QuickSight console. Instead, it allows only the domains that
    -- you include in this parameter. You can list up to three domains or
    -- subdomains in each API call.
    --
    -- To include all subdomains under a specific domain to the allow list, use
    -- @*@. For example, @https:\/\/*.sapp.amazon.com@ includes all subdomains
    -- under @https:\/\/sapp.amazon.com@.
    GenerateEmbedUrlForAnonymousUser -> Maybe [Text]
allowedDomains :: Prelude.Maybe [Prelude.Text],
    -- | How many minutes the session is valid. The session lifetime must be in
    -- [15-600] minutes range.
    GenerateEmbedUrlForAnonymousUser -> Maybe Natural
sessionLifetimeInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | The session tags used for row-level security. Before you use this
    -- parameter, make sure that you have configured the relevant datasets
    -- using the @DataSet$RowLevelPermissionTagConfiguration@ parameter so that
    -- session tags can be used to provide row-level security.
    --
    -- These are not the tags used for the Amazon Web Services resource tagging
    -- feature. For more information, see
    -- <https://docs.aws.amazon.com/quicksight/latest/user/quicksight-dev-rls-tags.html Using Row-Level Security (RLS) with Tags>in
    -- the /Amazon QuickSight User Guide/.
    GenerateEmbedUrlForAnonymousUser -> Maybe (NonEmpty SessionTag)
sessionTags :: Prelude.Maybe (Prelude.NonEmpty SessionTag),
    -- | The ID for the Amazon Web Services account that contains the dashboard
    -- that you\'re embedding.
    GenerateEmbedUrlForAnonymousUser -> Text
awsAccountId :: Prelude.Text,
    -- | The Amazon QuickSight namespace that the anonymous user virtually
    -- belongs to. If you are not using an Amazon QuickSight custom namespace,
    -- set this to @default@.
    GenerateEmbedUrlForAnonymousUser -> Text
namespace :: Prelude.Text,
    -- | The Amazon Resource Names (ARNs) for the Amazon QuickSight resources
    -- that the user is authorized to access during the lifetime of the
    -- session. If you choose @Dashboard@ embedding experience, pass the list
    -- of dashboard ARNs in the account that you want the user to be able to
    -- view. Currently, you can pass up to 25 dashboard ARNs in each API call.
    GenerateEmbedUrlForAnonymousUser -> [Text]
authorizedResourceArns :: [Prelude.Text],
    -- | The configuration of the experience that you are embedding.
    GenerateEmbedUrlForAnonymousUser
-> AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration :: AnonymousUserEmbeddingExperienceConfiguration
  }
  deriving (GenerateEmbedUrlForAnonymousUser
-> GenerateEmbedUrlForAnonymousUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenerateEmbedUrlForAnonymousUser
-> GenerateEmbedUrlForAnonymousUser -> Bool
$c/= :: GenerateEmbedUrlForAnonymousUser
-> GenerateEmbedUrlForAnonymousUser -> Bool
== :: GenerateEmbedUrlForAnonymousUser
-> GenerateEmbedUrlForAnonymousUser -> Bool
$c== :: GenerateEmbedUrlForAnonymousUser
-> GenerateEmbedUrlForAnonymousUser -> Bool
Prelude.Eq, Int -> GenerateEmbedUrlForAnonymousUser -> ShowS
[GenerateEmbedUrlForAnonymousUser] -> ShowS
GenerateEmbedUrlForAnonymousUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenerateEmbedUrlForAnonymousUser] -> ShowS
$cshowList :: [GenerateEmbedUrlForAnonymousUser] -> ShowS
show :: GenerateEmbedUrlForAnonymousUser -> String
$cshow :: GenerateEmbedUrlForAnonymousUser -> String
showsPrec :: Int -> GenerateEmbedUrlForAnonymousUser -> ShowS
$cshowsPrec :: Int -> GenerateEmbedUrlForAnonymousUser -> ShowS
Prelude.Show, forall x.
Rep GenerateEmbedUrlForAnonymousUser x
-> GenerateEmbedUrlForAnonymousUser
forall x.
GenerateEmbedUrlForAnonymousUser
-> Rep GenerateEmbedUrlForAnonymousUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GenerateEmbedUrlForAnonymousUser x
-> GenerateEmbedUrlForAnonymousUser
$cfrom :: forall x.
GenerateEmbedUrlForAnonymousUser
-> Rep GenerateEmbedUrlForAnonymousUser x
Prelude.Generic)

-- |
-- Create a value of 'GenerateEmbedUrlForAnonymousUser' 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:
--
-- 'allowedDomains', 'generateEmbedUrlForAnonymousUser_allowedDomains' - The domains that you want to add to the allow list for access to the
-- generated URL that is then embedded. This optional parameter overrides
-- the static domains that are configured in the Manage QuickSight menu in
-- the Amazon QuickSight console. Instead, it allows only the domains that
-- you include in this parameter. You can list up to three domains or
-- subdomains in each API call.
--
-- To include all subdomains under a specific domain to the allow list, use
-- @*@. For example, @https:\/\/*.sapp.amazon.com@ includes all subdomains
-- under @https:\/\/sapp.amazon.com@.
--
-- 'sessionLifetimeInMinutes', 'generateEmbedUrlForAnonymousUser_sessionLifetimeInMinutes' - How many minutes the session is valid. The session lifetime must be in
-- [15-600] minutes range.
--
-- 'sessionTags', 'generateEmbedUrlForAnonymousUser_sessionTags' - The session tags used for row-level security. Before you use this
-- parameter, make sure that you have configured the relevant datasets
-- using the @DataSet$RowLevelPermissionTagConfiguration@ parameter so that
-- session tags can be used to provide row-level security.
--
-- These are not the tags used for the Amazon Web Services resource tagging
-- feature. For more information, see
-- <https://docs.aws.amazon.com/quicksight/latest/user/quicksight-dev-rls-tags.html Using Row-Level Security (RLS) with Tags>in
-- the /Amazon QuickSight User Guide/.
--
-- 'awsAccountId', 'generateEmbedUrlForAnonymousUser_awsAccountId' - The ID for the Amazon Web Services account that contains the dashboard
-- that you\'re embedding.
--
-- 'namespace', 'generateEmbedUrlForAnonymousUser_namespace' - The Amazon QuickSight namespace that the anonymous user virtually
-- belongs to. If you are not using an Amazon QuickSight custom namespace,
-- set this to @default@.
--
-- 'authorizedResourceArns', 'generateEmbedUrlForAnonymousUser_authorizedResourceArns' - The Amazon Resource Names (ARNs) for the Amazon QuickSight resources
-- that the user is authorized to access during the lifetime of the
-- session. If you choose @Dashboard@ embedding experience, pass the list
-- of dashboard ARNs in the account that you want the user to be able to
-- view. Currently, you can pass up to 25 dashboard ARNs in each API call.
--
-- 'experienceConfiguration', 'generateEmbedUrlForAnonymousUser_experienceConfiguration' - The configuration of the experience that you are embedding.
newGenerateEmbedUrlForAnonymousUser ::
  -- | 'awsAccountId'
  Prelude.Text ->
  -- | 'namespace'
  Prelude.Text ->
  -- | 'experienceConfiguration'
  AnonymousUserEmbeddingExperienceConfiguration ->
  GenerateEmbedUrlForAnonymousUser
newGenerateEmbedUrlForAnonymousUser :: Text
-> Text
-> AnonymousUserEmbeddingExperienceConfiguration
-> GenerateEmbedUrlForAnonymousUser
newGenerateEmbedUrlForAnonymousUser
  Text
pAwsAccountId_
  Text
pNamespace_
  AnonymousUserEmbeddingExperienceConfiguration
pExperienceConfiguration_ =
    GenerateEmbedUrlForAnonymousUser'
      { $sel:allowedDomains:GenerateEmbedUrlForAnonymousUser' :: Maybe [Text]
allowedDomains =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sessionLifetimeInMinutes:GenerateEmbedUrlForAnonymousUser' :: Maybe Natural
sessionLifetimeInMinutes =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sessionTags:GenerateEmbedUrlForAnonymousUser' :: Maybe (NonEmpty SessionTag)
sessionTags = forall a. Maybe a
Prelude.Nothing,
        $sel:awsAccountId:GenerateEmbedUrlForAnonymousUser' :: Text
awsAccountId = Text
pAwsAccountId_,
        $sel:namespace:GenerateEmbedUrlForAnonymousUser' :: Text
namespace = Text
pNamespace_,
        $sel:authorizedResourceArns:GenerateEmbedUrlForAnonymousUser' :: [Text]
authorizedResourceArns = forall a. Monoid a => a
Prelude.mempty,
        $sel:experienceConfiguration:GenerateEmbedUrlForAnonymousUser' :: AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration =
          AnonymousUserEmbeddingExperienceConfiguration
pExperienceConfiguration_
      }

-- | The domains that you want to add to the allow list for access to the
-- generated URL that is then embedded. This optional parameter overrides
-- the static domains that are configured in the Manage QuickSight menu in
-- the Amazon QuickSight console. Instead, it allows only the domains that
-- you include in this parameter. You can list up to three domains or
-- subdomains in each API call.
--
-- To include all subdomains under a specific domain to the allow list, use
-- @*@. For example, @https:\/\/*.sapp.amazon.com@ includes all subdomains
-- under @https:\/\/sapp.amazon.com@.
generateEmbedUrlForAnonymousUser_allowedDomains :: Lens.Lens' GenerateEmbedUrlForAnonymousUser (Prelude.Maybe [Prelude.Text])
generateEmbedUrlForAnonymousUser_allowedDomains :: Lens' GenerateEmbedUrlForAnonymousUser (Maybe [Text])
generateEmbedUrlForAnonymousUser_allowedDomains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUser' {Maybe [Text]
allowedDomains :: Maybe [Text]
$sel:allowedDomains:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe [Text]
allowedDomains} -> Maybe [Text]
allowedDomains) (\s :: GenerateEmbedUrlForAnonymousUser
s@GenerateEmbedUrlForAnonymousUser' {} Maybe [Text]
a -> GenerateEmbedUrlForAnonymousUser
s {$sel:allowedDomains:GenerateEmbedUrlForAnonymousUser' :: Maybe [Text]
allowedDomains = Maybe [Text]
a} :: GenerateEmbedUrlForAnonymousUser) 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

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

-- | The session tags used for row-level security. Before you use this
-- parameter, make sure that you have configured the relevant datasets
-- using the @DataSet$RowLevelPermissionTagConfiguration@ parameter so that
-- session tags can be used to provide row-level security.
--
-- These are not the tags used for the Amazon Web Services resource tagging
-- feature. For more information, see
-- <https://docs.aws.amazon.com/quicksight/latest/user/quicksight-dev-rls-tags.html Using Row-Level Security (RLS) with Tags>in
-- the /Amazon QuickSight User Guide/.
generateEmbedUrlForAnonymousUser_sessionTags :: Lens.Lens' GenerateEmbedUrlForAnonymousUser (Prelude.Maybe (Prelude.NonEmpty SessionTag))
generateEmbedUrlForAnonymousUser_sessionTags :: Lens'
  GenerateEmbedUrlForAnonymousUser (Maybe (NonEmpty SessionTag))
generateEmbedUrlForAnonymousUser_sessionTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUser' {Maybe (NonEmpty SessionTag)
sessionTags :: Maybe (NonEmpty SessionTag)
$sel:sessionTags:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe (NonEmpty SessionTag)
sessionTags} -> Maybe (NonEmpty SessionTag)
sessionTags) (\s :: GenerateEmbedUrlForAnonymousUser
s@GenerateEmbedUrlForAnonymousUser' {} Maybe (NonEmpty SessionTag)
a -> GenerateEmbedUrlForAnonymousUser
s {$sel:sessionTags:GenerateEmbedUrlForAnonymousUser' :: Maybe (NonEmpty SessionTag)
sessionTags = Maybe (NonEmpty SessionTag)
a} :: GenerateEmbedUrlForAnonymousUser) 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 for the Amazon Web Services account that contains the dashboard
-- that you\'re embedding.
generateEmbedUrlForAnonymousUser_awsAccountId :: Lens.Lens' GenerateEmbedUrlForAnonymousUser Prelude.Text
generateEmbedUrlForAnonymousUser_awsAccountId :: Lens' GenerateEmbedUrlForAnonymousUser Text
generateEmbedUrlForAnonymousUser_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUser' {Text
awsAccountId :: Text
$sel:awsAccountId:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
awsAccountId} -> Text
awsAccountId) (\s :: GenerateEmbedUrlForAnonymousUser
s@GenerateEmbedUrlForAnonymousUser' {} Text
a -> GenerateEmbedUrlForAnonymousUser
s {$sel:awsAccountId:GenerateEmbedUrlForAnonymousUser' :: Text
awsAccountId = Text
a} :: GenerateEmbedUrlForAnonymousUser)

-- | The Amazon QuickSight namespace that the anonymous user virtually
-- belongs to. If you are not using an Amazon QuickSight custom namespace,
-- set this to @default@.
generateEmbedUrlForAnonymousUser_namespace :: Lens.Lens' GenerateEmbedUrlForAnonymousUser Prelude.Text
generateEmbedUrlForAnonymousUser_namespace :: Lens' GenerateEmbedUrlForAnonymousUser Text
generateEmbedUrlForAnonymousUser_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUser' {Text
namespace :: Text
$sel:namespace:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
namespace} -> Text
namespace) (\s :: GenerateEmbedUrlForAnonymousUser
s@GenerateEmbedUrlForAnonymousUser' {} Text
a -> GenerateEmbedUrlForAnonymousUser
s {$sel:namespace:GenerateEmbedUrlForAnonymousUser' :: Text
namespace = Text
a} :: GenerateEmbedUrlForAnonymousUser)

-- | The Amazon Resource Names (ARNs) for the Amazon QuickSight resources
-- that the user is authorized to access during the lifetime of the
-- session. If you choose @Dashboard@ embedding experience, pass the list
-- of dashboard ARNs in the account that you want the user to be able to
-- view. Currently, you can pass up to 25 dashboard ARNs in each API call.
generateEmbedUrlForAnonymousUser_authorizedResourceArns :: Lens.Lens' GenerateEmbedUrlForAnonymousUser [Prelude.Text]
generateEmbedUrlForAnonymousUser_authorizedResourceArns :: Lens' GenerateEmbedUrlForAnonymousUser [Text]
generateEmbedUrlForAnonymousUser_authorizedResourceArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUser' {[Text]
authorizedResourceArns :: [Text]
$sel:authorizedResourceArns:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> [Text]
authorizedResourceArns} -> [Text]
authorizedResourceArns) (\s :: GenerateEmbedUrlForAnonymousUser
s@GenerateEmbedUrlForAnonymousUser' {} [Text]
a -> GenerateEmbedUrlForAnonymousUser
s {$sel:authorizedResourceArns:GenerateEmbedUrlForAnonymousUser' :: [Text]
authorizedResourceArns = [Text]
a} :: GenerateEmbedUrlForAnonymousUser) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The configuration of the experience that you are embedding.
generateEmbedUrlForAnonymousUser_experienceConfiguration :: Lens.Lens' GenerateEmbedUrlForAnonymousUser AnonymousUserEmbeddingExperienceConfiguration
generateEmbedUrlForAnonymousUser_experienceConfiguration :: Lens'
  GenerateEmbedUrlForAnonymousUser
  AnonymousUserEmbeddingExperienceConfiguration
generateEmbedUrlForAnonymousUser_experienceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUser' {AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration :: AnonymousUserEmbeddingExperienceConfiguration
$sel:experienceConfiguration:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser
-> AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration} -> AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration) (\s :: GenerateEmbedUrlForAnonymousUser
s@GenerateEmbedUrlForAnonymousUser' {} AnonymousUserEmbeddingExperienceConfiguration
a -> GenerateEmbedUrlForAnonymousUser
s {$sel:experienceConfiguration:GenerateEmbedUrlForAnonymousUser' :: AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration = AnonymousUserEmbeddingExperienceConfiguration
a} :: GenerateEmbedUrlForAnonymousUser)

instance
  Core.AWSRequest
    GenerateEmbedUrlForAnonymousUser
  where
  type
    AWSResponse GenerateEmbedUrlForAnonymousUser =
      GenerateEmbedUrlForAnonymousUserResponse
  request :: (Service -> Service)
-> GenerateEmbedUrlForAnonymousUser
-> Request GenerateEmbedUrlForAnonymousUser
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 GenerateEmbedUrlForAnonymousUser
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GenerateEmbedUrlForAnonymousUser)))
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
-> Sensitive Text
-> Text
-> Text
-> GenerateEmbedUrlForAnonymousUserResponse
GenerateEmbedUrlForAnonymousUserResponse'
            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
"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 a
Data..:> Key
"RequestId")
            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
"AnonymousUserArn")
      )

instance
  Prelude.Hashable
    GenerateEmbedUrlForAnonymousUser
  where
  hashWithSalt :: Int -> GenerateEmbedUrlForAnonymousUser -> Int
hashWithSalt
    Int
_salt
    GenerateEmbedUrlForAnonymousUser' {[Text]
Maybe Natural
Maybe [Text]
Maybe (NonEmpty SessionTag)
Text
AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration :: AnonymousUserEmbeddingExperienceConfiguration
authorizedResourceArns :: [Text]
namespace :: Text
awsAccountId :: Text
sessionTags :: Maybe (NonEmpty SessionTag)
sessionLifetimeInMinutes :: Maybe Natural
allowedDomains :: Maybe [Text]
$sel:experienceConfiguration:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser
-> AnonymousUserEmbeddingExperienceConfiguration
$sel:authorizedResourceArns:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> [Text]
$sel:namespace:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:awsAccountId:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:sessionTags:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe (NonEmpty SessionTag)
$sel:sessionLifetimeInMinutes:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe Natural
$sel:allowedDomains:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe [Text]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
allowedDomains
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
sessionLifetimeInMinutes
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty SessionTag)
sessionTags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
namespace
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
authorizedResourceArns
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration

instance
  Prelude.NFData
    GenerateEmbedUrlForAnonymousUser
  where
  rnf :: GenerateEmbedUrlForAnonymousUser -> ()
rnf GenerateEmbedUrlForAnonymousUser' {[Text]
Maybe Natural
Maybe [Text]
Maybe (NonEmpty SessionTag)
Text
AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration :: AnonymousUserEmbeddingExperienceConfiguration
authorizedResourceArns :: [Text]
namespace :: Text
awsAccountId :: Text
sessionTags :: Maybe (NonEmpty SessionTag)
sessionLifetimeInMinutes :: Maybe Natural
allowedDomains :: Maybe [Text]
$sel:experienceConfiguration:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser
-> AnonymousUserEmbeddingExperienceConfiguration
$sel:authorizedResourceArns:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> [Text]
$sel:namespace:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:awsAccountId:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:sessionTags:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe (NonEmpty SessionTag)
$sel:sessionLifetimeInMinutes:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe Natural
$sel:allowedDomains:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
allowedDomains
      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 (NonEmpty SessionTag)
sessionTags
      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
namespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
authorizedResourceArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration

instance
  Data.ToHeaders
    GenerateEmbedUrlForAnonymousUser
  where
  toHeaders :: GenerateEmbedUrlForAnonymousUser -> 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.ToJSON GenerateEmbedUrlForAnonymousUser where
  toJSON :: GenerateEmbedUrlForAnonymousUser -> Value
toJSON GenerateEmbedUrlForAnonymousUser' {[Text]
Maybe Natural
Maybe [Text]
Maybe (NonEmpty SessionTag)
Text
AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration :: AnonymousUserEmbeddingExperienceConfiguration
authorizedResourceArns :: [Text]
namespace :: Text
awsAccountId :: Text
sessionTags :: Maybe (NonEmpty SessionTag)
sessionLifetimeInMinutes :: Maybe Natural
allowedDomains :: Maybe [Text]
$sel:experienceConfiguration:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser
-> AnonymousUserEmbeddingExperienceConfiguration
$sel:authorizedResourceArns:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> [Text]
$sel:namespace:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:awsAccountId:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:sessionTags:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe (NonEmpty SessionTag)
$sel:sessionLifetimeInMinutes:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe Natural
$sel:allowedDomains:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllowedDomains" 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]
allowedDomains,
            (Key
"SessionLifetimeInMinutes" 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 Natural
sessionLifetimeInMinutes,
            (Key
"SessionTags" 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 (NonEmpty SessionTag)
sessionTags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Namespace" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
namespace),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"AuthorizedResourceArns"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
authorizedResourceArns
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ExperienceConfiguration"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration
              )
          ]
      )

instance Data.ToPath GenerateEmbedUrlForAnonymousUser where
  toPath :: GenerateEmbedUrlForAnonymousUser -> ByteString
toPath GenerateEmbedUrlForAnonymousUser' {[Text]
Maybe Natural
Maybe [Text]
Maybe (NonEmpty SessionTag)
Text
AnonymousUserEmbeddingExperienceConfiguration
experienceConfiguration :: AnonymousUserEmbeddingExperienceConfiguration
authorizedResourceArns :: [Text]
namespace :: Text
awsAccountId :: Text
sessionTags :: Maybe (NonEmpty SessionTag)
sessionLifetimeInMinutes :: Maybe Natural
allowedDomains :: Maybe [Text]
$sel:experienceConfiguration:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser
-> AnonymousUserEmbeddingExperienceConfiguration
$sel:authorizedResourceArns:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> [Text]
$sel:namespace:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:awsAccountId:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Text
$sel:sessionTags:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe (NonEmpty SessionTag)
$sel:sessionLifetimeInMinutes:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe Natural
$sel:allowedDomains:GenerateEmbedUrlForAnonymousUser' :: GenerateEmbedUrlForAnonymousUser -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
awsAccountId,
        ByteString
"/embed-url/anonymous-user"
      ]

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

-- | /See:/ 'newGenerateEmbedUrlForAnonymousUserResponse' smart constructor.
data GenerateEmbedUrlForAnonymousUserResponse = GenerateEmbedUrlForAnonymousUserResponse'
  { -- | The HTTP status of the request.
    GenerateEmbedUrlForAnonymousUserResponse -> Int
status :: Prelude.Int,
    -- | The embed URL for the dashboard.
    GenerateEmbedUrlForAnonymousUserResponse -> Sensitive Text
embedUrl :: Data.Sensitive Prelude.Text,
    -- | The Amazon Web Services request ID for this operation.
    GenerateEmbedUrlForAnonymousUserResponse -> Text
requestId :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) to use for the anonymous Amazon
    -- QuickSight user.
    GenerateEmbedUrlForAnonymousUserResponse -> Text
anonymousUserArn :: Prelude.Text
  }
  deriving (GenerateEmbedUrlForAnonymousUserResponse
-> GenerateEmbedUrlForAnonymousUserResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenerateEmbedUrlForAnonymousUserResponse
-> GenerateEmbedUrlForAnonymousUserResponse -> Bool
$c/= :: GenerateEmbedUrlForAnonymousUserResponse
-> GenerateEmbedUrlForAnonymousUserResponse -> Bool
== :: GenerateEmbedUrlForAnonymousUserResponse
-> GenerateEmbedUrlForAnonymousUserResponse -> Bool
$c== :: GenerateEmbedUrlForAnonymousUserResponse
-> GenerateEmbedUrlForAnonymousUserResponse -> Bool
Prelude.Eq, Int -> GenerateEmbedUrlForAnonymousUserResponse -> ShowS
[GenerateEmbedUrlForAnonymousUserResponse] -> ShowS
GenerateEmbedUrlForAnonymousUserResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenerateEmbedUrlForAnonymousUserResponse] -> ShowS
$cshowList :: [GenerateEmbedUrlForAnonymousUserResponse] -> ShowS
show :: GenerateEmbedUrlForAnonymousUserResponse -> String
$cshow :: GenerateEmbedUrlForAnonymousUserResponse -> String
showsPrec :: Int -> GenerateEmbedUrlForAnonymousUserResponse -> ShowS
$cshowsPrec :: Int -> GenerateEmbedUrlForAnonymousUserResponse -> ShowS
Prelude.Show, forall x.
Rep GenerateEmbedUrlForAnonymousUserResponse x
-> GenerateEmbedUrlForAnonymousUserResponse
forall x.
GenerateEmbedUrlForAnonymousUserResponse
-> Rep GenerateEmbedUrlForAnonymousUserResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GenerateEmbedUrlForAnonymousUserResponse x
-> GenerateEmbedUrlForAnonymousUserResponse
$cfrom :: forall x.
GenerateEmbedUrlForAnonymousUserResponse
-> Rep GenerateEmbedUrlForAnonymousUserResponse x
Prelude.Generic)

-- |
-- Create a value of 'GenerateEmbedUrlForAnonymousUserResponse' 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:
--
-- 'status', 'generateEmbedUrlForAnonymousUserResponse_status' - The HTTP status of the request.
--
-- 'embedUrl', 'generateEmbedUrlForAnonymousUserResponse_embedUrl' - The embed URL for the dashboard.
--
-- 'requestId', 'generateEmbedUrlForAnonymousUserResponse_requestId' - The Amazon Web Services request ID for this operation.
--
-- 'anonymousUserArn', 'generateEmbedUrlForAnonymousUserResponse_anonymousUserArn' - The Amazon Resource Name (ARN) to use for the anonymous Amazon
-- QuickSight user.
newGenerateEmbedUrlForAnonymousUserResponse ::
  -- | 'status'
  Prelude.Int ->
  -- | 'embedUrl'
  Prelude.Text ->
  -- | 'requestId'
  Prelude.Text ->
  -- | 'anonymousUserArn'
  Prelude.Text ->
  GenerateEmbedUrlForAnonymousUserResponse
newGenerateEmbedUrlForAnonymousUserResponse :: Int
-> Text -> Text -> Text -> GenerateEmbedUrlForAnonymousUserResponse
newGenerateEmbedUrlForAnonymousUserResponse
  Int
pStatus_
  Text
pEmbedUrl_
  Text
pRequestId_
  Text
pAnonymousUserArn_ =
    GenerateEmbedUrlForAnonymousUserResponse'
      { $sel:status:GenerateEmbedUrlForAnonymousUserResponse' :: Int
status =
          Int
pStatus_,
        $sel:embedUrl:GenerateEmbedUrlForAnonymousUserResponse' :: Sensitive Text
embedUrl =
          forall a. Iso' (Sensitive a) a
Data._Sensitive
            forall t b. AReview t b -> b -> t
Lens.# Text
pEmbedUrl_,
        $sel:requestId:GenerateEmbedUrlForAnonymousUserResponse' :: Text
requestId = Text
pRequestId_,
        $sel:anonymousUserArn:GenerateEmbedUrlForAnonymousUserResponse' :: Text
anonymousUserArn =
          Text
pAnonymousUserArn_
      }

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

-- | The embed URL for the dashboard.
generateEmbedUrlForAnonymousUserResponse_embedUrl :: Lens.Lens' GenerateEmbedUrlForAnonymousUserResponse Prelude.Text
generateEmbedUrlForAnonymousUserResponse_embedUrl :: Lens' GenerateEmbedUrlForAnonymousUserResponse Text
generateEmbedUrlForAnonymousUserResponse_embedUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUserResponse' {Sensitive Text
embedUrl :: Sensitive Text
$sel:embedUrl:GenerateEmbedUrlForAnonymousUserResponse' :: GenerateEmbedUrlForAnonymousUserResponse -> Sensitive Text
embedUrl} -> Sensitive Text
embedUrl) (\s :: GenerateEmbedUrlForAnonymousUserResponse
s@GenerateEmbedUrlForAnonymousUserResponse' {} Sensitive Text
a -> GenerateEmbedUrlForAnonymousUserResponse
s {$sel:embedUrl:GenerateEmbedUrlForAnonymousUserResponse' :: Sensitive Text
embedUrl = Sensitive Text
a} :: GenerateEmbedUrlForAnonymousUserResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

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

-- | The Amazon Resource Name (ARN) to use for the anonymous Amazon
-- QuickSight user.
generateEmbedUrlForAnonymousUserResponse_anonymousUserArn :: Lens.Lens' GenerateEmbedUrlForAnonymousUserResponse Prelude.Text
generateEmbedUrlForAnonymousUserResponse_anonymousUserArn :: Lens' GenerateEmbedUrlForAnonymousUserResponse Text
generateEmbedUrlForAnonymousUserResponse_anonymousUserArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GenerateEmbedUrlForAnonymousUserResponse' {Text
anonymousUserArn :: Text
$sel:anonymousUserArn:GenerateEmbedUrlForAnonymousUserResponse' :: GenerateEmbedUrlForAnonymousUserResponse -> Text
anonymousUserArn} -> Text
anonymousUserArn) (\s :: GenerateEmbedUrlForAnonymousUserResponse
s@GenerateEmbedUrlForAnonymousUserResponse' {} Text
a -> GenerateEmbedUrlForAnonymousUserResponse
s {$sel:anonymousUserArn:GenerateEmbedUrlForAnonymousUserResponse' :: Text
anonymousUserArn = Text
a} :: GenerateEmbedUrlForAnonymousUserResponse)

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