{-# 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.Nimble.ListStreamingSessionBackups
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the backups of a streaming session in a studio.
--
-- This operation returns paginated results.
module Amazonka.Nimble.ListStreamingSessionBackups
  ( -- * Creating a Request
    ListStreamingSessionBackups (..),
    newListStreamingSessionBackups,

    -- * Request Lenses
    listStreamingSessionBackups_nextToken,
    listStreamingSessionBackups_ownedBy,
    listStreamingSessionBackups_studioId,

    -- * Destructuring the Response
    ListStreamingSessionBackupsResponse (..),
    newListStreamingSessionBackupsResponse,

    -- * Response Lenses
    listStreamingSessionBackupsResponse_nextToken,
    listStreamingSessionBackupsResponse_streamingSessionBackups,
    listStreamingSessionBackupsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListStreamingSessionBackups' smart constructor.
data ListStreamingSessionBackups = ListStreamingSessionBackups'
  { -- | The token for the next set of results, or null if there are no more
    -- results.
    ListStreamingSessionBackups -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The user ID of the user that owns the streaming session.
    ListStreamingSessionBackups -> Maybe Text
ownedBy :: Prelude.Maybe Prelude.Text,
    -- | The studio ID.
    ListStreamingSessionBackups -> Text
studioId :: Prelude.Text
  }
  deriving (ListStreamingSessionBackups -> ListStreamingSessionBackups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStreamingSessionBackups -> ListStreamingSessionBackups -> Bool
$c/= :: ListStreamingSessionBackups -> ListStreamingSessionBackups -> Bool
== :: ListStreamingSessionBackups -> ListStreamingSessionBackups -> Bool
$c== :: ListStreamingSessionBackups -> ListStreamingSessionBackups -> Bool
Prelude.Eq, ReadPrec [ListStreamingSessionBackups]
ReadPrec ListStreamingSessionBackups
Int -> ReadS ListStreamingSessionBackups
ReadS [ListStreamingSessionBackups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStreamingSessionBackups]
$creadListPrec :: ReadPrec [ListStreamingSessionBackups]
readPrec :: ReadPrec ListStreamingSessionBackups
$creadPrec :: ReadPrec ListStreamingSessionBackups
readList :: ReadS [ListStreamingSessionBackups]
$creadList :: ReadS [ListStreamingSessionBackups]
readsPrec :: Int -> ReadS ListStreamingSessionBackups
$creadsPrec :: Int -> ReadS ListStreamingSessionBackups
Prelude.Read, Int -> ListStreamingSessionBackups -> ShowS
[ListStreamingSessionBackups] -> ShowS
ListStreamingSessionBackups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStreamingSessionBackups] -> ShowS
$cshowList :: [ListStreamingSessionBackups] -> ShowS
show :: ListStreamingSessionBackups -> String
$cshow :: ListStreamingSessionBackups -> String
showsPrec :: Int -> ListStreamingSessionBackups -> ShowS
$cshowsPrec :: Int -> ListStreamingSessionBackups -> ShowS
Prelude.Show, forall x.
Rep ListStreamingSessionBackups x -> ListStreamingSessionBackups
forall x.
ListStreamingSessionBackups -> Rep ListStreamingSessionBackups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListStreamingSessionBackups x -> ListStreamingSessionBackups
$cfrom :: forall x.
ListStreamingSessionBackups -> Rep ListStreamingSessionBackups x
Prelude.Generic)

-- |
-- Create a value of 'ListStreamingSessionBackups' 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:
--
-- 'nextToken', 'listStreamingSessionBackups_nextToken' - The token for the next set of results, or null if there are no more
-- results.
--
-- 'ownedBy', 'listStreamingSessionBackups_ownedBy' - The user ID of the user that owns the streaming session.
--
-- 'studioId', 'listStreamingSessionBackups_studioId' - The studio ID.
newListStreamingSessionBackups ::
  -- | 'studioId'
  Prelude.Text ->
  ListStreamingSessionBackups
newListStreamingSessionBackups :: Text -> ListStreamingSessionBackups
newListStreamingSessionBackups Text
pStudioId_ =
  ListStreamingSessionBackups'
    { $sel:nextToken:ListStreamingSessionBackups' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:ownedBy:ListStreamingSessionBackups' :: Maybe Text
ownedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:studioId:ListStreamingSessionBackups' :: Text
studioId = Text
pStudioId_
    }

-- | The token for the next set of results, or null if there are no more
-- results.
listStreamingSessionBackups_nextToken :: Lens.Lens' ListStreamingSessionBackups (Prelude.Maybe Prelude.Text)
listStreamingSessionBackups_nextToken :: Lens' ListStreamingSessionBackups (Maybe Text)
listStreamingSessionBackups_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingSessionBackups' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStreamingSessionBackups
s@ListStreamingSessionBackups' {} Maybe Text
a -> ListStreamingSessionBackups
s {$sel:nextToken:ListStreamingSessionBackups' :: Maybe Text
nextToken = Maybe Text
a} :: ListStreamingSessionBackups)

-- | The user ID of the user that owns the streaming session.
listStreamingSessionBackups_ownedBy :: Lens.Lens' ListStreamingSessionBackups (Prelude.Maybe Prelude.Text)
listStreamingSessionBackups_ownedBy :: Lens' ListStreamingSessionBackups (Maybe Text)
listStreamingSessionBackups_ownedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingSessionBackups' {Maybe Text
ownedBy :: Maybe Text
$sel:ownedBy:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
ownedBy} -> Maybe Text
ownedBy) (\s :: ListStreamingSessionBackups
s@ListStreamingSessionBackups' {} Maybe Text
a -> ListStreamingSessionBackups
s {$sel:ownedBy:ListStreamingSessionBackups' :: Maybe Text
ownedBy = Maybe Text
a} :: ListStreamingSessionBackups)

-- | The studio ID.
listStreamingSessionBackups_studioId :: Lens.Lens' ListStreamingSessionBackups Prelude.Text
listStreamingSessionBackups_studioId :: Lens' ListStreamingSessionBackups Text
listStreamingSessionBackups_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingSessionBackups' {Text
studioId :: Text
$sel:studioId:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Text
studioId} -> Text
studioId) (\s :: ListStreamingSessionBackups
s@ListStreamingSessionBackups' {} Text
a -> ListStreamingSessionBackups
s {$sel:studioId:ListStreamingSessionBackups' :: Text
studioId = Text
a} :: ListStreamingSessionBackups)

instance Core.AWSPager ListStreamingSessionBackups where
  page :: ListStreamingSessionBackups
-> AWSResponse ListStreamingSessionBackups
-> Maybe ListStreamingSessionBackups
page ListStreamingSessionBackups
rq AWSResponse ListStreamingSessionBackups
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListStreamingSessionBackups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamingSessionBackupsResponse (Maybe Text)
listStreamingSessionBackupsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListStreamingSessionBackups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListStreamingSessionBackupsResponse
  (Maybe [StreamingSessionBackup])
listStreamingSessionBackupsResponse_streamingSessionBackups
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListStreamingSessionBackups
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListStreamingSessionBackups (Maybe Text)
listStreamingSessionBackups_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListStreamingSessionBackups
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStreamingSessionBackupsResponse (Maybe Text)
listStreamingSessionBackupsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListStreamingSessionBackups where
  type
    AWSResponse ListStreamingSessionBackups =
      ListStreamingSessionBackupsResponse
  request :: (Service -> Service)
-> ListStreamingSessionBackups
-> Request ListStreamingSessionBackups
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 ListStreamingSessionBackups
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListStreamingSessionBackups)))
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 Text
-> Maybe [StreamingSessionBackup]
-> Int
-> ListStreamingSessionBackupsResponse
ListStreamingSessionBackupsResponse'
            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
"nextToken")
            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
"streamingSessionBackups"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 ListStreamingSessionBackups where
  hashWithSalt :: Int -> ListStreamingSessionBackups -> Int
hashWithSalt Int
_salt ListStreamingSessionBackups' {Maybe Text
Text
studioId :: Text
ownedBy :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Text
$sel:ownedBy:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
$sel:nextToken:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownedBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId

instance Prelude.NFData ListStreamingSessionBackups where
  rnf :: ListStreamingSessionBackups -> ()
rnf ListStreamingSessionBackups' {Maybe Text
Text
studioId :: Text
ownedBy :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Text
$sel:ownedBy:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
$sel:nextToken:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
studioId

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

instance Data.ToPath ListStreamingSessionBackups where
  toPath :: ListStreamingSessionBackups -> ByteString
toPath ListStreamingSessionBackups' {Maybe Text
Text
studioId :: Text
ownedBy :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Text
$sel:ownedBy:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
$sel:nextToken:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-08-01/studios/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
studioId,
        ByteString
"/streaming-session-backups"
      ]

instance Data.ToQuery ListStreamingSessionBackups where
  toQuery :: ListStreamingSessionBackups -> QueryString
toQuery ListStreamingSessionBackups' {Maybe Text
Text
studioId :: Text
ownedBy :: Maybe Text
nextToken :: Maybe Text
$sel:studioId:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Text
$sel:ownedBy:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
$sel:nextToken:ListStreamingSessionBackups' :: ListStreamingSessionBackups -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"ownedBy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ownedBy
      ]

-- | /See:/ 'newListStreamingSessionBackupsResponse' smart constructor.
data ListStreamingSessionBackupsResponse = ListStreamingSessionBackupsResponse'
  { -- | The token for the next set of results, or null if there are no more
    -- results.
    ListStreamingSessionBackupsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the streaming session backups.
    ListStreamingSessionBackupsResponse
-> Maybe [StreamingSessionBackup]
streamingSessionBackups :: Prelude.Maybe [StreamingSessionBackup],
    -- | The response's http status code.
    ListStreamingSessionBackupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListStreamingSessionBackupsResponse
-> ListStreamingSessionBackupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStreamingSessionBackupsResponse
-> ListStreamingSessionBackupsResponse -> Bool
$c/= :: ListStreamingSessionBackupsResponse
-> ListStreamingSessionBackupsResponse -> Bool
== :: ListStreamingSessionBackupsResponse
-> ListStreamingSessionBackupsResponse -> Bool
$c== :: ListStreamingSessionBackupsResponse
-> ListStreamingSessionBackupsResponse -> Bool
Prelude.Eq, ReadPrec [ListStreamingSessionBackupsResponse]
ReadPrec ListStreamingSessionBackupsResponse
Int -> ReadS ListStreamingSessionBackupsResponse
ReadS [ListStreamingSessionBackupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStreamingSessionBackupsResponse]
$creadListPrec :: ReadPrec [ListStreamingSessionBackupsResponse]
readPrec :: ReadPrec ListStreamingSessionBackupsResponse
$creadPrec :: ReadPrec ListStreamingSessionBackupsResponse
readList :: ReadS [ListStreamingSessionBackupsResponse]
$creadList :: ReadS [ListStreamingSessionBackupsResponse]
readsPrec :: Int -> ReadS ListStreamingSessionBackupsResponse
$creadsPrec :: Int -> ReadS ListStreamingSessionBackupsResponse
Prelude.Read, Int -> ListStreamingSessionBackupsResponse -> ShowS
[ListStreamingSessionBackupsResponse] -> ShowS
ListStreamingSessionBackupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStreamingSessionBackupsResponse] -> ShowS
$cshowList :: [ListStreamingSessionBackupsResponse] -> ShowS
show :: ListStreamingSessionBackupsResponse -> String
$cshow :: ListStreamingSessionBackupsResponse -> String
showsPrec :: Int -> ListStreamingSessionBackupsResponse -> ShowS
$cshowsPrec :: Int -> ListStreamingSessionBackupsResponse -> ShowS
Prelude.Show, forall x.
Rep ListStreamingSessionBackupsResponse x
-> ListStreamingSessionBackupsResponse
forall x.
ListStreamingSessionBackupsResponse
-> Rep ListStreamingSessionBackupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListStreamingSessionBackupsResponse x
-> ListStreamingSessionBackupsResponse
$cfrom :: forall x.
ListStreamingSessionBackupsResponse
-> Rep ListStreamingSessionBackupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListStreamingSessionBackupsResponse' 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:
--
-- 'nextToken', 'listStreamingSessionBackupsResponse_nextToken' - The token for the next set of results, or null if there are no more
-- results.
--
-- 'streamingSessionBackups', 'listStreamingSessionBackupsResponse_streamingSessionBackups' - Information about the streaming session backups.
--
-- 'httpStatus', 'listStreamingSessionBackupsResponse_httpStatus' - The response's http status code.
newListStreamingSessionBackupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListStreamingSessionBackupsResponse
newListStreamingSessionBackupsResponse :: Int -> ListStreamingSessionBackupsResponse
newListStreamingSessionBackupsResponse Int
pHttpStatus_ =
  ListStreamingSessionBackupsResponse'
    { $sel:nextToken:ListStreamingSessionBackupsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:streamingSessionBackups:ListStreamingSessionBackupsResponse' :: Maybe [StreamingSessionBackup]
streamingSessionBackups =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListStreamingSessionBackupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token for the next set of results, or null if there are no more
-- results.
listStreamingSessionBackupsResponse_nextToken :: Lens.Lens' ListStreamingSessionBackupsResponse (Prelude.Maybe Prelude.Text)
listStreamingSessionBackupsResponse_nextToken :: Lens' ListStreamingSessionBackupsResponse (Maybe Text)
listStreamingSessionBackupsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingSessionBackupsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStreamingSessionBackupsResponse' :: ListStreamingSessionBackupsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStreamingSessionBackupsResponse
s@ListStreamingSessionBackupsResponse' {} Maybe Text
a -> ListStreamingSessionBackupsResponse
s {$sel:nextToken:ListStreamingSessionBackupsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListStreamingSessionBackupsResponse)

-- | Information about the streaming session backups.
listStreamingSessionBackupsResponse_streamingSessionBackups :: Lens.Lens' ListStreamingSessionBackupsResponse (Prelude.Maybe [StreamingSessionBackup])
listStreamingSessionBackupsResponse_streamingSessionBackups :: Lens'
  ListStreamingSessionBackupsResponse
  (Maybe [StreamingSessionBackup])
listStreamingSessionBackupsResponse_streamingSessionBackups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingSessionBackupsResponse' {Maybe [StreamingSessionBackup]
streamingSessionBackups :: Maybe [StreamingSessionBackup]
$sel:streamingSessionBackups:ListStreamingSessionBackupsResponse' :: ListStreamingSessionBackupsResponse
-> Maybe [StreamingSessionBackup]
streamingSessionBackups} -> Maybe [StreamingSessionBackup]
streamingSessionBackups) (\s :: ListStreamingSessionBackupsResponse
s@ListStreamingSessionBackupsResponse' {} Maybe [StreamingSessionBackup]
a -> ListStreamingSessionBackupsResponse
s {$sel:streamingSessionBackups:ListStreamingSessionBackupsResponse' :: Maybe [StreamingSessionBackup]
streamingSessionBackups = Maybe [StreamingSessionBackup]
a} :: ListStreamingSessionBackupsResponse) 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 response's http status code.
listStreamingSessionBackupsResponse_httpStatus :: Lens.Lens' ListStreamingSessionBackupsResponse Prelude.Int
listStreamingSessionBackupsResponse_httpStatus :: Lens' ListStreamingSessionBackupsResponse Int
listStreamingSessionBackupsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStreamingSessionBackupsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListStreamingSessionBackupsResponse' :: ListStreamingSessionBackupsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListStreamingSessionBackupsResponse
s@ListStreamingSessionBackupsResponse' {} Int
a -> ListStreamingSessionBackupsResponse
s {$sel:httpStatus:ListStreamingSessionBackupsResponse' :: Int
httpStatus = Int
a} :: ListStreamingSessionBackupsResponse)

instance
  Prelude.NFData
    ListStreamingSessionBackupsResponse
  where
  rnf :: ListStreamingSessionBackupsResponse -> ()
rnf ListStreamingSessionBackupsResponse' {Int
Maybe [StreamingSessionBackup]
Maybe Text
httpStatus :: Int
streamingSessionBackups :: Maybe [StreamingSessionBackup]
nextToken :: Maybe Text
$sel:httpStatus:ListStreamingSessionBackupsResponse' :: ListStreamingSessionBackupsResponse -> Int
$sel:streamingSessionBackups:ListStreamingSessionBackupsResponse' :: ListStreamingSessionBackupsResponse
-> Maybe [StreamingSessionBackup]
$sel:nextToken:ListStreamingSessionBackupsResponse' :: ListStreamingSessionBackupsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [StreamingSessionBackup]
streamingSessionBackups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus