{-# 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.GetStudioSessionMapping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Fetches mapping details for the specified Amazon EMR Studio and identity
-- (user or group).
module Amazonka.EMR.GetStudioSessionMapping
  ( -- * Creating a Request
    GetStudioSessionMapping (..),
    newGetStudioSessionMapping,

    -- * Request Lenses
    getStudioSessionMapping_identityId,
    getStudioSessionMapping_identityName,
    getStudioSessionMapping_studioId,
    getStudioSessionMapping_identityType,

    -- * Destructuring the Response
    GetStudioSessionMappingResponse (..),
    newGetStudioSessionMappingResponse,

    -- * Response Lenses
    getStudioSessionMappingResponse_sessionMapping,
    getStudioSessionMappingResponse_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:/ 'newGetStudioSessionMapping' smart constructor.
data GetStudioSessionMapping = GetStudioSessionMapping'
  { -- | The globally unique identifier (GUID) of the user or group. For more
    -- information, see
    -- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_User.html#singlesignon-Type-User-UserId UserId>
    -- and
    -- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_Group.html#singlesignon-Type-Group-GroupId GroupId>
    -- in the /IAM Identity Center Identity Store API Reference/. Either
    -- @IdentityName@ or @IdentityId@ must be specified.
    GetStudioSessionMapping -> Maybe Text
identityId :: Prelude.Maybe Prelude.Text,
    -- | The name of the user or group to fetch. For more information, see
    -- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_User.html#singlesignon-Type-User-UserName UserName>
    -- and
    -- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_Group.html#singlesignon-Type-Group-DisplayName DisplayName>
    -- in the /IAM Identity Center Identity Store API Reference/. Either
    -- @IdentityName@ or @IdentityId@ must be specified.
    GetStudioSessionMapping -> Maybe Text
identityName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Amazon EMR Studio.
    GetStudioSessionMapping -> Text
studioId :: Prelude.Text,
    -- | Specifies whether the identity to fetch is a user or a group.
    GetStudioSessionMapping -> IdentityType
identityType :: IdentityType
  }
  deriving (GetStudioSessionMapping -> GetStudioSessionMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStudioSessionMapping -> GetStudioSessionMapping -> Bool
$c/= :: GetStudioSessionMapping -> GetStudioSessionMapping -> Bool
== :: GetStudioSessionMapping -> GetStudioSessionMapping -> Bool
$c== :: GetStudioSessionMapping -> GetStudioSessionMapping -> Bool
Prelude.Eq, ReadPrec [GetStudioSessionMapping]
ReadPrec GetStudioSessionMapping
Int -> ReadS GetStudioSessionMapping
ReadS [GetStudioSessionMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStudioSessionMapping]
$creadListPrec :: ReadPrec [GetStudioSessionMapping]
readPrec :: ReadPrec GetStudioSessionMapping
$creadPrec :: ReadPrec GetStudioSessionMapping
readList :: ReadS [GetStudioSessionMapping]
$creadList :: ReadS [GetStudioSessionMapping]
readsPrec :: Int -> ReadS GetStudioSessionMapping
$creadsPrec :: Int -> ReadS GetStudioSessionMapping
Prelude.Read, Int -> GetStudioSessionMapping -> ShowS
[GetStudioSessionMapping] -> ShowS
GetStudioSessionMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStudioSessionMapping] -> ShowS
$cshowList :: [GetStudioSessionMapping] -> ShowS
show :: GetStudioSessionMapping -> String
$cshow :: GetStudioSessionMapping -> String
showsPrec :: Int -> GetStudioSessionMapping -> ShowS
$cshowsPrec :: Int -> GetStudioSessionMapping -> ShowS
Prelude.Show, forall x. Rep GetStudioSessionMapping x -> GetStudioSessionMapping
forall x. GetStudioSessionMapping -> Rep GetStudioSessionMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStudioSessionMapping x -> GetStudioSessionMapping
$cfrom :: forall x. GetStudioSessionMapping -> Rep GetStudioSessionMapping x
Prelude.Generic)

-- |
-- Create a value of 'GetStudioSessionMapping' 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:
--
-- 'identityId', 'getStudioSessionMapping_identityId' - The globally unique identifier (GUID) of the user or group. For more
-- information, see
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_User.html#singlesignon-Type-User-UserId UserId>
-- and
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_Group.html#singlesignon-Type-Group-GroupId GroupId>
-- in the /IAM Identity Center Identity Store API Reference/. Either
-- @IdentityName@ or @IdentityId@ must be specified.
--
-- 'identityName', 'getStudioSessionMapping_identityName' - The name of the user or group to fetch. For more information, see
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_User.html#singlesignon-Type-User-UserName UserName>
-- and
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_Group.html#singlesignon-Type-Group-DisplayName DisplayName>
-- in the /IAM Identity Center Identity Store API Reference/. Either
-- @IdentityName@ or @IdentityId@ must be specified.
--
-- 'studioId', 'getStudioSessionMapping_studioId' - The ID of the Amazon EMR Studio.
--
-- 'identityType', 'getStudioSessionMapping_identityType' - Specifies whether the identity to fetch is a user or a group.
newGetStudioSessionMapping ::
  -- | 'studioId'
  Prelude.Text ->
  -- | 'identityType'
  IdentityType ->
  GetStudioSessionMapping
newGetStudioSessionMapping :: Text -> IdentityType -> GetStudioSessionMapping
newGetStudioSessionMapping Text
pStudioId_ IdentityType
pIdentityType_ =
  GetStudioSessionMapping'
    { $sel:identityId:GetStudioSessionMapping' :: Maybe Text
identityId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityName:GetStudioSessionMapping' :: Maybe Text
identityName = forall a. Maybe a
Prelude.Nothing,
      $sel:studioId:GetStudioSessionMapping' :: Text
studioId = Text
pStudioId_,
      $sel:identityType:GetStudioSessionMapping' :: IdentityType
identityType = IdentityType
pIdentityType_
    }

-- | The globally unique identifier (GUID) of the user or group. For more
-- information, see
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_User.html#singlesignon-Type-User-UserId UserId>
-- and
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_Group.html#singlesignon-Type-Group-GroupId GroupId>
-- in the /IAM Identity Center Identity Store API Reference/. Either
-- @IdentityName@ or @IdentityId@ must be specified.
getStudioSessionMapping_identityId :: Lens.Lens' GetStudioSessionMapping (Prelude.Maybe Prelude.Text)
getStudioSessionMapping_identityId :: Lens' GetStudioSessionMapping (Maybe Text)
getStudioSessionMapping_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioSessionMapping' {Maybe Text
identityId :: Maybe Text
$sel:identityId:GetStudioSessionMapping' :: GetStudioSessionMapping -> Maybe Text
identityId} -> Maybe Text
identityId) (\s :: GetStudioSessionMapping
s@GetStudioSessionMapping' {} Maybe Text
a -> GetStudioSessionMapping
s {$sel:identityId:GetStudioSessionMapping' :: Maybe Text
identityId = Maybe Text
a} :: GetStudioSessionMapping)

-- | The name of the user or group to fetch. For more information, see
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_User.html#singlesignon-Type-User-UserName UserName>
-- and
-- <https://docs.aws.amazon.com/singlesignon/latest/IdentityStoreAPIReference/API_Group.html#singlesignon-Type-Group-DisplayName DisplayName>
-- in the /IAM Identity Center Identity Store API Reference/. Either
-- @IdentityName@ or @IdentityId@ must be specified.
getStudioSessionMapping_identityName :: Lens.Lens' GetStudioSessionMapping (Prelude.Maybe Prelude.Text)
getStudioSessionMapping_identityName :: Lens' GetStudioSessionMapping (Maybe Text)
getStudioSessionMapping_identityName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioSessionMapping' {Maybe Text
identityName :: Maybe Text
$sel:identityName:GetStudioSessionMapping' :: GetStudioSessionMapping -> Maybe Text
identityName} -> Maybe Text
identityName) (\s :: GetStudioSessionMapping
s@GetStudioSessionMapping' {} Maybe Text
a -> GetStudioSessionMapping
s {$sel:identityName:GetStudioSessionMapping' :: Maybe Text
identityName = Maybe Text
a} :: GetStudioSessionMapping)

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

-- | Specifies whether the identity to fetch is a user or a group.
getStudioSessionMapping_identityType :: Lens.Lens' GetStudioSessionMapping IdentityType
getStudioSessionMapping_identityType :: Lens' GetStudioSessionMapping IdentityType
getStudioSessionMapping_identityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioSessionMapping' {IdentityType
identityType :: IdentityType
$sel:identityType:GetStudioSessionMapping' :: GetStudioSessionMapping -> IdentityType
identityType} -> IdentityType
identityType) (\s :: GetStudioSessionMapping
s@GetStudioSessionMapping' {} IdentityType
a -> GetStudioSessionMapping
s {$sel:identityType:GetStudioSessionMapping' :: IdentityType
identityType = IdentityType
a} :: GetStudioSessionMapping)

instance Core.AWSRequest GetStudioSessionMapping where
  type
    AWSResponse GetStudioSessionMapping =
      GetStudioSessionMappingResponse
  request :: (Service -> Service)
-> GetStudioSessionMapping -> Request GetStudioSessionMapping
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 GetStudioSessionMapping
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetStudioSessionMapping)))
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 SessionMappingDetail
-> Int -> GetStudioSessionMappingResponse
GetStudioSessionMappingResponse'
            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
"SessionMapping")
            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 GetStudioSessionMapping where
  hashWithSalt :: Int -> GetStudioSessionMapping -> Int
hashWithSalt Int
_salt GetStudioSessionMapping' {Maybe Text
Text
IdentityType
identityType :: IdentityType
studioId :: Text
identityName :: Maybe Text
identityId :: Maybe Text
$sel:identityType:GetStudioSessionMapping' :: GetStudioSessionMapping -> IdentityType
$sel:studioId:GetStudioSessionMapping' :: GetStudioSessionMapping -> Text
$sel:identityName:GetStudioSessionMapping' :: GetStudioSessionMapping -> Maybe Text
$sel:identityId:GetStudioSessionMapping' :: GetStudioSessionMapping -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
identityId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
identityName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
studioId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IdentityType
identityType

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

instance Data.ToHeaders GetStudioSessionMapping where
  toHeaders :: GetStudioSessionMapping -> 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.GetStudioSessionMapping" ::
                          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 GetStudioSessionMapping where
  toJSON :: GetStudioSessionMapping -> Value
toJSON GetStudioSessionMapping' {Maybe Text
Text
IdentityType
identityType :: IdentityType
studioId :: Text
identityName :: Maybe Text
identityId :: Maybe Text
$sel:identityType:GetStudioSessionMapping' :: GetStudioSessionMapping -> IdentityType
$sel:studioId:GetStudioSessionMapping' :: GetStudioSessionMapping -> Text
$sel:identityName:GetStudioSessionMapping' :: GetStudioSessionMapping -> Maybe Text
$sel:identityId:GetStudioSessionMapping' :: GetStudioSessionMapping -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IdentityId" 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
identityId,
            (Key
"IdentityName" 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
identityName,
            forall a. a -> Maybe a
Prelude.Just (Key
"StudioId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
studioId),
            forall a. a -> Maybe a
Prelude.Just (Key
"IdentityType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IdentityType
identityType)
          ]
      )

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

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

-- | /See:/ 'newGetStudioSessionMappingResponse' smart constructor.
data GetStudioSessionMappingResponse = GetStudioSessionMappingResponse'
  { -- | The session mapping details for the specified Amazon EMR Studio and
    -- identity, including session policy ARN and creation time.
    GetStudioSessionMappingResponse -> Maybe SessionMappingDetail
sessionMapping :: Prelude.Maybe SessionMappingDetail,
    -- | The response's http status code.
    GetStudioSessionMappingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetStudioSessionMappingResponse
-> GetStudioSessionMappingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStudioSessionMappingResponse
-> GetStudioSessionMappingResponse -> Bool
$c/= :: GetStudioSessionMappingResponse
-> GetStudioSessionMappingResponse -> Bool
== :: GetStudioSessionMappingResponse
-> GetStudioSessionMappingResponse -> Bool
$c== :: GetStudioSessionMappingResponse
-> GetStudioSessionMappingResponse -> Bool
Prelude.Eq, ReadPrec [GetStudioSessionMappingResponse]
ReadPrec GetStudioSessionMappingResponse
Int -> ReadS GetStudioSessionMappingResponse
ReadS [GetStudioSessionMappingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStudioSessionMappingResponse]
$creadListPrec :: ReadPrec [GetStudioSessionMappingResponse]
readPrec :: ReadPrec GetStudioSessionMappingResponse
$creadPrec :: ReadPrec GetStudioSessionMappingResponse
readList :: ReadS [GetStudioSessionMappingResponse]
$creadList :: ReadS [GetStudioSessionMappingResponse]
readsPrec :: Int -> ReadS GetStudioSessionMappingResponse
$creadsPrec :: Int -> ReadS GetStudioSessionMappingResponse
Prelude.Read, Int -> GetStudioSessionMappingResponse -> ShowS
[GetStudioSessionMappingResponse] -> ShowS
GetStudioSessionMappingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStudioSessionMappingResponse] -> ShowS
$cshowList :: [GetStudioSessionMappingResponse] -> ShowS
show :: GetStudioSessionMappingResponse -> String
$cshow :: GetStudioSessionMappingResponse -> String
showsPrec :: Int -> GetStudioSessionMappingResponse -> ShowS
$cshowsPrec :: Int -> GetStudioSessionMappingResponse -> ShowS
Prelude.Show, forall x.
Rep GetStudioSessionMappingResponse x
-> GetStudioSessionMappingResponse
forall x.
GetStudioSessionMappingResponse
-> Rep GetStudioSessionMappingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetStudioSessionMappingResponse x
-> GetStudioSessionMappingResponse
$cfrom :: forall x.
GetStudioSessionMappingResponse
-> Rep GetStudioSessionMappingResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetStudioSessionMappingResponse' 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:
--
-- 'sessionMapping', 'getStudioSessionMappingResponse_sessionMapping' - The session mapping details for the specified Amazon EMR Studio and
-- identity, including session policy ARN and creation time.
--
-- 'httpStatus', 'getStudioSessionMappingResponse_httpStatus' - The response's http status code.
newGetStudioSessionMappingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetStudioSessionMappingResponse
newGetStudioSessionMappingResponse :: Int -> GetStudioSessionMappingResponse
newGetStudioSessionMappingResponse Int
pHttpStatus_ =
  GetStudioSessionMappingResponse'
    { $sel:sessionMapping:GetStudioSessionMappingResponse' :: Maybe SessionMappingDetail
sessionMapping =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetStudioSessionMappingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The session mapping details for the specified Amazon EMR Studio and
-- identity, including session policy ARN and creation time.
getStudioSessionMappingResponse_sessionMapping :: Lens.Lens' GetStudioSessionMappingResponse (Prelude.Maybe SessionMappingDetail)
getStudioSessionMappingResponse_sessionMapping :: Lens' GetStudioSessionMappingResponse (Maybe SessionMappingDetail)
getStudioSessionMappingResponse_sessionMapping = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStudioSessionMappingResponse' {Maybe SessionMappingDetail
sessionMapping :: Maybe SessionMappingDetail
$sel:sessionMapping:GetStudioSessionMappingResponse' :: GetStudioSessionMappingResponse -> Maybe SessionMappingDetail
sessionMapping} -> Maybe SessionMappingDetail
sessionMapping) (\s :: GetStudioSessionMappingResponse
s@GetStudioSessionMappingResponse' {} Maybe SessionMappingDetail
a -> GetStudioSessionMappingResponse
s {$sel:sessionMapping:GetStudioSessionMappingResponse' :: Maybe SessionMappingDetail
sessionMapping = Maybe SessionMappingDetail
a} :: GetStudioSessionMappingResponse)

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

instance
  Prelude.NFData
    GetStudioSessionMappingResponse
  where
  rnf :: GetStudioSessionMappingResponse -> ()
rnf GetStudioSessionMappingResponse' {Int
Maybe SessionMappingDetail
httpStatus :: Int
sessionMapping :: Maybe SessionMappingDetail
$sel:httpStatus:GetStudioSessionMappingResponse' :: GetStudioSessionMappingResponse -> Int
$sel:sessionMapping:GetStudioSessionMappingResponse' :: GetStudioSessionMappingResponse -> Maybe SessionMappingDetail
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SessionMappingDetail
sessionMapping
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus