{-# 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.IdentityStore.GetGroupId
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves @GroupId@ in an identity store.
module Amazonka.IdentityStore.GetGroupId
  ( -- * Creating a Request
    GetGroupId (..),
    newGetGroupId,

    -- * Request Lenses
    getGroupId_identityStoreId,
    getGroupId_alternateIdentifier,

    -- * Destructuring the Response
    GetGroupIdResponse (..),
    newGetGroupIdResponse,

    -- * Response Lenses
    getGroupIdResponse_httpStatus,
    getGroupIdResponse_groupId,
    getGroupIdResponse_identityStoreId,
  )
where

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

-- | /See:/ 'newGetGroupId' smart constructor.
data GetGroupId = GetGroupId'
  { -- | The globally unique identifier for the identity store.
    GetGroupId -> Text
identityStoreId :: Prelude.Text,
    -- | A unique identifier for a user or group that is not the primary
    -- identifier. This value can be an identifier from an external identity
    -- provider (IdP) that is associated with the user, the group, or a unique
    -- attribute. For example, a unique @GroupDisplayName@.
    GetGroupId -> AlternateIdentifier
alternateIdentifier :: AlternateIdentifier
  }
  deriving (GetGroupId -> GetGroupId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGroupId -> GetGroupId -> Bool
$c/= :: GetGroupId -> GetGroupId -> Bool
== :: GetGroupId -> GetGroupId -> Bool
$c== :: GetGroupId -> GetGroupId -> Bool
Prelude.Eq, Int -> GetGroupId -> ShowS
[GetGroupId] -> ShowS
GetGroupId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGroupId] -> ShowS
$cshowList :: [GetGroupId] -> ShowS
show :: GetGroupId -> String
$cshow :: GetGroupId -> String
showsPrec :: Int -> GetGroupId -> ShowS
$cshowsPrec :: Int -> GetGroupId -> ShowS
Prelude.Show, forall x. Rep GetGroupId x -> GetGroupId
forall x. GetGroupId -> Rep GetGroupId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetGroupId x -> GetGroupId
$cfrom :: forall x. GetGroupId -> Rep GetGroupId x
Prelude.Generic)

-- |
-- Create a value of 'GetGroupId' 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:
--
-- 'identityStoreId', 'getGroupId_identityStoreId' - The globally unique identifier for the identity store.
--
-- 'alternateIdentifier', 'getGroupId_alternateIdentifier' - A unique identifier for a user or group that is not the primary
-- identifier. This value can be an identifier from an external identity
-- provider (IdP) that is associated with the user, the group, or a unique
-- attribute. For example, a unique @GroupDisplayName@.
newGetGroupId ::
  -- | 'identityStoreId'
  Prelude.Text ->
  -- | 'alternateIdentifier'
  AlternateIdentifier ->
  GetGroupId
newGetGroupId :: Text -> AlternateIdentifier -> GetGroupId
newGetGroupId Text
pIdentityStoreId_ AlternateIdentifier
pAlternateIdentifier_ =
  GetGroupId'
    { $sel:identityStoreId:GetGroupId' :: Text
identityStoreId = Text
pIdentityStoreId_,
      $sel:alternateIdentifier:GetGroupId' :: AlternateIdentifier
alternateIdentifier = AlternateIdentifier
pAlternateIdentifier_
    }

-- | The globally unique identifier for the identity store.
getGroupId_identityStoreId :: Lens.Lens' GetGroupId Prelude.Text
getGroupId_identityStoreId :: Lens' GetGroupId Text
getGroupId_identityStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGroupId' {Text
identityStoreId :: Text
$sel:identityStoreId:GetGroupId' :: GetGroupId -> Text
identityStoreId} -> Text
identityStoreId) (\s :: GetGroupId
s@GetGroupId' {} Text
a -> GetGroupId
s {$sel:identityStoreId:GetGroupId' :: Text
identityStoreId = Text
a} :: GetGroupId)

-- | A unique identifier for a user or group that is not the primary
-- identifier. This value can be an identifier from an external identity
-- provider (IdP) that is associated with the user, the group, or a unique
-- attribute. For example, a unique @GroupDisplayName@.
getGroupId_alternateIdentifier :: Lens.Lens' GetGroupId AlternateIdentifier
getGroupId_alternateIdentifier :: Lens' GetGroupId AlternateIdentifier
getGroupId_alternateIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGroupId' {AlternateIdentifier
alternateIdentifier :: AlternateIdentifier
$sel:alternateIdentifier:GetGroupId' :: GetGroupId -> AlternateIdentifier
alternateIdentifier} -> AlternateIdentifier
alternateIdentifier) (\s :: GetGroupId
s@GetGroupId' {} AlternateIdentifier
a -> GetGroupId
s {$sel:alternateIdentifier:GetGroupId' :: AlternateIdentifier
alternateIdentifier = AlternateIdentifier
a} :: GetGroupId)

instance Core.AWSRequest GetGroupId where
  type AWSResponse GetGroupId = GetGroupIdResponse
  request :: (Service -> Service) -> GetGroupId -> Request GetGroupId
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 GetGroupId
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetGroupId)))
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 ->
          Int -> Text -> Text -> GetGroupIdResponse
GetGroupIdResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"GroupId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"IdentityStoreId")
      )

instance Prelude.Hashable GetGroupId where
  hashWithSalt :: Int -> GetGroupId -> Int
hashWithSalt Int
_salt GetGroupId' {Text
AlternateIdentifier
alternateIdentifier :: AlternateIdentifier
identityStoreId :: Text
$sel:alternateIdentifier:GetGroupId' :: GetGroupId -> AlternateIdentifier
$sel:identityStoreId:GetGroupId' :: GetGroupId -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityStoreId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AlternateIdentifier
alternateIdentifier

instance Prelude.NFData GetGroupId where
  rnf :: GetGroupId -> ()
rnf GetGroupId' {Text
AlternateIdentifier
alternateIdentifier :: AlternateIdentifier
identityStoreId :: Text
$sel:alternateIdentifier:GetGroupId' :: GetGroupId -> AlternateIdentifier
$sel:identityStoreId:GetGroupId' :: GetGroupId -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identityStoreId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AlternateIdentifier
alternateIdentifier

instance Data.ToHeaders GetGroupId where
  toHeaders :: GetGroupId -> 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
"AWSIdentityStore.GetGroupId" ::
                          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 GetGroupId where
  toJSON :: GetGroupId -> Value
toJSON GetGroupId' {Text
AlternateIdentifier
alternateIdentifier :: AlternateIdentifier
identityStoreId :: Text
$sel:alternateIdentifier:GetGroupId' :: GetGroupId -> AlternateIdentifier
$sel:identityStoreId:GetGroupId' :: GetGroupId -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityStoreId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityStoreId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AlternateIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AlternateIdentifier
alternateIdentifier)
          ]
      )

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

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

-- | /See:/ 'newGetGroupIdResponse' smart constructor.
data GetGroupIdResponse = GetGroupIdResponse'
  { -- | The response's http status code.
    GetGroupIdResponse -> Int
httpStatus :: Prelude.Int,
    -- | The identifier for a group in the identity store.
    GetGroupIdResponse -> Text
groupId :: Prelude.Text,
    -- | The globally unique identifier for the identity store.
    GetGroupIdResponse -> Text
identityStoreId :: Prelude.Text
  }
  deriving (GetGroupIdResponse -> GetGroupIdResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGroupIdResponse -> GetGroupIdResponse -> Bool
$c/= :: GetGroupIdResponse -> GetGroupIdResponse -> Bool
== :: GetGroupIdResponse -> GetGroupIdResponse -> Bool
$c== :: GetGroupIdResponse -> GetGroupIdResponse -> Bool
Prelude.Eq, ReadPrec [GetGroupIdResponse]
ReadPrec GetGroupIdResponse
Int -> ReadS GetGroupIdResponse
ReadS [GetGroupIdResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGroupIdResponse]
$creadListPrec :: ReadPrec [GetGroupIdResponse]
readPrec :: ReadPrec GetGroupIdResponse
$creadPrec :: ReadPrec GetGroupIdResponse
readList :: ReadS [GetGroupIdResponse]
$creadList :: ReadS [GetGroupIdResponse]
readsPrec :: Int -> ReadS GetGroupIdResponse
$creadsPrec :: Int -> ReadS GetGroupIdResponse
Prelude.Read, Int -> GetGroupIdResponse -> ShowS
[GetGroupIdResponse] -> ShowS
GetGroupIdResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGroupIdResponse] -> ShowS
$cshowList :: [GetGroupIdResponse] -> ShowS
show :: GetGroupIdResponse -> String
$cshow :: GetGroupIdResponse -> String
showsPrec :: Int -> GetGroupIdResponse -> ShowS
$cshowsPrec :: Int -> GetGroupIdResponse -> ShowS
Prelude.Show, forall x. Rep GetGroupIdResponse x -> GetGroupIdResponse
forall x. GetGroupIdResponse -> Rep GetGroupIdResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetGroupIdResponse x -> GetGroupIdResponse
$cfrom :: forall x. GetGroupIdResponse -> Rep GetGroupIdResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetGroupIdResponse' 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:
--
-- 'httpStatus', 'getGroupIdResponse_httpStatus' - The response's http status code.
--
-- 'groupId', 'getGroupIdResponse_groupId' - The identifier for a group in the identity store.
--
-- 'identityStoreId', 'getGroupIdResponse_identityStoreId' - The globally unique identifier for the identity store.
newGetGroupIdResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'groupId'
  Prelude.Text ->
  -- | 'identityStoreId'
  Prelude.Text ->
  GetGroupIdResponse
newGetGroupIdResponse :: Int -> Text -> Text -> GetGroupIdResponse
newGetGroupIdResponse
  Int
pHttpStatus_
  Text
pGroupId_
  Text
pIdentityStoreId_ =
    GetGroupIdResponse'
      { $sel:httpStatus:GetGroupIdResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:groupId:GetGroupIdResponse' :: Text
groupId = Text
pGroupId_,
        $sel:identityStoreId:GetGroupIdResponse' :: Text
identityStoreId = Text
pIdentityStoreId_
      }

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

-- | The identifier for a group in the identity store.
getGroupIdResponse_groupId :: Lens.Lens' GetGroupIdResponse Prelude.Text
getGroupIdResponse_groupId :: Lens' GetGroupIdResponse Text
getGroupIdResponse_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGroupIdResponse' {Text
groupId :: Text
$sel:groupId:GetGroupIdResponse' :: GetGroupIdResponse -> Text
groupId} -> Text
groupId) (\s :: GetGroupIdResponse
s@GetGroupIdResponse' {} Text
a -> GetGroupIdResponse
s {$sel:groupId:GetGroupIdResponse' :: Text
groupId = Text
a} :: GetGroupIdResponse)

-- | The globally unique identifier for the identity store.
getGroupIdResponse_identityStoreId :: Lens.Lens' GetGroupIdResponse Prelude.Text
getGroupIdResponse_identityStoreId :: Lens' GetGroupIdResponse Text
getGroupIdResponse_identityStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGroupIdResponse' {Text
identityStoreId :: Text
$sel:identityStoreId:GetGroupIdResponse' :: GetGroupIdResponse -> Text
identityStoreId} -> Text
identityStoreId) (\s :: GetGroupIdResponse
s@GetGroupIdResponse' {} Text
a -> GetGroupIdResponse
s {$sel:identityStoreId:GetGroupIdResponse' :: Text
identityStoreId = Text
a} :: GetGroupIdResponse)

instance Prelude.NFData GetGroupIdResponse where
  rnf :: GetGroupIdResponse -> ()
rnf GetGroupIdResponse' {Int
Text
identityStoreId :: Text
groupId :: Text
httpStatus :: Int
$sel:identityStoreId:GetGroupIdResponse' :: GetGroupIdResponse -> Text
$sel:groupId:GetGroupIdResponse' :: GetGroupIdResponse -> Text
$sel:httpStatus:GetGroupIdResponse' :: GetGroupIdResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
groupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityStoreId