{-# 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.DeleteStudioSessionMapping
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes a user or group from an Amazon EMR Studio.
module Amazonka.EMR.DeleteStudioSessionMapping
  ( -- * Creating a Request
    DeleteStudioSessionMapping (..),
    newDeleteStudioSessionMapping,

    -- * Request Lenses
    deleteStudioSessionMapping_identityId,
    deleteStudioSessionMapping_identityName,
    deleteStudioSessionMapping_studioId,
    deleteStudioSessionMapping_identityType,

    -- * Destructuring the Response
    DeleteStudioSessionMappingResponse (..),
    newDeleteStudioSessionMappingResponse,
  )
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:/ 'newDeleteStudioSessionMapping' smart constructor.
data DeleteStudioSessionMapping = DeleteStudioSessionMapping'
  { -- | The globally unique identifier (GUID) of the user or group to remove
    -- from the Amazon EMR Studio. 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.
    DeleteStudioSessionMapping -> Maybe Text
identityId :: Prelude.Maybe Prelude.Text,
    -- | The name of the user name or group to remove from the Amazon EMR Studio.
    -- 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 Store API Reference/. Either @IdentityName@
    -- or @IdentityId@ must be specified.
    DeleteStudioSessionMapping -> Maybe Text
identityName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Amazon EMR Studio.
    DeleteStudioSessionMapping -> Text
studioId :: Prelude.Text,
    -- | Specifies whether the identity to delete from the Amazon EMR Studio is a
    -- user or a group.
    DeleteStudioSessionMapping -> IdentityType
identityType :: IdentityType
  }
  deriving (DeleteStudioSessionMapping -> DeleteStudioSessionMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteStudioSessionMapping -> DeleteStudioSessionMapping -> Bool
$c/= :: DeleteStudioSessionMapping -> DeleteStudioSessionMapping -> Bool
== :: DeleteStudioSessionMapping -> DeleteStudioSessionMapping -> Bool
$c== :: DeleteStudioSessionMapping -> DeleteStudioSessionMapping -> Bool
Prelude.Eq, ReadPrec [DeleteStudioSessionMapping]
ReadPrec DeleteStudioSessionMapping
Int -> ReadS DeleteStudioSessionMapping
ReadS [DeleteStudioSessionMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteStudioSessionMapping]
$creadListPrec :: ReadPrec [DeleteStudioSessionMapping]
readPrec :: ReadPrec DeleteStudioSessionMapping
$creadPrec :: ReadPrec DeleteStudioSessionMapping
readList :: ReadS [DeleteStudioSessionMapping]
$creadList :: ReadS [DeleteStudioSessionMapping]
readsPrec :: Int -> ReadS DeleteStudioSessionMapping
$creadsPrec :: Int -> ReadS DeleteStudioSessionMapping
Prelude.Read, Int -> DeleteStudioSessionMapping -> ShowS
[DeleteStudioSessionMapping] -> ShowS
DeleteStudioSessionMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteStudioSessionMapping] -> ShowS
$cshowList :: [DeleteStudioSessionMapping] -> ShowS
show :: DeleteStudioSessionMapping -> String
$cshow :: DeleteStudioSessionMapping -> String
showsPrec :: Int -> DeleteStudioSessionMapping -> ShowS
$cshowsPrec :: Int -> DeleteStudioSessionMapping -> ShowS
Prelude.Show, forall x.
Rep DeleteStudioSessionMapping x -> DeleteStudioSessionMapping
forall x.
DeleteStudioSessionMapping -> Rep DeleteStudioSessionMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteStudioSessionMapping x -> DeleteStudioSessionMapping
$cfrom :: forall x.
DeleteStudioSessionMapping -> Rep DeleteStudioSessionMapping x
Prelude.Generic)

-- |
-- Create a value of 'DeleteStudioSessionMapping' 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', 'deleteStudioSessionMapping_identityId' - The globally unique identifier (GUID) of the user or group to remove
-- from the Amazon EMR Studio. 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', 'deleteStudioSessionMapping_identityName' - The name of the user name or group to remove from the Amazon EMR Studio.
-- 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 Store API Reference/. Either @IdentityName@
-- or @IdentityId@ must be specified.
--
-- 'studioId', 'deleteStudioSessionMapping_studioId' - The ID of the Amazon EMR Studio.
--
-- 'identityType', 'deleteStudioSessionMapping_identityType' - Specifies whether the identity to delete from the Amazon EMR Studio is a
-- user or a group.
newDeleteStudioSessionMapping ::
  -- | 'studioId'
  Prelude.Text ->
  -- | 'identityType'
  IdentityType ->
  DeleteStudioSessionMapping
newDeleteStudioSessionMapping :: Text -> IdentityType -> DeleteStudioSessionMapping
newDeleteStudioSessionMapping
  Text
pStudioId_
  IdentityType
pIdentityType_ =
    DeleteStudioSessionMapping'
      { $sel:identityId:DeleteStudioSessionMapping' :: Maybe Text
identityId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:identityName:DeleteStudioSessionMapping' :: Maybe Text
identityName = forall a. Maybe a
Prelude.Nothing,
        $sel:studioId:DeleteStudioSessionMapping' :: Text
studioId = Text
pStudioId_,
        $sel:identityType:DeleteStudioSessionMapping' :: IdentityType
identityType = IdentityType
pIdentityType_
      }

-- | The globally unique identifier (GUID) of the user or group to remove
-- from the Amazon EMR Studio. 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.
deleteStudioSessionMapping_identityId :: Lens.Lens' DeleteStudioSessionMapping (Prelude.Maybe Prelude.Text)
deleteStudioSessionMapping_identityId :: Lens' DeleteStudioSessionMapping (Maybe Text)
deleteStudioSessionMapping_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStudioSessionMapping' {Maybe Text
identityId :: Maybe Text
$sel:identityId:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Maybe Text
identityId} -> Maybe Text
identityId) (\s :: DeleteStudioSessionMapping
s@DeleteStudioSessionMapping' {} Maybe Text
a -> DeleteStudioSessionMapping
s {$sel:identityId:DeleteStudioSessionMapping' :: Maybe Text
identityId = Maybe Text
a} :: DeleteStudioSessionMapping)

-- | The name of the user name or group to remove from the Amazon EMR Studio.
-- 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 Store API Reference/. Either @IdentityName@
-- or @IdentityId@ must be specified.
deleteStudioSessionMapping_identityName :: Lens.Lens' DeleteStudioSessionMapping (Prelude.Maybe Prelude.Text)
deleteStudioSessionMapping_identityName :: Lens' DeleteStudioSessionMapping (Maybe Text)
deleteStudioSessionMapping_identityName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStudioSessionMapping' {Maybe Text
identityName :: Maybe Text
$sel:identityName:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Maybe Text
identityName} -> Maybe Text
identityName) (\s :: DeleteStudioSessionMapping
s@DeleteStudioSessionMapping' {} Maybe Text
a -> DeleteStudioSessionMapping
s {$sel:identityName:DeleteStudioSessionMapping' :: Maybe Text
identityName = Maybe Text
a} :: DeleteStudioSessionMapping)

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

-- | Specifies whether the identity to delete from the Amazon EMR Studio is a
-- user or a group.
deleteStudioSessionMapping_identityType :: Lens.Lens' DeleteStudioSessionMapping IdentityType
deleteStudioSessionMapping_identityType :: Lens' DeleteStudioSessionMapping IdentityType
deleteStudioSessionMapping_identityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStudioSessionMapping' {IdentityType
identityType :: IdentityType
$sel:identityType:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> IdentityType
identityType} -> IdentityType
identityType) (\s :: DeleteStudioSessionMapping
s@DeleteStudioSessionMapping' {} IdentityType
a -> DeleteStudioSessionMapping
s {$sel:identityType:DeleteStudioSessionMapping' :: IdentityType
identityType = IdentityType
a} :: DeleteStudioSessionMapping)

instance Core.AWSRequest DeleteStudioSessionMapping where
  type
    AWSResponse DeleteStudioSessionMapping =
      DeleteStudioSessionMappingResponse
  request :: (Service -> Service)
-> DeleteStudioSessionMapping -> Request DeleteStudioSessionMapping
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 DeleteStudioSessionMapping
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteStudioSessionMapping)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteStudioSessionMappingResponse
DeleteStudioSessionMappingResponse'

instance Prelude.Hashable DeleteStudioSessionMapping where
  hashWithSalt :: Int -> DeleteStudioSessionMapping -> Int
hashWithSalt Int
_salt DeleteStudioSessionMapping' {Maybe Text
Text
IdentityType
identityType :: IdentityType
studioId :: Text
identityName :: Maybe Text
identityId :: Maybe Text
$sel:identityType:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> IdentityType
$sel:studioId:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Text
$sel:identityName:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Maybe Text
$sel:identityId:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> 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 DeleteStudioSessionMapping where
  rnf :: DeleteStudioSessionMapping -> ()
rnf DeleteStudioSessionMapping' {Maybe Text
Text
IdentityType
identityType :: IdentityType
studioId :: Text
identityName :: Maybe Text
identityId :: Maybe Text
$sel:identityType:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> IdentityType
$sel:studioId:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Text
$sel:identityName:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Maybe Text
$sel:identityId:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> 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 DeleteStudioSessionMapping where
  toHeaders :: DeleteStudioSessionMapping -> [Header]
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 -> [Header]
Data.=# ( ByteString
"ElasticMapReduce.DeleteStudioSessionMapping" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteStudioSessionMapping where
  toJSON :: DeleteStudioSessionMapping -> Value
toJSON DeleteStudioSessionMapping' {Maybe Text
Text
IdentityType
identityType :: IdentityType
studioId :: Text
identityName :: Maybe Text
identityId :: Maybe Text
$sel:identityType:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> IdentityType
$sel:studioId:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Text
$sel:identityName:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> Maybe Text
$sel:identityId:DeleteStudioSessionMapping' :: DeleteStudioSessionMapping -> 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 DeleteStudioSessionMapping where
  toPath :: DeleteStudioSessionMapping -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDeleteStudioSessionMappingResponse' smart constructor.
data DeleteStudioSessionMappingResponse = DeleteStudioSessionMappingResponse'
  {
  }
  deriving (DeleteStudioSessionMappingResponse
-> DeleteStudioSessionMappingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteStudioSessionMappingResponse
-> DeleteStudioSessionMappingResponse -> Bool
$c/= :: DeleteStudioSessionMappingResponse
-> DeleteStudioSessionMappingResponse -> Bool
== :: DeleteStudioSessionMappingResponse
-> DeleteStudioSessionMappingResponse -> Bool
$c== :: DeleteStudioSessionMappingResponse
-> DeleteStudioSessionMappingResponse -> Bool
Prelude.Eq, ReadPrec [DeleteStudioSessionMappingResponse]
ReadPrec DeleteStudioSessionMappingResponse
Int -> ReadS DeleteStudioSessionMappingResponse
ReadS [DeleteStudioSessionMappingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteStudioSessionMappingResponse]
$creadListPrec :: ReadPrec [DeleteStudioSessionMappingResponse]
readPrec :: ReadPrec DeleteStudioSessionMappingResponse
$creadPrec :: ReadPrec DeleteStudioSessionMappingResponse
readList :: ReadS [DeleteStudioSessionMappingResponse]
$creadList :: ReadS [DeleteStudioSessionMappingResponse]
readsPrec :: Int -> ReadS DeleteStudioSessionMappingResponse
$creadsPrec :: Int -> ReadS DeleteStudioSessionMappingResponse
Prelude.Read, Int -> DeleteStudioSessionMappingResponse -> ShowS
[DeleteStudioSessionMappingResponse] -> ShowS
DeleteStudioSessionMappingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteStudioSessionMappingResponse] -> ShowS
$cshowList :: [DeleteStudioSessionMappingResponse] -> ShowS
show :: DeleteStudioSessionMappingResponse -> String
$cshow :: DeleteStudioSessionMappingResponse -> String
showsPrec :: Int -> DeleteStudioSessionMappingResponse -> ShowS
$cshowsPrec :: Int -> DeleteStudioSessionMappingResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteStudioSessionMappingResponse x
-> DeleteStudioSessionMappingResponse
forall x.
DeleteStudioSessionMappingResponse
-> Rep DeleteStudioSessionMappingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteStudioSessionMappingResponse x
-> DeleteStudioSessionMappingResponse
$cfrom :: forall x.
DeleteStudioSessionMappingResponse
-> Rep DeleteStudioSessionMappingResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteStudioSessionMappingResponse' 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.
newDeleteStudioSessionMappingResponse ::
  DeleteStudioSessionMappingResponse
newDeleteStudioSessionMappingResponse :: DeleteStudioSessionMappingResponse
newDeleteStudioSessionMappingResponse =
  DeleteStudioSessionMappingResponse
DeleteStudioSessionMappingResponse'

instance
  Prelude.NFData
    DeleteStudioSessionMappingResponse
  where
  rnf :: DeleteStudioSessionMappingResponse -> ()
rnf DeleteStudioSessionMappingResponse
_ = ()