{-# 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.AppStream.CreateStreamingURL
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a temporary URL to start an AppStream 2.0 streaming session for
-- the specified user. A streaming URL enables application streaming to be
-- tested without user setup.
module Amazonka.AppStream.CreateStreamingURL
  ( -- * Creating a Request
    CreateStreamingURL (..),
    newCreateStreamingURL,

    -- * Request Lenses
    createStreamingURL_applicationId,
    createStreamingURL_sessionContext,
    createStreamingURL_validity,
    createStreamingURL_stackName,
    createStreamingURL_fleetName,
    createStreamingURL_userId,

    -- * Destructuring the Response
    CreateStreamingURLResponse (..),
    newCreateStreamingURLResponse,

    -- * Response Lenses
    createStreamingURLResponse_expires,
    createStreamingURLResponse_streamingURL,
    createStreamingURLResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateStreamingURL' smart constructor.
data CreateStreamingURL = CreateStreamingURL'
  { -- | The name of the application to launch after the session starts. This is
    -- the name that you specified as __Name__ in the Image Assistant. If your
    -- fleet is enabled for the __Desktop__ stream view, you can also choose to
    -- launch directly to the operating system desktop. To do so, specify
    -- __Desktop__.
    CreateStreamingURL -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    -- | The session context. For more information, see
    -- <https://docs.aws.amazon.com/appstream2/latest/developerguide/managing-stacks-fleets.html#managing-stacks-fleets-parameters Session Context>
    -- in the /Amazon AppStream 2.0 Administration Guide/.
    CreateStreamingURL -> Maybe Text
sessionContext :: Prelude.Maybe Prelude.Text,
    -- | The time that the streaming URL will be valid, in seconds. Specify a
    -- value between 1 and 604800 seconds. The default is 60 seconds.
    CreateStreamingURL -> Maybe Integer
validity :: Prelude.Maybe Prelude.Integer,
    -- | The name of the stack.
    CreateStreamingURL -> Text
stackName :: Prelude.Text,
    -- | The name of the fleet.
    CreateStreamingURL -> Text
fleetName :: Prelude.Text,
    -- | The identifier of the user.
    CreateStreamingURL -> Text
userId :: Prelude.Text
  }
  deriving (CreateStreamingURL -> CreateStreamingURL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStreamingURL -> CreateStreamingURL -> Bool
$c/= :: CreateStreamingURL -> CreateStreamingURL -> Bool
== :: CreateStreamingURL -> CreateStreamingURL -> Bool
$c== :: CreateStreamingURL -> CreateStreamingURL -> Bool
Prelude.Eq, ReadPrec [CreateStreamingURL]
ReadPrec CreateStreamingURL
Int -> ReadS CreateStreamingURL
ReadS [CreateStreamingURL]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStreamingURL]
$creadListPrec :: ReadPrec [CreateStreamingURL]
readPrec :: ReadPrec CreateStreamingURL
$creadPrec :: ReadPrec CreateStreamingURL
readList :: ReadS [CreateStreamingURL]
$creadList :: ReadS [CreateStreamingURL]
readsPrec :: Int -> ReadS CreateStreamingURL
$creadsPrec :: Int -> ReadS CreateStreamingURL
Prelude.Read, Int -> CreateStreamingURL -> ShowS
[CreateStreamingURL] -> ShowS
CreateStreamingURL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStreamingURL] -> ShowS
$cshowList :: [CreateStreamingURL] -> ShowS
show :: CreateStreamingURL -> String
$cshow :: CreateStreamingURL -> String
showsPrec :: Int -> CreateStreamingURL -> ShowS
$cshowsPrec :: Int -> CreateStreamingURL -> ShowS
Prelude.Show, forall x. Rep CreateStreamingURL x -> CreateStreamingURL
forall x. CreateStreamingURL -> Rep CreateStreamingURL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStreamingURL x -> CreateStreamingURL
$cfrom :: forall x. CreateStreamingURL -> Rep CreateStreamingURL x
Prelude.Generic)

-- |
-- Create a value of 'CreateStreamingURL' 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:
--
-- 'applicationId', 'createStreamingURL_applicationId' - The name of the application to launch after the session starts. This is
-- the name that you specified as __Name__ in the Image Assistant. If your
-- fleet is enabled for the __Desktop__ stream view, you can also choose to
-- launch directly to the operating system desktop. To do so, specify
-- __Desktop__.
--
-- 'sessionContext', 'createStreamingURL_sessionContext' - The session context. For more information, see
-- <https://docs.aws.amazon.com/appstream2/latest/developerguide/managing-stacks-fleets.html#managing-stacks-fleets-parameters Session Context>
-- in the /Amazon AppStream 2.0 Administration Guide/.
--
-- 'validity', 'createStreamingURL_validity' - The time that the streaming URL will be valid, in seconds. Specify a
-- value between 1 and 604800 seconds. The default is 60 seconds.
--
-- 'stackName', 'createStreamingURL_stackName' - The name of the stack.
--
-- 'fleetName', 'createStreamingURL_fleetName' - The name of the fleet.
--
-- 'userId', 'createStreamingURL_userId' - The identifier of the user.
newCreateStreamingURL ::
  -- | 'stackName'
  Prelude.Text ->
  -- | 'fleetName'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  CreateStreamingURL
newCreateStreamingURL :: Text -> Text -> Text -> CreateStreamingURL
newCreateStreamingURL
  Text
pStackName_
  Text
pFleetName_
  Text
pUserId_ =
    CreateStreamingURL'
      { $sel:applicationId:CreateStreamingURL' :: Maybe Text
applicationId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sessionContext:CreateStreamingURL' :: Maybe Text
sessionContext = forall a. Maybe a
Prelude.Nothing,
        $sel:validity:CreateStreamingURL' :: Maybe Integer
validity = forall a. Maybe a
Prelude.Nothing,
        $sel:stackName:CreateStreamingURL' :: Text
stackName = Text
pStackName_,
        $sel:fleetName:CreateStreamingURL' :: Text
fleetName = Text
pFleetName_,
        $sel:userId:CreateStreamingURL' :: Text
userId = Text
pUserId_
      }

-- | The name of the application to launch after the session starts. This is
-- the name that you specified as __Name__ in the Image Assistant. If your
-- fleet is enabled for the __Desktop__ stream view, you can also choose to
-- launch directly to the operating system desktop. To do so, specify
-- __Desktop__.
createStreamingURL_applicationId :: Lens.Lens' CreateStreamingURL (Prelude.Maybe Prelude.Text)
createStreamingURL_applicationId :: Lens' CreateStreamingURL (Maybe Text)
createStreamingURL_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURL' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: CreateStreamingURL
s@CreateStreamingURL' {} Maybe Text
a -> CreateStreamingURL
s {$sel:applicationId:CreateStreamingURL' :: Maybe Text
applicationId = Maybe Text
a} :: CreateStreamingURL)

-- | The session context. For more information, see
-- <https://docs.aws.amazon.com/appstream2/latest/developerguide/managing-stacks-fleets.html#managing-stacks-fleets-parameters Session Context>
-- in the /Amazon AppStream 2.0 Administration Guide/.
createStreamingURL_sessionContext :: Lens.Lens' CreateStreamingURL (Prelude.Maybe Prelude.Text)
createStreamingURL_sessionContext :: Lens' CreateStreamingURL (Maybe Text)
createStreamingURL_sessionContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURL' {Maybe Text
sessionContext :: Maybe Text
$sel:sessionContext:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
sessionContext} -> Maybe Text
sessionContext) (\s :: CreateStreamingURL
s@CreateStreamingURL' {} Maybe Text
a -> CreateStreamingURL
s {$sel:sessionContext:CreateStreamingURL' :: Maybe Text
sessionContext = Maybe Text
a} :: CreateStreamingURL)

-- | The time that the streaming URL will be valid, in seconds. Specify a
-- value between 1 and 604800 seconds. The default is 60 seconds.
createStreamingURL_validity :: Lens.Lens' CreateStreamingURL (Prelude.Maybe Prelude.Integer)
createStreamingURL_validity :: Lens' CreateStreamingURL (Maybe Integer)
createStreamingURL_validity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURL' {Maybe Integer
validity :: Maybe Integer
$sel:validity:CreateStreamingURL' :: CreateStreamingURL -> Maybe Integer
validity} -> Maybe Integer
validity) (\s :: CreateStreamingURL
s@CreateStreamingURL' {} Maybe Integer
a -> CreateStreamingURL
s {$sel:validity:CreateStreamingURL' :: Maybe Integer
validity = Maybe Integer
a} :: CreateStreamingURL)

-- | The name of the stack.
createStreamingURL_stackName :: Lens.Lens' CreateStreamingURL Prelude.Text
createStreamingURL_stackName :: Lens' CreateStreamingURL Text
createStreamingURL_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURL' {Text
stackName :: Text
$sel:stackName:CreateStreamingURL' :: CreateStreamingURL -> Text
stackName} -> Text
stackName) (\s :: CreateStreamingURL
s@CreateStreamingURL' {} Text
a -> CreateStreamingURL
s {$sel:stackName:CreateStreamingURL' :: Text
stackName = Text
a} :: CreateStreamingURL)

-- | The name of the fleet.
createStreamingURL_fleetName :: Lens.Lens' CreateStreamingURL Prelude.Text
createStreamingURL_fleetName :: Lens' CreateStreamingURL Text
createStreamingURL_fleetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURL' {Text
fleetName :: Text
$sel:fleetName:CreateStreamingURL' :: CreateStreamingURL -> Text
fleetName} -> Text
fleetName) (\s :: CreateStreamingURL
s@CreateStreamingURL' {} Text
a -> CreateStreamingURL
s {$sel:fleetName:CreateStreamingURL' :: Text
fleetName = Text
a} :: CreateStreamingURL)

-- | The identifier of the user.
createStreamingURL_userId :: Lens.Lens' CreateStreamingURL Prelude.Text
createStreamingURL_userId :: Lens' CreateStreamingURL Text
createStreamingURL_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURL' {Text
userId :: Text
$sel:userId:CreateStreamingURL' :: CreateStreamingURL -> Text
userId} -> Text
userId) (\s :: CreateStreamingURL
s@CreateStreamingURL' {} Text
a -> CreateStreamingURL
s {$sel:userId:CreateStreamingURL' :: Text
userId = Text
a} :: CreateStreamingURL)

instance Core.AWSRequest CreateStreamingURL where
  type
    AWSResponse CreateStreamingURL =
      CreateStreamingURLResponse
  request :: (Service -> Service)
-> CreateStreamingURL -> Request CreateStreamingURL
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 CreateStreamingURL
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateStreamingURL)))
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 POSIX -> Maybe Text -> Int -> CreateStreamingURLResponse
CreateStreamingURLResponse'
            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
"Expires")
            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
"StreamingURL")
            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 CreateStreamingURL where
  hashWithSalt :: Int -> CreateStreamingURL -> Int
hashWithSalt Int
_salt CreateStreamingURL' {Maybe Integer
Maybe Text
Text
userId :: Text
fleetName :: Text
stackName :: Text
validity :: Maybe Integer
sessionContext :: Maybe Text
applicationId :: Maybe Text
$sel:userId:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:fleetName:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:stackName:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:validity:CreateStreamingURL' :: CreateStreamingURL -> Maybe Integer
$sel:sessionContext:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
$sel:applicationId:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sessionContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
validity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId

instance Prelude.NFData CreateStreamingURL where
  rnf :: CreateStreamingURL -> ()
rnf CreateStreamingURL' {Maybe Integer
Maybe Text
Text
userId :: Text
fleetName :: Text
stackName :: Text
validity :: Maybe Integer
sessionContext :: Maybe Text
applicationId :: Maybe Text
$sel:userId:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:fleetName:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:stackName:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:validity:CreateStreamingURL' :: CreateStreamingURL -> Maybe Integer
$sel:sessionContext:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
$sel:applicationId:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
validity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fleetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId

instance Data.ToHeaders CreateStreamingURL where
  toHeaders :: CreateStreamingURL -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"PhotonAdminProxyService.CreateStreamingURL" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateStreamingURL where
  toJSON :: CreateStreamingURL -> Value
toJSON CreateStreamingURL' {Maybe Integer
Maybe Text
Text
userId :: Text
fleetName :: Text
stackName :: Text
validity :: Maybe Integer
sessionContext :: Maybe Text
applicationId :: Maybe Text
$sel:userId:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:fleetName:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:stackName:CreateStreamingURL' :: CreateStreamingURL -> Text
$sel:validity:CreateStreamingURL' :: CreateStreamingURL -> Maybe Integer
$sel:sessionContext:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
$sel:applicationId:CreateStreamingURL' :: CreateStreamingURL -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ApplicationId" 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
applicationId,
            (Key
"SessionContext" 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
sessionContext,
            (Key
"Validity" 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 Integer
validity,
            forall a. a -> Maybe a
Prelude.Just (Key
"StackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackName),
            forall a. a -> Maybe a
Prelude.Just (Key
"FleetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
fleetName),
            forall a. a -> Maybe a
Prelude.Just (Key
"UserId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userId)
          ]
      )

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

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

-- | /See:/ 'newCreateStreamingURLResponse' smart constructor.
data CreateStreamingURLResponse = CreateStreamingURLResponse'
  { -- | The elapsed time, in seconds after the Unix epoch, when this URL
    -- expires.
    CreateStreamingURLResponse -> Maybe POSIX
expires :: Prelude.Maybe Data.POSIX,
    -- | The URL to start the AppStream 2.0 streaming session.
    CreateStreamingURLResponse -> Maybe Text
streamingURL :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateStreamingURLResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateStreamingURLResponse -> CreateStreamingURLResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStreamingURLResponse -> CreateStreamingURLResponse -> Bool
$c/= :: CreateStreamingURLResponse -> CreateStreamingURLResponse -> Bool
== :: CreateStreamingURLResponse -> CreateStreamingURLResponse -> Bool
$c== :: CreateStreamingURLResponse -> CreateStreamingURLResponse -> Bool
Prelude.Eq, ReadPrec [CreateStreamingURLResponse]
ReadPrec CreateStreamingURLResponse
Int -> ReadS CreateStreamingURLResponse
ReadS [CreateStreamingURLResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStreamingURLResponse]
$creadListPrec :: ReadPrec [CreateStreamingURLResponse]
readPrec :: ReadPrec CreateStreamingURLResponse
$creadPrec :: ReadPrec CreateStreamingURLResponse
readList :: ReadS [CreateStreamingURLResponse]
$creadList :: ReadS [CreateStreamingURLResponse]
readsPrec :: Int -> ReadS CreateStreamingURLResponse
$creadsPrec :: Int -> ReadS CreateStreamingURLResponse
Prelude.Read, Int -> CreateStreamingURLResponse -> ShowS
[CreateStreamingURLResponse] -> ShowS
CreateStreamingURLResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStreamingURLResponse] -> ShowS
$cshowList :: [CreateStreamingURLResponse] -> ShowS
show :: CreateStreamingURLResponse -> String
$cshow :: CreateStreamingURLResponse -> String
showsPrec :: Int -> CreateStreamingURLResponse -> ShowS
$cshowsPrec :: Int -> CreateStreamingURLResponse -> ShowS
Prelude.Show, forall x.
Rep CreateStreamingURLResponse x -> CreateStreamingURLResponse
forall x.
CreateStreamingURLResponse -> Rep CreateStreamingURLResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateStreamingURLResponse x -> CreateStreamingURLResponse
$cfrom :: forall x.
CreateStreamingURLResponse -> Rep CreateStreamingURLResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateStreamingURLResponse' 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:
--
-- 'expires', 'createStreamingURLResponse_expires' - The elapsed time, in seconds after the Unix epoch, when this URL
-- expires.
--
-- 'streamingURL', 'createStreamingURLResponse_streamingURL' - The URL to start the AppStream 2.0 streaming session.
--
-- 'httpStatus', 'createStreamingURLResponse_httpStatus' - The response's http status code.
newCreateStreamingURLResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateStreamingURLResponse
newCreateStreamingURLResponse :: Int -> CreateStreamingURLResponse
newCreateStreamingURLResponse Int
pHttpStatus_ =
  CreateStreamingURLResponse'
    { $sel:expires:CreateStreamingURLResponse' :: Maybe POSIX
expires =
        forall a. Maybe a
Prelude.Nothing,
      $sel:streamingURL:CreateStreamingURLResponse' :: Maybe Text
streamingURL = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateStreamingURLResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The elapsed time, in seconds after the Unix epoch, when this URL
-- expires.
createStreamingURLResponse_expires :: Lens.Lens' CreateStreamingURLResponse (Prelude.Maybe Prelude.UTCTime)
createStreamingURLResponse_expires :: Lens' CreateStreamingURLResponse (Maybe UTCTime)
createStreamingURLResponse_expires = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURLResponse' {Maybe POSIX
expires :: Maybe POSIX
$sel:expires:CreateStreamingURLResponse' :: CreateStreamingURLResponse -> Maybe POSIX
expires} -> Maybe POSIX
expires) (\s :: CreateStreamingURLResponse
s@CreateStreamingURLResponse' {} Maybe POSIX
a -> CreateStreamingURLResponse
s {$sel:expires:CreateStreamingURLResponse' :: Maybe POSIX
expires = Maybe POSIX
a} :: CreateStreamingURLResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The URL to start the AppStream 2.0 streaming session.
createStreamingURLResponse_streamingURL :: Lens.Lens' CreateStreamingURLResponse (Prelude.Maybe Prelude.Text)
createStreamingURLResponse_streamingURL :: Lens' CreateStreamingURLResponse (Maybe Text)
createStreamingURLResponse_streamingURL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStreamingURLResponse' {Maybe Text
streamingURL :: Maybe Text
$sel:streamingURL:CreateStreamingURLResponse' :: CreateStreamingURLResponse -> Maybe Text
streamingURL} -> Maybe Text
streamingURL) (\s :: CreateStreamingURLResponse
s@CreateStreamingURLResponse' {} Maybe Text
a -> CreateStreamingURLResponse
s {$sel:streamingURL:CreateStreamingURLResponse' :: Maybe Text
streamingURL = Maybe Text
a} :: CreateStreamingURLResponse)

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

instance Prelude.NFData CreateStreamingURLResponse where
  rnf :: CreateStreamingURLResponse -> ()
rnf CreateStreamingURLResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
streamingURL :: Maybe Text
expires :: Maybe POSIX
$sel:httpStatus:CreateStreamingURLResponse' :: CreateStreamingURLResponse -> Int
$sel:streamingURL:CreateStreamingURLResponse' :: CreateStreamingURLResponse -> Maybe Text
$sel:expires:CreateStreamingURLResponse' :: CreateStreamingURLResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
expires
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamingURL
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus