{-# 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.EMR.ListStudioSessionMappings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of all user or group session mappings for the Amazon EMR
-- Studio specified by @StudioId@.
--
-- This operation returns paginated results.
module Amazonka.EMR.ListStudioSessionMappings
  ( -- * Creating a Request
    ListStudioSessionMappings (..),
    newListStudioSessionMappings,

    -- * Request Lenses
    listStudioSessionMappings_identityType,
    listStudioSessionMappings_marker,
    listStudioSessionMappings_studioId,

    -- * Destructuring the Response
    ListStudioSessionMappingsResponse (..),
    newListStudioSessionMappingsResponse,

    -- * Response Lenses
    listStudioSessionMappingsResponse_marker,
    listStudioSessionMappingsResponse_sessionMappings,
    listStudioSessionMappingsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListStudioSessionMappings' smart constructor.
data ListStudioSessionMappings = ListStudioSessionMappings'
  { -- | Specifies whether to return session mappings for users or groups. If not
    -- specified, the results include session mapping details for both users
    -- and groups.
    ListStudioSessionMappings -> Maybe IdentityType
identityType :: Prelude.Maybe IdentityType,
    -- | The pagination token that indicates the set of results to retrieve.
    ListStudioSessionMappings -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Amazon EMR Studio.
    ListStudioSessionMappings -> Maybe Text
studioId :: Prelude.Maybe Prelude.Text
  }
  deriving (ListStudioSessionMappings -> ListStudioSessionMappings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStudioSessionMappings -> ListStudioSessionMappings -> Bool
$c/= :: ListStudioSessionMappings -> ListStudioSessionMappings -> Bool
== :: ListStudioSessionMappings -> ListStudioSessionMappings -> Bool
$c== :: ListStudioSessionMappings -> ListStudioSessionMappings -> Bool
Prelude.Eq, ReadPrec [ListStudioSessionMappings]
ReadPrec ListStudioSessionMappings
Int -> ReadS ListStudioSessionMappings
ReadS [ListStudioSessionMappings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStudioSessionMappings]
$creadListPrec :: ReadPrec [ListStudioSessionMappings]
readPrec :: ReadPrec ListStudioSessionMappings
$creadPrec :: ReadPrec ListStudioSessionMappings
readList :: ReadS [ListStudioSessionMappings]
$creadList :: ReadS [ListStudioSessionMappings]
readsPrec :: Int -> ReadS ListStudioSessionMappings
$creadsPrec :: Int -> ReadS ListStudioSessionMappings
Prelude.Read, Int -> ListStudioSessionMappings -> ShowS
[ListStudioSessionMappings] -> ShowS
ListStudioSessionMappings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStudioSessionMappings] -> ShowS
$cshowList :: [ListStudioSessionMappings] -> ShowS
show :: ListStudioSessionMappings -> String
$cshow :: ListStudioSessionMappings -> String
showsPrec :: Int -> ListStudioSessionMappings -> ShowS
$cshowsPrec :: Int -> ListStudioSessionMappings -> ShowS
Prelude.Show, forall x.
Rep ListStudioSessionMappings x -> ListStudioSessionMappings
forall x.
ListStudioSessionMappings -> Rep ListStudioSessionMappings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListStudioSessionMappings x -> ListStudioSessionMappings
$cfrom :: forall x.
ListStudioSessionMappings -> Rep ListStudioSessionMappings x
Prelude.Generic)

-- |
-- Create a value of 'ListStudioSessionMappings' 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:
--
-- 'identityType', 'listStudioSessionMappings_identityType' - Specifies whether to return session mappings for users or groups. If not
-- specified, the results include session mapping details for both users
-- and groups.
--
-- 'marker', 'listStudioSessionMappings_marker' - The pagination token that indicates the set of results to retrieve.
--
-- 'studioId', 'listStudioSessionMappings_studioId' - The ID of the Amazon EMR Studio.
newListStudioSessionMappings ::
  ListStudioSessionMappings
newListStudioSessionMappings :: ListStudioSessionMappings
newListStudioSessionMappings =
  ListStudioSessionMappings'
    { $sel:identityType:ListStudioSessionMappings' :: Maybe IdentityType
identityType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListStudioSessionMappings' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:studioId:ListStudioSessionMappings' :: Maybe Text
studioId = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies whether to return session mappings for users or groups. If not
-- specified, the results include session mapping details for both users
-- and groups.
listStudioSessionMappings_identityType :: Lens.Lens' ListStudioSessionMappings (Prelude.Maybe IdentityType)
listStudioSessionMappings_identityType :: Lens' ListStudioSessionMappings (Maybe IdentityType)
listStudioSessionMappings_identityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStudioSessionMappings' {Maybe IdentityType
identityType :: Maybe IdentityType
$sel:identityType:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe IdentityType
identityType} -> Maybe IdentityType
identityType) (\s :: ListStudioSessionMappings
s@ListStudioSessionMappings' {} Maybe IdentityType
a -> ListStudioSessionMappings
s {$sel:identityType:ListStudioSessionMappings' :: Maybe IdentityType
identityType = Maybe IdentityType
a} :: ListStudioSessionMappings)

-- | The pagination token that indicates the set of results to retrieve.
listStudioSessionMappings_marker :: Lens.Lens' ListStudioSessionMappings (Prelude.Maybe Prelude.Text)
listStudioSessionMappings_marker :: Lens' ListStudioSessionMappings (Maybe Text)
listStudioSessionMappings_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStudioSessionMappings' {Maybe Text
marker :: Maybe Text
$sel:marker:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListStudioSessionMappings
s@ListStudioSessionMappings' {} Maybe Text
a -> ListStudioSessionMappings
s {$sel:marker:ListStudioSessionMappings' :: Maybe Text
marker = Maybe Text
a} :: ListStudioSessionMappings)

-- | The ID of the Amazon EMR Studio.
listStudioSessionMappings_studioId :: Lens.Lens' ListStudioSessionMappings (Prelude.Maybe Prelude.Text)
listStudioSessionMappings_studioId :: Lens' ListStudioSessionMappings (Maybe Text)
listStudioSessionMappings_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStudioSessionMappings' {Maybe Text
studioId :: Maybe Text
$sel:studioId:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
studioId} -> Maybe Text
studioId) (\s :: ListStudioSessionMappings
s@ListStudioSessionMappings' {} Maybe Text
a -> ListStudioSessionMappings
s {$sel:studioId:ListStudioSessionMappings' :: Maybe Text
studioId = Maybe Text
a} :: ListStudioSessionMappings)

instance Core.AWSPager ListStudioSessionMappings where
  page :: ListStudioSessionMappings
-> AWSResponse ListStudioSessionMappings
-> Maybe ListStudioSessionMappings
page ListStudioSessionMappings
rq AWSResponse ListStudioSessionMappings
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListStudioSessionMappings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStudioSessionMappingsResponse (Maybe Text)
listStudioSessionMappingsResponse_marker
            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 ListStudioSessionMappings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListStudioSessionMappingsResponse (Maybe [SessionMappingSummary])
listStudioSessionMappingsResponse_sessionMappings
            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.$ ListStudioSessionMappings
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListStudioSessionMappings (Maybe Text)
listStudioSessionMappings_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListStudioSessionMappings
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStudioSessionMappingsResponse (Maybe Text)
listStudioSessionMappingsResponse_marker
          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 ListStudioSessionMappings where
  type
    AWSResponse ListStudioSessionMappings =
      ListStudioSessionMappingsResponse
  request :: (Service -> Service)
-> ListStudioSessionMappings -> Request ListStudioSessionMappings
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 ListStudioSessionMappings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListStudioSessionMappings)))
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 [SessionMappingSummary]
-> Int
-> ListStudioSessionMappingsResponse
ListStudioSessionMappingsResponse'
            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
"Marker")
            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
"SessionMappings"
                            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 ListStudioSessionMappings where
  hashWithSalt :: Int -> ListStudioSessionMappings -> Int
hashWithSalt Int
_salt ListStudioSessionMappings' {Maybe Text
Maybe IdentityType
studioId :: Maybe Text
marker :: Maybe Text
identityType :: Maybe IdentityType
$sel:studioId:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
$sel:marker:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
$sel:identityType:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe IdentityType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IdentityType
identityType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
studioId

instance Prelude.NFData ListStudioSessionMappings where
  rnf :: ListStudioSessionMappings -> ()
rnf ListStudioSessionMappings' {Maybe Text
Maybe IdentityType
studioId :: Maybe Text
marker :: Maybe Text
identityType :: Maybe IdentityType
$sel:studioId:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
$sel:marker:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
$sel:identityType:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe IdentityType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe IdentityType
identityType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
studioId

instance Data.ToHeaders ListStudioSessionMappings where
  toHeaders :: ListStudioSessionMappings -> 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
"ElasticMapReduce.ListStudioSessionMappings" ::
                          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 ListStudioSessionMappings where
  toJSON :: ListStudioSessionMappings -> Value
toJSON ListStudioSessionMappings' {Maybe Text
Maybe IdentityType
studioId :: Maybe Text
marker :: Maybe Text
identityType :: Maybe IdentityType
$sel:studioId:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
$sel:marker:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe Text
$sel:identityType:ListStudioSessionMappings' :: ListStudioSessionMappings -> Maybe IdentityType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IdentityType" 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 IdentityType
identityType,
            (Key
"Marker" 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
marker,
            (Key
"StudioId" 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
studioId
          ]
      )

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

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

-- | /See:/ 'newListStudioSessionMappingsResponse' smart constructor.
data ListStudioSessionMappingsResponse = ListStudioSessionMappingsResponse'
  { -- | The pagination token that indicates the next set of results to retrieve.
    ListStudioSessionMappingsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | A list of session mapping summary objects. Each object includes session
    -- mapping details such as creation time, identity type (user or group),
    -- and Amazon EMR Studio ID.
    ListStudioSessionMappingsResponse -> Maybe [SessionMappingSummary]
sessionMappings :: Prelude.Maybe [SessionMappingSummary],
    -- | The response's http status code.
    ListStudioSessionMappingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListStudioSessionMappingsResponse
-> ListStudioSessionMappingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStudioSessionMappingsResponse
-> ListStudioSessionMappingsResponse -> Bool
$c/= :: ListStudioSessionMappingsResponse
-> ListStudioSessionMappingsResponse -> Bool
== :: ListStudioSessionMappingsResponse
-> ListStudioSessionMappingsResponse -> Bool
$c== :: ListStudioSessionMappingsResponse
-> ListStudioSessionMappingsResponse -> Bool
Prelude.Eq, ReadPrec [ListStudioSessionMappingsResponse]
ReadPrec ListStudioSessionMappingsResponse
Int -> ReadS ListStudioSessionMappingsResponse
ReadS [ListStudioSessionMappingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStudioSessionMappingsResponse]
$creadListPrec :: ReadPrec [ListStudioSessionMappingsResponse]
readPrec :: ReadPrec ListStudioSessionMappingsResponse
$creadPrec :: ReadPrec ListStudioSessionMappingsResponse
readList :: ReadS [ListStudioSessionMappingsResponse]
$creadList :: ReadS [ListStudioSessionMappingsResponse]
readsPrec :: Int -> ReadS ListStudioSessionMappingsResponse
$creadsPrec :: Int -> ReadS ListStudioSessionMappingsResponse
Prelude.Read, Int -> ListStudioSessionMappingsResponse -> ShowS
[ListStudioSessionMappingsResponse] -> ShowS
ListStudioSessionMappingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStudioSessionMappingsResponse] -> ShowS
$cshowList :: [ListStudioSessionMappingsResponse] -> ShowS
show :: ListStudioSessionMappingsResponse -> String
$cshow :: ListStudioSessionMappingsResponse -> String
showsPrec :: Int -> ListStudioSessionMappingsResponse -> ShowS
$cshowsPrec :: Int -> ListStudioSessionMappingsResponse -> ShowS
Prelude.Show, forall x.
Rep ListStudioSessionMappingsResponse x
-> ListStudioSessionMappingsResponse
forall x.
ListStudioSessionMappingsResponse
-> Rep ListStudioSessionMappingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListStudioSessionMappingsResponse x
-> ListStudioSessionMappingsResponse
$cfrom :: forall x.
ListStudioSessionMappingsResponse
-> Rep ListStudioSessionMappingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListStudioSessionMappingsResponse' 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:
--
-- 'marker', 'listStudioSessionMappingsResponse_marker' - The pagination token that indicates the next set of results to retrieve.
--
-- 'sessionMappings', 'listStudioSessionMappingsResponse_sessionMappings' - A list of session mapping summary objects. Each object includes session
-- mapping details such as creation time, identity type (user or group),
-- and Amazon EMR Studio ID.
--
-- 'httpStatus', 'listStudioSessionMappingsResponse_httpStatus' - The response's http status code.
newListStudioSessionMappingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListStudioSessionMappingsResponse
newListStudioSessionMappingsResponse :: Int -> ListStudioSessionMappingsResponse
newListStudioSessionMappingsResponse Int
pHttpStatus_ =
  ListStudioSessionMappingsResponse'
    { $sel:marker:ListStudioSessionMappingsResponse' :: Maybe Text
marker =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sessionMappings:ListStudioSessionMappingsResponse' :: Maybe [SessionMappingSummary]
sessionMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListStudioSessionMappingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The pagination token that indicates the next set of results to retrieve.
listStudioSessionMappingsResponse_marker :: Lens.Lens' ListStudioSessionMappingsResponse (Prelude.Maybe Prelude.Text)
listStudioSessionMappingsResponse_marker :: Lens' ListStudioSessionMappingsResponse (Maybe Text)
listStudioSessionMappingsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStudioSessionMappingsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListStudioSessionMappingsResponse' :: ListStudioSessionMappingsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListStudioSessionMappingsResponse
s@ListStudioSessionMappingsResponse' {} Maybe Text
a -> ListStudioSessionMappingsResponse
s {$sel:marker:ListStudioSessionMappingsResponse' :: Maybe Text
marker = Maybe Text
a} :: ListStudioSessionMappingsResponse)

-- | A list of session mapping summary objects. Each object includes session
-- mapping details such as creation time, identity type (user or group),
-- and Amazon EMR Studio ID.
listStudioSessionMappingsResponse_sessionMappings :: Lens.Lens' ListStudioSessionMappingsResponse (Prelude.Maybe [SessionMappingSummary])
listStudioSessionMappingsResponse_sessionMappings :: Lens'
  ListStudioSessionMappingsResponse (Maybe [SessionMappingSummary])
listStudioSessionMappingsResponse_sessionMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStudioSessionMappingsResponse' {Maybe [SessionMappingSummary]
sessionMappings :: Maybe [SessionMappingSummary]
$sel:sessionMappings:ListStudioSessionMappingsResponse' :: ListStudioSessionMappingsResponse -> Maybe [SessionMappingSummary]
sessionMappings} -> Maybe [SessionMappingSummary]
sessionMappings) (\s :: ListStudioSessionMappingsResponse
s@ListStudioSessionMappingsResponse' {} Maybe [SessionMappingSummary]
a -> ListStudioSessionMappingsResponse
s {$sel:sessionMappings:ListStudioSessionMappingsResponse' :: Maybe [SessionMappingSummary]
sessionMappings = Maybe [SessionMappingSummary]
a} :: ListStudioSessionMappingsResponse) 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.
listStudioSessionMappingsResponse_httpStatus :: Lens.Lens' ListStudioSessionMappingsResponse Prelude.Int
listStudioSessionMappingsResponse_httpStatus :: Lens' ListStudioSessionMappingsResponse Int
listStudioSessionMappingsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStudioSessionMappingsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListStudioSessionMappingsResponse' :: ListStudioSessionMappingsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListStudioSessionMappingsResponse
s@ListStudioSessionMappingsResponse' {} Int
a -> ListStudioSessionMappingsResponse
s {$sel:httpStatus:ListStudioSessionMappingsResponse' :: Int
httpStatus = Int
a} :: ListStudioSessionMappingsResponse)

instance
  Prelude.NFData
    ListStudioSessionMappingsResponse
  where
  rnf :: ListStudioSessionMappingsResponse -> ()
rnf ListStudioSessionMappingsResponse' {Int
Maybe [SessionMappingSummary]
Maybe Text
httpStatus :: Int
sessionMappings :: Maybe [SessionMappingSummary]
marker :: Maybe Text
$sel:httpStatus:ListStudioSessionMappingsResponse' :: ListStudioSessionMappingsResponse -> Int
$sel:sessionMappings:ListStudioSessionMappingsResponse' :: ListStudioSessionMappingsResponse -> Maybe [SessionMappingSummary]
$sel:marker:ListStudioSessionMappingsResponse' :: ListStudioSessionMappingsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SessionMappingSummary]
sessionMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus