{-# 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.CognitoSync.GetCognitoEvents
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the events and the corresponding Lambda functions associated with
-- an identity pool.
--
-- This API can only be called with developer credentials. You cannot call
-- this API with the temporary user credentials provided by Cognito
-- Identity.
module Amazonka.CognitoSync.GetCognitoEvents
  ( -- * Creating a Request
    GetCognitoEvents (..),
    newGetCognitoEvents,

    -- * Request Lenses
    getCognitoEvents_identityPoolId,

    -- * Destructuring the Response
    GetCognitoEventsResponse (..),
    newGetCognitoEventsResponse,

    -- * Response Lenses
    getCognitoEventsResponse_events,
    getCognitoEventsResponse_httpStatus,
  )
where

import Amazonka.CognitoSync.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

-- | A request for a list of the configured Cognito Events
--
-- /See:/ 'newGetCognitoEvents' smart constructor.
data GetCognitoEvents = GetCognitoEvents'
  { -- | The Cognito Identity Pool ID for the request
    GetCognitoEvents -> Text
identityPoolId :: Prelude.Text
  }
  deriving (GetCognitoEvents -> GetCognitoEvents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCognitoEvents -> GetCognitoEvents -> Bool
$c/= :: GetCognitoEvents -> GetCognitoEvents -> Bool
== :: GetCognitoEvents -> GetCognitoEvents -> Bool
$c== :: GetCognitoEvents -> GetCognitoEvents -> Bool
Prelude.Eq, ReadPrec [GetCognitoEvents]
ReadPrec GetCognitoEvents
Int -> ReadS GetCognitoEvents
ReadS [GetCognitoEvents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCognitoEvents]
$creadListPrec :: ReadPrec [GetCognitoEvents]
readPrec :: ReadPrec GetCognitoEvents
$creadPrec :: ReadPrec GetCognitoEvents
readList :: ReadS [GetCognitoEvents]
$creadList :: ReadS [GetCognitoEvents]
readsPrec :: Int -> ReadS GetCognitoEvents
$creadsPrec :: Int -> ReadS GetCognitoEvents
Prelude.Read, Int -> GetCognitoEvents -> ShowS
[GetCognitoEvents] -> ShowS
GetCognitoEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCognitoEvents] -> ShowS
$cshowList :: [GetCognitoEvents] -> ShowS
show :: GetCognitoEvents -> String
$cshow :: GetCognitoEvents -> String
showsPrec :: Int -> GetCognitoEvents -> ShowS
$cshowsPrec :: Int -> GetCognitoEvents -> ShowS
Prelude.Show, forall x. Rep GetCognitoEvents x -> GetCognitoEvents
forall x. GetCognitoEvents -> Rep GetCognitoEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCognitoEvents x -> GetCognitoEvents
$cfrom :: forall x. GetCognitoEvents -> Rep GetCognitoEvents x
Prelude.Generic)

-- |
-- Create a value of 'GetCognitoEvents' 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:
--
-- 'identityPoolId', 'getCognitoEvents_identityPoolId' - The Cognito Identity Pool ID for the request
newGetCognitoEvents ::
  -- | 'identityPoolId'
  Prelude.Text ->
  GetCognitoEvents
newGetCognitoEvents :: Text -> GetCognitoEvents
newGetCognitoEvents Text
pIdentityPoolId_ =
  GetCognitoEvents'
    { $sel:identityPoolId:GetCognitoEvents' :: Text
identityPoolId =
        Text
pIdentityPoolId_
    }

-- | The Cognito Identity Pool ID for the request
getCognitoEvents_identityPoolId :: Lens.Lens' GetCognitoEvents Prelude.Text
getCognitoEvents_identityPoolId :: Lens' GetCognitoEvents Text
getCognitoEvents_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCognitoEvents' {Text
identityPoolId :: Text
$sel:identityPoolId:GetCognitoEvents' :: GetCognitoEvents -> Text
identityPoolId} -> Text
identityPoolId) (\s :: GetCognitoEvents
s@GetCognitoEvents' {} Text
a -> GetCognitoEvents
s {$sel:identityPoolId:GetCognitoEvents' :: Text
identityPoolId = Text
a} :: GetCognitoEvents)

instance Core.AWSRequest GetCognitoEvents where
  type
    AWSResponse GetCognitoEvents =
      GetCognitoEventsResponse
  request :: (Service -> Service)
-> GetCognitoEvents -> Request GetCognitoEvents
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetCognitoEvents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCognitoEvents)))
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 (HashMap Text Text) -> Int -> GetCognitoEventsResponse
GetCognitoEventsResponse'
            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
"Events" 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 GetCognitoEvents where
  hashWithSalt :: Int -> GetCognitoEvents -> Int
hashWithSalt Int
_salt GetCognitoEvents' {Text
identityPoolId :: Text
$sel:identityPoolId:GetCognitoEvents' :: GetCognitoEvents -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId

instance Prelude.NFData GetCognitoEvents where
  rnf :: GetCognitoEvents -> ()
rnf GetCognitoEvents' {Text
identityPoolId :: Text
$sel:identityPoolId:GetCognitoEvents' :: GetCognitoEvents -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identityPoolId

instance Data.ToHeaders GetCognitoEvents where
  toHeaders :: GetCognitoEvents -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetCognitoEvents where
  toPath :: GetCognitoEvents -> ByteString
toPath GetCognitoEvents' {Text
identityPoolId :: Text
$sel:identityPoolId:GetCognitoEvents' :: GetCognitoEvents -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/identitypools/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
identityPoolId,
        ByteString
"/events"
      ]

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

-- | The response from the GetCognitoEvents request
--
-- /See:/ 'newGetCognitoEventsResponse' smart constructor.
data GetCognitoEventsResponse = GetCognitoEventsResponse'
  { -- | The Cognito Events returned from the GetCognitoEvents request
    GetCognitoEventsResponse -> Maybe (HashMap Text Text)
events :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetCognitoEventsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCognitoEventsResponse -> GetCognitoEventsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCognitoEventsResponse -> GetCognitoEventsResponse -> Bool
$c/= :: GetCognitoEventsResponse -> GetCognitoEventsResponse -> Bool
== :: GetCognitoEventsResponse -> GetCognitoEventsResponse -> Bool
$c== :: GetCognitoEventsResponse -> GetCognitoEventsResponse -> Bool
Prelude.Eq, ReadPrec [GetCognitoEventsResponse]
ReadPrec GetCognitoEventsResponse
Int -> ReadS GetCognitoEventsResponse
ReadS [GetCognitoEventsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCognitoEventsResponse]
$creadListPrec :: ReadPrec [GetCognitoEventsResponse]
readPrec :: ReadPrec GetCognitoEventsResponse
$creadPrec :: ReadPrec GetCognitoEventsResponse
readList :: ReadS [GetCognitoEventsResponse]
$creadList :: ReadS [GetCognitoEventsResponse]
readsPrec :: Int -> ReadS GetCognitoEventsResponse
$creadsPrec :: Int -> ReadS GetCognitoEventsResponse
Prelude.Read, Int -> GetCognitoEventsResponse -> ShowS
[GetCognitoEventsResponse] -> ShowS
GetCognitoEventsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCognitoEventsResponse] -> ShowS
$cshowList :: [GetCognitoEventsResponse] -> ShowS
show :: GetCognitoEventsResponse -> String
$cshow :: GetCognitoEventsResponse -> String
showsPrec :: Int -> GetCognitoEventsResponse -> ShowS
$cshowsPrec :: Int -> GetCognitoEventsResponse -> ShowS
Prelude.Show, forall x.
Rep GetCognitoEventsResponse x -> GetCognitoEventsResponse
forall x.
GetCognitoEventsResponse -> Rep GetCognitoEventsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCognitoEventsResponse x -> GetCognitoEventsResponse
$cfrom :: forall x.
GetCognitoEventsResponse -> Rep GetCognitoEventsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCognitoEventsResponse' 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:
--
-- 'events', 'getCognitoEventsResponse_events' - The Cognito Events returned from the GetCognitoEvents request
--
-- 'httpStatus', 'getCognitoEventsResponse_httpStatus' - The response's http status code.
newGetCognitoEventsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCognitoEventsResponse
newGetCognitoEventsResponse :: Int -> GetCognitoEventsResponse
newGetCognitoEventsResponse Int
pHttpStatus_ =
  GetCognitoEventsResponse'
    { $sel:events:GetCognitoEventsResponse' :: Maybe (HashMap Text Text)
events = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCognitoEventsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Cognito Events returned from the GetCognitoEvents request
getCognitoEventsResponse_events :: Lens.Lens' GetCognitoEventsResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getCognitoEventsResponse_events :: Lens' GetCognitoEventsResponse (Maybe (HashMap Text Text))
getCognitoEventsResponse_events = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCognitoEventsResponse' {Maybe (HashMap Text Text)
events :: Maybe (HashMap Text Text)
$sel:events:GetCognitoEventsResponse' :: GetCognitoEventsResponse -> Maybe (HashMap Text Text)
events} -> Maybe (HashMap Text Text)
events) (\s :: GetCognitoEventsResponse
s@GetCognitoEventsResponse' {} Maybe (HashMap Text Text)
a -> GetCognitoEventsResponse
s {$sel:events:GetCognitoEventsResponse' :: Maybe (HashMap Text Text)
events = Maybe (HashMap Text Text)
a} :: GetCognitoEventsResponse) 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.
getCognitoEventsResponse_httpStatus :: Lens.Lens' GetCognitoEventsResponse Prelude.Int
getCognitoEventsResponse_httpStatus :: Lens' GetCognitoEventsResponse Int
getCognitoEventsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCognitoEventsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetCognitoEventsResponse' :: GetCognitoEventsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetCognitoEventsResponse
s@GetCognitoEventsResponse' {} Int
a -> GetCognitoEventsResponse
s {$sel:httpStatus:GetCognitoEventsResponse' :: Int
httpStatus = Int
a} :: GetCognitoEventsResponse)

instance Prelude.NFData GetCognitoEventsResponse where
  rnf :: GetCognitoEventsResponse -> ()
rnf GetCognitoEventsResponse' {Int
Maybe (HashMap Text Text)
httpStatus :: Int
events :: Maybe (HashMap Text Text)
$sel:httpStatus:GetCognitoEventsResponse' :: GetCognitoEventsResponse -> Int
$sel:events:GetCognitoEventsResponse' :: GetCognitoEventsResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
events
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus