{-# 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.CognitoIdentity.GetId
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates (or retrieves) a Cognito ID. Supplying multiple logins will
-- create an implicit linked account.
--
-- This is a public API. You do not need any credentials to call this API.
module Amazonka.CognitoIdentity.GetId
  ( -- * Creating a Request
    GetId (..),
    newGetId,

    -- * Request Lenses
    getId_accountId,
    getId_logins,
    getId_identityPoolId,

    -- * Destructuring the Response
    GetIdResponse (..),
    newGetIdResponse,

    -- * Response Lenses
    getIdResponse_identityId,
    getIdResponse_httpStatus,
  )
where

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

-- | Input to the GetId action.
--
-- /See:/ 'newGetId' smart constructor.
data GetId = GetId'
  { -- | A standard AWS account ID (9+ digits).
    GetId -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    -- | A set of optional name-value pairs that map provider names to provider
    -- tokens. The available provider names for @Logins@ are as follows:
    --
    -- -   Facebook: @graph.facebook.com@
    --
    -- -   Amazon Cognito user pool:
    --     @cognito-idp.\<region>.amazonaws.com\/\<YOUR_USER_POOL_ID>@, for
    --     example, @cognito-idp.us-east-1.amazonaws.com\/us-east-1_123456789@.
    --
    -- -   Google: @accounts.google.com@
    --
    -- -   Amazon: @www.amazon.com@
    --
    -- -   Twitter: @api.twitter.com@
    --
    -- -   Digits: @www.digits.com@
    GetId -> Maybe (HashMap Text Text)
logins :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | An identity pool ID in the format REGION:GUID.
    GetId -> Text
identityPoolId :: Prelude.Text
  }
  deriving (GetId -> GetId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetId -> GetId -> Bool
$c/= :: GetId -> GetId -> Bool
== :: GetId -> GetId -> Bool
$c== :: GetId -> GetId -> Bool
Prelude.Eq, ReadPrec [GetId]
ReadPrec GetId
Int -> ReadS GetId
ReadS [GetId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetId]
$creadListPrec :: ReadPrec [GetId]
readPrec :: ReadPrec GetId
$creadPrec :: ReadPrec GetId
readList :: ReadS [GetId]
$creadList :: ReadS [GetId]
readsPrec :: Int -> ReadS GetId
$creadsPrec :: Int -> ReadS GetId
Prelude.Read, Int -> GetId -> ShowS
[GetId] -> ShowS
GetId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetId] -> ShowS
$cshowList :: [GetId] -> ShowS
show :: GetId -> String
$cshow :: GetId -> String
showsPrec :: Int -> GetId -> ShowS
$cshowsPrec :: Int -> GetId -> ShowS
Prelude.Show, forall x. Rep GetId x -> GetId
forall x. GetId -> Rep GetId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetId x -> GetId
$cfrom :: forall x. GetId -> Rep GetId x
Prelude.Generic)

-- |
-- Create a value of 'GetId' 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:
--
-- 'accountId', 'getId_accountId' - A standard AWS account ID (9+ digits).
--
-- 'logins', 'getId_logins' - A set of optional name-value pairs that map provider names to provider
-- tokens. The available provider names for @Logins@ are as follows:
--
-- -   Facebook: @graph.facebook.com@
--
-- -   Amazon Cognito user pool:
--     @cognito-idp.\<region>.amazonaws.com\/\<YOUR_USER_POOL_ID>@, for
--     example, @cognito-idp.us-east-1.amazonaws.com\/us-east-1_123456789@.
--
-- -   Google: @accounts.google.com@
--
-- -   Amazon: @www.amazon.com@
--
-- -   Twitter: @api.twitter.com@
--
-- -   Digits: @www.digits.com@
--
-- 'identityPoolId', 'getId_identityPoolId' - An identity pool ID in the format REGION:GUID.
newGetId ::
  -- | 'identityPoolId'
  Prelude.Text ->
  GetId
newGetId :: Text -> GetId
newGetId Text
pIdentityPoolId_ =
  GetId'
    { $sel:accountId:GetId' :: Maybe Text
accountId = forall a. Maybe a
Prelude.Nothing,
      $sel:logins:GetId' :: Maybe (HashMap Text Text)
logins = forall a. Maybe a
Prelude.Nothing,
      $sel:identityPoolId:GetId' :: Text
identityPoolId = Text
pIdentityPoolId_
    }

-- | A standard AWS account ID (9+ digits).
getId_accountId :: Lens.Lens' GetId (Prelude.Maybe Prelude.Text)
getId_accountId :: Lens' GetId (Maybe Text)
getId_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetId' {Maybe Text
accountId :: Maybe Text
$sel:accountId:GetId' :: GetId -> Maybe Text
accountId} -> Maybe Text
accountId) (\s :: GetId
s@GetId' {} Maybe Text
a -> GetId
s {$sel:accountId:GetId' :: Maybe Text
accountId = Maybe Text
a} :: GetId)

-- | A set of optional name-value pairs that map provider names to provider
-- tokens. The available provider names for @Logins@ are as follows:
--
-- -   Facebook: @graph.facebook.com@
--
-- -   Amazon Cognito user pool:
--     @cognito-idp.\<region>.amazonaws.com\/\<YOUR_USER_POOL_ID>@, for
--     example, @cognito-idp.us-east-1.amazonaws.com\/us-east-1_123456789@.
--
-- -   Google: @accounts.google.com@
--
-- -   Amazon: @www.amazon.com@
--
-- -   Twitter: @api.twitter.com@
--
-- -   Digits: @www.digits.com@
getId_logins :: Lens.Lens' GetId (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getId_logins :: Lens' GetId (Maybe (HashMap Text Text))
getId_logins = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetId' {Maybe (HashMap Text Text)
logins :: Maybe (HashMap Text Text)
$sel:logins:GetId' :: GetId -> Maybe (HashMap Text Text)
logins} -> Maybe (HashMap Text Text)
logins) (\s :: GetId
s@GetId' {} Maybe (HashMap Text Text)
a -> GetId
s {$sel:logins:GetId' :: Maybe (HashMap Text Text)
logins = Maybe (HashMap Text Text)
a} :: GetId) 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

-- | An identity pool ID in the format REGION:GUID.
getId_identityPoolId :: Lens.Lens' GetId Prelude.Text
getId_identityPoolId :: Lens' GetId Text
getId_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetId' {Text
identityPoolId :: Text
$sel:identityPoolId:GetId' :: GetId -> Text
identityPoolId} -> Text
identityPoolId) (\s :: GetId
s@GetId' {} Text
a -> GetId
s {$sel:identityPoolId:GetId' :: Text
identityPoolId = Text
a} :: GetId)

instance Core.AWSRequest GetId where
  type AWSResponse GetId = GetIdResponse
  request :: (Service -> Service) -> GetId -> Request GetId
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 GetId
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetId)))
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 -> Int -> GetIdResponse
GetIdResponse'
            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
"IdentityId")
            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 GetId where
  hashWithSalt :: Int -> GetId -> Int
hashWithSalt Int
_salt GetId' {Maybe Text
Maybe (HashMap Text Text)
Text
identityPoolId :: Text
logins :: Maybe (HashMap Text Text)
accountId :: Maybe Text
$sel:identityPoolId:GetId' :: GetId -> Text
$sel:logins:GetId' :: GetId -> Maybe (HashMap Text Text)
$sel:accountId:GetId' :: GetId -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
logins
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId

instance Prelude.NFData GetId where
  rnf :: GetId -> ()
rnf GetId' {Maybe Text
Maybe (HashMap Text Text)
Text
identityPoolId :: Text
logins :: Maybe (HashMap Text Text)
accountId :: Maybe Text
$sel:identityPoolId:GetId' :: GetId -> Text
$sel:logins:GetId' :: GetId -> Maybe (HashMap Text Text)
$sel:accountId:GetId' :: GetId -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
logins
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identityPoolId

instance Data.ToHeaders GetId where
  toHeaders :: GetId -> 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
"AWSCognitoIdentityService.GetId" ::
                          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 GetId where
  toJSON :: GetId -> Value
toJSON GetId' {Maybe Text
Maybe (HashMap Text Text)
Text
identityPoolId :: Text
logins :: Maybe (HashMap Text Text)
accountId :: Maybe Text
$sel:identityPoolId:GetId' :: GetId -> Text
$sel:logins:GetId' :: GetId -> Maybe (HashMap Text Text)
$sel:accountId:GetId' :: GetId -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountId" 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
accountId,
            (Key
"Logins" 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 (HashMap Text Text)
logins,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityPoolId)
          ]
      )

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

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

-- | Returned in response to a GetId request.
--
-- /See:/ 'newGetIdResponse' smart constructor.
data GetIdResponse = GetIdResponse'
  { -- | A unique identifier in the format REGION:GUID.
    GetIdResponse -> Maybe Text
identityId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetIdResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetIdResponse -> GetIdResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIdResponse -> GetIdResponse -> Bool
$c/= :: GetIdResponse -> GetIdResponse -> Bool
== :: GetIdResponse -> GetIdResponse -> Bool
$c== :: GetIdResponse -> GetIdResponse -> Bool
Prelude.Eq, ReadPrec [GetIdResponse]
ReadPrec GetIdResponse
Int -> ReadS GetIdResponse
ReadS [GetIdResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIdResponse]
$creadListPrec :: ReadPrec [GetIdResponse]
readPrec :: ReadPrec GetIdResponse
$creadPrec :: ReadPrec GetIdResponse
readList :: ReadS [GetIdResponse]
$creadList :: ReadS [GetIdResponse]
readsPrec :: Int -> ReadS GetIdResponse
$creadsPrec :: Int -> ReadS GetIdResponse
Prelude.Read, Int -> GetIdResponse -> ShowS
[GetIdResponse] -> ShowS
GetIdResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIdResponse] -> ShowS
$cshowList :: [GetIdResponse] -> ShowS
show :: GetIdResponse -> String
$cshow :: GetIdResponse -> String
showsPrec :: Int -> GetIdResponse -> ShowS
$cshowsPrec :: Int -> GetIdResponse -> ShowS
Prelude.Show, forall x. Rep GetIdResponse x -> GetIdResponse
forall x. GetIdResponse -> Rep GetIdResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetIdResponse x -> GetIdResponse
$cfrom :: forall x. GetIdResponse -> Rep GetIdResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetIdResponse' 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', 'getIdResponse_identityId' - A unique identifier in the format REGION:GUID.
--
-- 'httpStatus', 'getIdResponse_httpStatus' - The response's http status code.
newGetIdResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetIdResponse
newGetIdResponse :: Int -> GetIdResponse
newGetIdResponse Int
pHttpStatus_ =
  GetIdResponse'
    { $sel:identityId:GetIdResponse' :: Maybe Text
identityId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetIdResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique identifier in the format REGION:GUID.
getIdResponse_identityId :: Lens.Lens' GetIdResponse (Prelude.Maybe Prelude.Text)
getIdResponse_identityId :: Lens' GetIdResponse (Maybe Text)
getIdResponse_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIdResponse' {Maybe Text
identityId :: Maybe Text
$sel:identityId:GetIdResponse' :: GetIdResponse -> Maybe Text
identityId} -> Maybe Text
identityId) (\s :: GetIdResponse
s@GetIdResponse' {} Maybe Text
a -> GetIdResponse
s {$sel:identityId:GetIdResponse' :: Maybe Text
identityId = Maybe Text
a} :: GetIdResponse)

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

instance Prelude.NFData GetIdResponse where
  rnf :: GetIdResponse -> ()
rnf GetIdResponse' {Int
Maybe Text
httpStatus :: Int
identityId :: Maybe Text
$sel:httpStatus:GetIdResponse' :: GetIdResponse -> Int
$sel:identityId:GetIdResponse' :: GetIdResponse -> 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 Int
httpStatus