{-# 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.GetSessionEmbedUrl
-- 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 session URL and authorization code that you can use to embed
-- the Amazon Amazon QuickSight console in your web server code. Use
-- @GetSessionEmbedUrl@ where you want to provide an authoring portal that
-- allows users to create data sources, datasets, analyses, and dashboards.
-- The users who access an embedded Amazon QuickSight console need belong
-- to the author or admin security cohort. If you want to restrict
-- permissions to some of these features, add a custom permissions profile
-- to the user with the
-- @ @<https://docs.aws.amazon.com/quicksight/latest/APIReference/API_UpdateUser.html UpdateUser>@ @
-- API operation. Use
-- @ @<https://docs.aws.amazon.com/quicksight/latest/APIReference/API_RegisterUser.html RegisterUser>@ @
-- API operation to add a new user with a custom permission profile
-- attached. For more information, see the following sections in the
-- /Amazon QuickSight User Guide/:
--
-- -   <https://docs.aws.amazon.com/quicksight/latest/user/embedded-analytics.html Embedding Analytics>
--
-- -   <https://docs.aws.amazon.com/quicksight/latest/user/customizing-permissions-to-the-quicksight-console.html Customizing Access to the Amazon QuickSight Console>
module Amazonka.QuickSight.GetSessionEmbedUrl
  ( -- * Creating a Request
    GetSessionEmbedUrl (..),
    newGetSessionEmbedUrl,

    -- * Request Lenses
    getSessionEmbedUrl_entryPoint,
    getSessionEmbedUrl_sessionLifetimeInMinutes,
    getSessionEmbedUrl_userArn,
    getSessionEmbedUrl_awsAccountId,

    -- * Destructuring the Response
    GetSessionEmbedUrlResponse (..),
    newGetSessionEmbedUrlResponse,

    -- * Response Lenses
    getSessionEmbedUrlResponse_embedUrl,
    getSessionEmbedUrlResponse_requestId,
    getSessionEmbedUrlResponse_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:/ 'newGetSessionEmbedUrl' smart constructor.
data GetSessionEmbedUrl = GetSessionEmbedUrl'
  { -- | The URL you use to access the embedded session. The entry point URL is
    -- constrained to the following paths:
    --
    -- -   @\/start@
    --
    -- -   @\/start\/analyses@
    --
    -- -   @\/start\/dashboards@
    --
    -- -   @\/start\/favorites@
    --
    -- -   @\/dashboards\/@/@DashboardId@/@ @ - where @DashboardId@ is the
    --     actual ID key from the Amazon QuickSight console URL of the
    --     dashboard
    --
    -- -   @\/analyses\/@/@AnalysisId@/@ @ - where @AnalysisId@ is the actual
    --     ID key from the Amazon QuickSight console URL of the analysis
    GetSessionEmbedUrl -> Maybe Text
entryPoint :: Prelude.Maybe Prelude.Text,
    -- | How many minutes the session is valid. The session lifetime must be
    -- 15-600 minutes.
    GetSessionEmbedUrl -> Maybe Natural
sessionLifetimeInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon QuickSight user\'s Amazon Resource Name (ARN), for use with
    -- @QUICKSIGHT@ identity type. You can use this for any type of Amazon
    -- QuickSight users in your account (readers, authors, or admins). They
    -- need to be authenticated as one of the following:
    --
    -- 1.  Active Directory (AD) users or group members
    --
    -- 2.  Invited nonfederated users
    --
    -- 3.  Identity and Access Management (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.
    GetSessionEmbedUrl -> Maybe Text
userArn :: Prelude.Maybe Prelude.Text,
    -- | The ID for the Amazon Web Services account associated with your Amazon
    -- QuickSight subscription.
    GetSessionEmbedUrl -> Text
awsAccountId :: Prelude.Text
  }
  deriving (GetSessionEmbedUrl -> GetSessionEmbedUrl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSessionEmbedUrl -> GetSessionEmbedUrl -> Bool
$c/= :: GetSessionEmbedUrl -> GetSessionEmbedUrl -> Bool
== :: GetSessionEmbedUrl -> GetSessionEmbedUrl -> Bool
$c== :: GetSessionEmbedUrl -> GetSessionEmbedUrl -> Bool
Prelude.Eq, ReadPrec [GetSessionEmbedUrl]
ReadPrec GetSessionEmbedUrl
Int -> ReadS GetSessionEmbedUrl
ReadS [GetSessionEmbedUrl]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSessionEmbedUrl]
$creadListPrec :: ReadPrec [GetSessionEmbedUrl]
readPrec :: ReadPrec GetSessionEmbedUrl
$creadPrec :: ReadPrec GetSessionEmbedUrl
readList :: ReadS [GetSessionEmbedUrl]
$creadList :: ReadS [GetSessionEmbedUrl]
readsPrec :: Int -> ReadS GetSessionEmbedUrl
$creadsPrec :: Int -> ReadS GetSessionEmbedUrl
Prelude.Read, Int -> GetSessionEmbedUrl -> ShowS
[GetSessionEmbedUrl] -> ShowS
GetSessionEmbedUrl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSessionEmbedUrl] -> ShowS
$cshowList :: [GetSessionEmbedUrl] -> ShowS
show :: GetSessionEmbedUrl -> String
$cshow :: GetSessionEmbedUrl -> String
showsPrec :: Int -> GetSessionEmbedUrl -> ShowS
$cshowsPrec :: Int -> GetSessionEmbedUrl -> ShowS
Prelude.Show, forall x. Rep GetSessionEmbedUrl x -> GetSessionEmbedUrl
forall x. GetSessionEmbedUrl -> Rep GetSessionEmbedUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSessionEmbedUrl x -> GetSessionEmbedUrl
$cfrom :: forall x. GetSessionEmbedUrl -> Rep GetSessionEmbedUrl x
Prelude.Generic)

-- |
-- Create a value of 'GetSessionEmbedUrl' 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:
--
-- 'entryPoint', 'getSessionEmbedUrl_entryPoint' - The URL you use to access the embedded session. The entry point URL is
-- constrained to the following paths:
--
-- -   @\/start@
--
-- -   @\/start\/analyses@
--
-- -   @\/start\/dashboards@
--
-- -   @\/start\/favorites@
--
-- -   @\/dashboards\/@/@DashboardId@/@ @ - where @DashboardId@ is the
--     actual ID key from the Amazon QuickSight console URL of the
--     dashboard
--
-- -   @\/analyses\/@/@AnalysisId@/@ @ - where @AnalysisId@ is the actual
--     ID key from the Amazon QuickSight console URL of the analysis
--
-- 'sessionLifetimeInMinutes', 'getSessionEmbedUrl_sessionLifetimeInMinutes' - How many minutes the session is valid. The session lifetime must be
-- 15-600 minutes.
--
-- 'userArn', 'getSessionEmbedUrl_userArn' - The Amazon QuickSight user\'s Amazon Resource Name (ARN), for use with
-- @QUICKSIGHT@ identity type. You can use this for any type of Amazon
-- QuickSight users in your account (readers, authors, or admins). They
-- need to be authenticated as one of the following:
--
-- 1.  Active Directory (AD) users or group members
--
-- 2.  Invited nonfederated users
--
-- 3.  Identity and Access Management (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', 'getSessionEmbedUrl_awsAccountId' - The ID for the Amazon Web Services account associated with your Amazon
-- QuickSight subscription.
newGetSessionEmbedUrl ::
  -- | 'awsAccountId'
  Prelude.Text ->
  GetSessionEmbedUrl
newGetSessionEmbedUrl :: Text -> GetSessionEmbedUrl
newGetSessionEmbedUrl Text
pAwsAccountId_ =
  GetSessionEmbedUrl'
    { $sel:entryPoint:GetSessionEmbedUrl' :: Maybe Text
entryPoint = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionLifetimeInMinutes:GetSessionEmbedUrl' :: Maybe Natural
sessionLifetimeInMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:userArn:GetSessionEmbedUrl' :: Maybe Text
userArn = forall a. Maybe a
Prelude.Nothing,
      $sel:awsAccountId:GetSessionEmbedUrl' :: Text
awsAccountId = Text
pAwsAccountId_
    }

-- | The URL you use to access the embedded session. The entry point URL is
-- constrained to the following paths:
--
-- -   @\/start@
--
-- -   @\/start\/analyses@
--
-- -   @\/start\/dashboards@
--
-- -   @\/start\/favorites@
--
-- -   @\/dashboards\/@/@DashboardId@/@ @ - where @DashboardId@ is the
--     actual ID key from the Amazon QuickSight console URL of the
--     dashboard
--
-- -   @\/analyses\/@/@AnalysisId@/@ @ - where @AnalysisId@ is the actual
--     ID key from the Amazon QuickSight console URL of the analysis
getSessionEmbedUrl_entryPoint :: Lens.Lens' GetSessionEmbedUrl (Prelude.Maybe Prelude.Text)
getSessionEmbedUrl_entryPoint :: Lens' GetSessionEmbedUrl (Maybe Text)
getSessionEmbedUrl_entryPoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionEmbedUrl' {Maybe Text
entryPoint :: Maybe Text
$sel:entryPoint:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
entryPoint} -> Maybe Text
entryPoint) (\s :: GetSessionEmbedUrl
s@GetSessionEmbedUrl' {} Maybe Text
a -> GetSessionEmbedUrl
s {$sel:entryPoint:GetSessionEmbedUrl' :: Maybe Text
entryPoint = Maybe Text
a} :: GetSessionEmbedUrl)

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

-- | The Amazon QuickSight user\'s Amazon Resource Name (ARN), for use with
-- @QUICKSIGHT@ identity type. You can use this for any type of Amazon
-- QuickSight users in your account (readers, authors, or admins). They
-- need to be authenticated as one of the following:
--
-- 1.  Active Directory (AD) users or group members
--
-- 2.  Invited nonfederated users
--
-- 3.  Identity and Access Management (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.
getSessionEmbedUrl_userArn :: Lens.Lens' GetSessionEmbedUrl (Prelude.Maybe Prelude.Text)
getSessionEmbedUrl_userArn :: Lens' GetSessionEmbedUrl (Maybe Text)
getSessionEmbedUrl_userArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionEmbedUrl' {Maybe Text
userArn :: Maybe Text
$sel:userArn:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
userArn} -> Maybe Text
userArn) (\s :: GetSessionEmbedUrl
s@GetSessionEmbedUrl' {} Maybe Text
a -> GetSessionEmbedUrl
s {$sel:userArn:GetSessionEmbedUrl' :: Maybe Text
userArn = Maybe Text
a} :: GetSessionEmbedUrl)

-- | The ID for the Amazon Web Services account associated with your Amazon
-- QuickSight subscription.
getSessionEmbedUrl_awsAccountId :: Lens.Lens' GetSessionEmbedUrl Prelude.Text
getSessionEmbedUrl_awsAccountId :: Lens' GetSessionEmbedUrl Text
getSessionEmbedUrl_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionEmbedUrl' {Text
awsAccountId :: Text
$sel:awsAccountId:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Text
awsAccountId} -> Text
awsAccountId) (\s :: GetSessionEmbedUrl
s@GetSessionEmbedUrl' {} Text
a -> GetSessionEmbedUrl
s {$sel:awsAccountId:GetSessionEmbedUrl' :: Text
awsAccountId = Text
a} :: GetSessionEmbedUrl)

instance Core.AWSRequest GetSessionEmbedUrl where
  type
    AWSResponse GetSessionEmbedUrl =
      GetSessionEmbedUrlResponse
  request :: (Service -> Service)
-> GetSessionEmbedUrl -> Request GetSessionEmbedUrl
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 GetSessionEmbedUrl
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSessionEmbedUrl)))
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 -> GetSessionEmbedUrlResponse
GetSessionEmbedUrlResponse'
            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 GetSessionEmbedUrl where
  hashWithSalt :: Int -> GetSessionEmbedUrl -> Int
hashWithSalt Int
_salt GetSessionEmbedUrl' {Maybe Natural
Maybe Text
Text
awsAccountId :: Text
userArn :: Maybe Text
sessionLifetimeInMinutes :: Maybe Natural
entryPoint :: Maybe Text
$sel:awsAccountId:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Text
$sel:userArn:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
$sel:sessionLifetimeInMinutes:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Natural
$sel:entryPoint:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
entryPoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
sessionLifetimeInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId

instance Prelude.NFData GetSessionEmbedUrl where
  rnf :: GetSessionEmbedUrl -> ()
rnf GetSessionEmbedUrl' {Maybe Natural
Maybe Text
Text
awsAccountId :: Text
userArn :: Maybe Text
sessionLifetimeInMinutes :: Maybe Natural
entryPoint :: Maybe Text
$sel:awsAccountId:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Text
$sel:userArn:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
$sel:sessionLifetimeInMinutes:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Natural
$sel:entryPoint:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
entryPoint
      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 Text
userArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId

instance Data.ToHeaders GetSessionEmbedUrl where
  toHeaders :: GetSessionEmbedUrl -> 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 GetSessionEmbedUrl where
  toPath :: GetSessionEmbedUrl -> ByteString
toPath GetSessionEmbedUrl' {Maybe Natural
Maybe Text
Text
awsAccountId :: Text
userArn :: Maybe Text
sessionLifetimeInMinutes :: Maybe Natural
entryPoint :: Maybe Text
$sel:awsAccountId:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Text
$sel:userArn:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
$sel:sessionLifetimeInMinutes:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Natural
$sel:entryPoint:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
awsAccountId,
        ByteString
"/session-embed-url"
      ]

instance Data.ToQuery GetSessionEmbedUrl where
  toQuery :: GetSessionEmbedUrl -> QueryString
toQuery GetSessionEmbedUrl' {Maybe Natural
Maybe Text
Text
awsAccountId :: Text
userArn :: Maybe Text
sessionLifetimeInMinutes :: Maybe Natural
entryPoint :: Maybe Text
$sel:awsAccountId:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Text
$sel:userArn:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
$sel:sessionLifetimeInMinutes:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Natural
$sel:entryPoint:GetSessionEmbedUrl' :: GetSessionEmbedUrl -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"entry-point" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
entryPoint,
        ByteString
"session-lifetime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
sessionLifetimeInMinutes,
        ByteString
"user-arn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
userArn
      ]

-- | /See:/ 'newGetSessionEmbedUrlResponse' smart constructor.
data GetSessionEmbedUrlResponse = GetSessionEmbedUrlResponse'
  { -- | A single-use URL that you can put into your server-side web page to
    -- embed your Amazon QuickSight session. 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.
    GetSessionEmbedUrlResponse -> Maybe (Sensitive Text)
embedUrl :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Web Services request ID for this operation.
    GetSessionEmbedUrlResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The HTTP status of the request.
    GetSessionEmbedUrlResponse -> Int
status :: Prelude.Int
  }
  deriving (GetSessionEmbedUrlResponse -> GetSessionEmbedUrlResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSessionEmbedUrlResponse -> GetSessionEmbedUrlResponse -> Bool
$c/= :: GetSessionEmbedUrlResponse -> GetSessionEmbedUrlResponse -> Bool
== :: GetSessionEmbedUrlResponse -> GetSessionEmbedUrlResponse -> Bool
$c== :: GetSessionEmbedUrlResponse -> GetSessionEmbedUrlResponse -> Bool
Prelude.Eq, Int -> GetSessionEmbedUrlResponse -> ShowS
[GetSessionEmbedUrlResponse] -> ShowS
GetSessionEmbedUrlResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSessionEmbedUrlResponse] -> ShowS
$cshowList :: [GetSessionEmbedUrlResponse] -> ShowS
show :: GetSessionEmbedUrlResponse -> String
$cshow :: GetSessionEmbedUrlResponse -> String
showsPrec :: Int -> GetSessionEmbedUrlResponse -> ShowS
$cshowsPrec :: Int -> GetSessionEmbedUrlResponse -> ShowS
Prelude.Show, forall x.
Rep GetSessionEmbedUrlResponse x -> GetSessionEmbedUrlResponse
forall x.
GetSessionEmbedUrlResponse -> Rep GetSessionEmbedUrlResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSessionEmbedUrlResponse x -> GetSessionEmbedUrlResponse
$cfrom :: forall x.
GetSessionEmbedUrlResponse -> Rep GetSessionEmbedUrlResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSessionEmbedUrlResponse' 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', 'getSessionEmbedUrlResponse_embedUrl' - A single-use URL that you can put into your server-side web page to
-- embed your Amazon QuickSight session. 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', 'getSessionEmbedUrlResponse_requestId' - The Amazon Web Services request ID for this operation.
--
-- 'status', 'getSessionEmbedUrlResponse_status' - The HTTP status of the request.
newGetSessionEmbedUrlResponse ::
  -- | 'status'
  Prelude.Int ->
  GetSessionEmbedUrlResponse
newGetSessionEmbedUrlResponse :: Int -> GetSessionEmbedUrlResponse
newGetSessionEmbedUrlResponse Int
pStatus_ =
  GetSessionEmbedUrlResponse'
    { $sel:embedUrl:GetSessionEmbedUrlResponse' :: Maybe (Sensitive Text)
embedUrl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:GetSessionEmbedUrlResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetSessionEmbedUrlResponse' :: Int
status = Int
pStatus_
    }

-- | A single-use URL that you can put into your server-side web page to
-- embed your Amazon QuickSight session. 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.
getSessionEmbedUrlResponse_embedUrl :: Lens.Lens' GetSessionEmbedUrlResponse (Prelude.Maybe Prelude.Text)
getSessionEmbedUrlResponse_embedUrl :: Lens' GetSessionEmbedUrlResponse (Maybe Text)
getSessionEmbedUrlResponse_embedUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionEmbedUrlResponse' {Maybe (Sensitive Text)
embedUrl :: Maybe (Sensitive Text)
$sel:embedUrl:GetSessionEmbedUrlResponse' :: GetSessionEmbedUrlResponse -> Maybe (Sensitive Text)
embedUrl} -> Maybe (Sensitive Text)
embedUrl) (\s :: GetSessionEmbedUrlResponse
s@GetSessionEmbedUrlResponse' {} Maybe (Sensitive Text)
a -> GetSessionEmbedUrlResponse
s {$sel:embedUrl:GetSessionEmbedUrlResponse' :: Maybe (Sensitive Text)
embedUrl = Maybe (Sensitive Text)
a} :: GetSessionEmbedUrlResponse) 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.
getSessionEmbedUrlResponse_requestId :: Lens.Lens' GetSessionEmbedUrlResponse (Prelude.Maybe Prelude.Text)
getSessionEmbedUrlResponse_requestId :: Lens' GetSessionEmbedUrlResponse (Maybe Text)
getSessionEmbedUrlResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSessionEmbedUrlResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:GetSessionEmbedUrlResponse' :: GetSessionEmbedUrlResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: GetSessionEmbedUrlResponse
s@GetSessionEmbedUrlResponse' {} Maybe Text
a -> GetSessionEmbedUrlResponse
s {$sel:requestId:GetSessionEmbedUrlResponse' :: Maybe Text
requestId = Maybe Text
a} :: GetSessionEmbedUrlResponse)

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

instance Prelude.NFData GetSessionEmbedUrlResponse where
  rnf :: GetSessionEmbedUrlResponse -> ()
rnf GetSessionEmbedUrlResponse' {Int
Maybe Text
Maybe (Sensitive Text)
status :: Int
requestId :: Maybe Text
embedUrl :: Maybe (Sensitive Text)
$sel:status:GetSessionEmbedUrlResponse' :: GetSessionEmbedUrlResponse -> Int
$sel:requestId:GetSessionEmbedUrlResponse' :: GetSessionEmbedUrlResponse -> Maybe Text
$sel:embedUrl:GetSessionEmbedUrlResponse' :: GetSessionEmbedUrlResponse -> 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