{-# 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.ConnectParticipant.SendEvent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends an event.
--
-- @ConnectionToken@ is used for invoking this API instead of
-- @ParticipantToken@.
--
-- The Amazon Connect Participant Service APIs do not use
-- <https://docs.aws.amazon.com/general/latest/gr/signature-version-4.html Signature Version 4 authentication>.
module Amazonka.ConnectParticipant.SendEvent
  ( -- * Creating a Request
    SendEvent (..),
    newSendEvent,

    -- * Request Lenses
    sendEvent_clientToken,
    sendEvent_content,
    sendEvent_contentType,
    sendEvent_connectionToken,

    -- * Destructuring the Response
    SendEventResponse (..),
    newSendEventResponse,

    -- * Response Lenses
    sendEventResponse_absoluteTime,
    sendEventResponse_id,
    sendEventResponse_httpStatus,
  )
where

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

-- | /See:/ 'newSendEvent' smart constructor.
data SendEvent = SendEvent'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If not provided, the Amazon Web Services SDK
    -- populates this field. For more information about idempotency, see
    -- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
    SendEvent -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The content of the event to be sent (for example, message text). For
    -- content related to message receipts, this is supported in the form of a
    -- JSON string.
    --
    -- Sample Content:
    -- \"{\\\"messageId\\\":\\\"11111111-aaaa-bbbb-cccc-EXAMPLE01234\\\"}\"
    SendEvent -> Maybe Text
content :: Prelude.Maybe Prelude.Text,
    -- | The content type of the request. Supported types are:
    --
    -- -   application\/vnd.amazonaws.connect.event.typing
    --
    -- -   application\/vnd.amazonaws.connect.event.connection.acknowledged
    --
    -- -   application\/vnd.amazonaws.connect.event.message.delivered
    --
    -- -   application\/vnd.amazonaws.connect.event.message.read
    SendEvent -> Text
contentType :: Prelude.Text,
    -- | The authentication token associated with the participant\'s connection.
    SendEvent -> Text
connectionToken :: Prelude.Text
  }
  deriving (SendEvent -> SendEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendEvent -> SendEvent -> Bool
$c/= :: SendEvent -> SendEvent -> Bool
== :: SendEvent -> SendEvent -> Bool
$c== :: SendEvent -> SendEvent -> Bool
Prelude.Eq, ReadPrec [SendEvent]
ReadPrec SendEvent
Int -> ReadS SendEvent
ReadS [SendEvent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendEvent]
$creadListPrec :: ReadPrec [SendEvent]
readPrec :: ReadPrec SendEvent
$creadPrec :: ReadPrec SendEvent
readList :: ReadS [SendEvent]
$creadList :: ReadS [SendEvent]
readsPrec :: Int -> ReadS SendEvent
$creadsPrec :: Int -> ReadS SendEvent
Prelude.Read, Int -> SendEvent -> ShowS
[SendEvent] -> ShowS
SendEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendEvent] -> ShowS
$cshowList :: [SendEvent] -> ShowS
show :: SendEvent -> String
$cshow :: SendEvent -> String
showsPrec :: Int -> SendEvent -> ShowS
$cshowsPrec :: Int -> SendEvent -> ShowS
Prelude.Show, forall x. Rep SendEvent x -> SendEvent
forall x. SendEvent -> Rep SendEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendEvent x -> SendEvent
$cfrom :: forall x. SendEvent -> Rep SendEvent x
Prelude.Generic)

-- |
-- Create a value of 'SendEvent' 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:
--
-- 'clientToken', 'sendEvent_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
--
-- 'content', 'sendEvent_content' - The content of the event to be sent (for example, message text). For
-- content related to message receipts, this is supported in the form of a
-- JSON string.
--
-- Sample Content:
-- \"{\\\"messageId\\\":\\\"11111111-aaaa-bbbb-cccc-EXAMPLE01234\\\"}\"
--
-- 'contentType', 'sendEvent_contentType' - The content type of the request. Supported types are:
--
-- -   application\/vnd.amazonaws.connect.event.typing
--
-- -   application\/vnd.amazonaws.connect.event.connection.acknowledged
--
-- -   application\/vnd.amazonaws.connect.event.message.delivered
--
-- -   application\/vnd.amazonaws.connect.event.message.read
--
-- 'connectionToken', 'sendEvent_connectionToken' - The authentication token associated with the participant\'s connection.
newSendEvent ::
  -- | 'contentType'
  Prelude.Text ->
  -- | 'connectionToken'
  Prelude.Text ->
  SendEvent
newSendEvent :: Text -> Text -> SendEvent
newSendEvent Text
pContentType_ Text
pConnectionToken_ =
  SendEvent'
    { $sel:clientToken:SendEvent' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:content:SendEvent' :: Maybe Text
content = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:SendEvent' :: Text
contentType = Text
pContentType_,
      $sel:connectionToken:SendEvent' :: Text
connectionToken = Text
pConnectionToken_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
sendEvent_clientToken :: Lens.Lens' SendEvent (Prelude.Maybe Prelude.Text)
sendEvent_clientToken :: Lens' SendEvent (Maybe Text)
sendEvent_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:SendEvent' :: SendEvent -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: SendEvent
s@SendEvent' {} Maybe Text
a -> SendEvent
s {$sel:clientToken:SendEvent' :: Maybe Text
clientToken = Maybe Text
a} :: SendEvent)

-- | The content of the event to be sent (for example, message text). For
-- content related to message receipts, this is supported in the form of a
-- JSON string.
--
-- Sample Content:
-- \"{\\\"messageId\\\":\\\"11111111-aaaa-bbbb-cccc-EXAMPLE01234\\\"}\"
sendEvent_content :: Lens.Lens' SendEvent (Prelude.Maybe Prelude.Text)
sendEvent_content :: Lens' SendEvent (Maybe Text)
sendEvent_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Maybe Text
content :: Maybe Text
$sel:content:SendEvent' :: SendEvent -> Maybe Text
content} -> Maybe Text
content) (\s :: SendEvent
s@SendEvent' {} Maybe Text
a -> SendEvent
s {$sel:content:SendEvent' :: Maybe Text
content = Maybe Text
a} :: SendEvent)

-- | The content type of the request. Supported types are:
--
-- -   application\/vnd.amazonaws.connect.event.typing
--
-- -   application\/vnd.amazonaws.connect.event.connection.acknowledged
--
-- -   application\/vnd.amazonaws.connect.event.message.delivered
--
-- -   application\/vnd.amazonaws.connect.event.message.read
sendEvent_contentType :: Lens.Lens' SendEvent Prelude.Text
sendEvent_contentType :: Lens' SendEvent Text
sendEvent_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Text
contentType :: Text
$sel:contentType:SendEvent' :: SendEvent -> Text
contentType} -> Text
contentType) (\s :: SendEvent
s@SendEvent' {} Text
a -> SendEvent
s {$sel:contentType:SendEvent' :: Text
contentType = Text
a} :: SendEvent)

-- | The authentication token associated with the participant\'s connection.
sendEvent_connectionToken :: Lens.Lens' SendEvent Prelude.Text
sendEvent_connectionToken :: Lens' SendEvent Text
sendEvent_connectionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Text
connectionToken :: Text
$sel:connectionToken:SendEvent' :: SendEvent -> Text
connectionToken} -> Text
connectionToken) (\s :: SendEvent
s@SendEvent' {} Text
a -> SendEvent
s {$sel:connectionToken:SendEvent' :: Text
connectionToken = Text
a} :: SendEvent)

instance Core.AWSRequest SendEvent where
  type AWSResponse SendEvent = SendEventResponse
  request :: (Service -> Service) -> SendEvent -> Request SendEvent
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 SendEvent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SendEvent)))
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 -> Maybe Text -> Int -> SendEventResponse
SendEventResponse'
            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
"AbsoluteTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Id")
            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 SendEvent where
  hashWithSalt :: Int -> SendEvent -> Int
hashWithSalt Int
_salt SendEvent' {Maybe Text
Text
connectionToken :: Text
contentType :: Text
content :: Maybe Text
clientToken :: Maybe Text
$sel:connectionToken:SendEvent' :: SendEvent -> Text
$sel:contentType:SendEvent' :: SendEvent -> Text
$sel:content:SendEvent' :: SendEvent -> Maybe Text
$sel:clientToken:SendEvent' :: SendEvent -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionToken

instance Prelude.NFData SendEvent where
  rnf :: SendEvent -> ()
rnf SendEvent' {Maybe Text
Text
connectionToken :: Text
contentType :: Text
content :: Maybe Text
clientToken :: Maybe Text
$sel:connectionToken:SendEvent' :: SendEvent -> Text
$sel:contentType:SendEvent' :: SendEvent -> Text
$sel:content:SendEvent' :: SendEvent -> Maybe Text
$sel:clientToken:SendEvent' :: SendEvent -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectionToken

instance Data.ToHeaders SendEvent where
  toHeaders :: SendEvent -> ResponseHeaders
toHeaders SendEvent' {Maybe Text
Text
connectionToken :: Text
contentType :: Text
content :: Maybe Text
clientToken :: Maybe Text
$sel:connectionToken:SendEvent' :: SendEvent -> Text
$sel:contentType:SendEvent' :: SendEvent -> Text
$sel:content:SendEvent' :: SendEvent -> Maybe Text
$sel:clientToken:SendEvent' :: SendEvent -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amz-Bearer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
connectionToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON SendEvent where
  toJSON :: SendEvent -> Value
toJSON SendEvent' {Maybe Text
Text
connectionToken :: Text
contentType :: Text
content :: Maybe Text
clientToken :: Maybe Text
$sel:connectionToken:SendEvent' :: SendEvent -> Text
$sel:contentType:SendEvent' :: SendEvent -> Text
$sel:content:SendEvent' :: SendEvent -> Maybe Text
$sel:clientToken:SendEvent' :: SendEvent -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (Key
"Content" 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
content,
            forall a. a -> Maybe a
Prelude.Just (Key
"ContentType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contentType)
          ]
      )

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

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

-- | /See:/ 'newSendEventResponse' smart constructor.
data SendEventResponse = SendEventResponse'
  { -- | The time when the event was sent.
    --
    -- It\'s specified in ISO 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For
    -- example, 2019-11-08T02:41:28.172Z.
    SendEventResponse -> Maybe Text
absoluteTime :: Prelude.Maybe Prelude.Text,
    -- | The ID of the response.
    SendEventResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SendEventResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendEventResponse -> SendEventResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendEventResponse -> SendEventResponse -> Bool
$c/= :: SendEventResponse -> SendEventResponse -> Bool
== :: SendEventResponse -> SendEventResponse -> Bool
$c== :: SendEventResponse -> SendEventResponse -> Bool
Prelude.Eq, ReadPrec [SendEventResponse]
ReadPrec SendEventResponse
Int -> ReadS SendEventResponse
ReadS [SendEventResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendEventResponse]
$creadListPrec :: ReadPrec [SendEventResponse]
readPrec :: ReadPrec SendEventResponse
$creadPrec :: ReadPrec SendEventResponse
readList :: ReadS [SendEventResponse]
$creadList :: ReadS [SendEventResponse]
readsPrec :: Int -> ReadS SendEventResponse
$creadsPrec :: Int -> ReadS SendEventResponse
Prelude.Read, Int -> SendEventResponse -> ShowS
[SendEventResponse] -> ShowS
SendEventResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendEventResponse] -> ShowS
$cshowList :: [SendEventResponse] -> ShowS
show :: SendEventResponse -> String
$cshow :: SendEventResponse -> String
showsPrec :: Int -> SendEventResponse -> ShowS
$cshowsPrec :: Int -> SendEventResponse -> ShowS
Prelude.Show, forall x. Rep SendEventResponse x -> SendEventResponse
forall x. SendEventResponse -> Rep SendEventResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendEventResponse x -> SendEventResponse
$cfrom :: forall x. SendEventResponse -> Rep SendEventResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendEventResponse' 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:
--
-- 'absoluteTime', 'sendEventResponse_absoluteTime' - The time when the event was sent.
--
-- It\'s specified in ISO 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For
-- example, 2019-11-08T02:41:28.172Z.
--
-- 'id', 'sendEventResponse_id' - The ID of the response.
--
-- 'httpStatus', 'sendEventResponse_httpStatus' - The response's http status code.
newSendEventResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendEventResponse
newSendEventResponse :: Int -> SendEventResponse
newSendEventResponse Int
pHttpStatus_ =
  SendEventResponse'
    { $sel:absoluteTime:SendEventResponse' :: Maybe Text
absoluteTime = forall a. Maybe a
Prelude.Nothing,
      $sel:id:SendEventResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SendEventResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The time when the event was sent.
--
-- It\'s specified in ISO 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For
-- example, 2019-11-08T02:41:28.172Z.
sendEventResponse_absoluteTime :: Lens.Lens' SendEventResponse (Prelude.Maybe Prelude.Text)
sendEventResponse_absoluteTime :: Lens' SendEventResponse (Maybe Text)
sendEventResponse_absoluteTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEventResponse' {Maybe Text
absoluteTime :: Maybe Text
$sel:absoluteTime:SendEventResponse' :: SendEventResponse -> Maybe Text
absoluteTime} -> Maybe Text
absoluteTime) (\s :: SendEventResponse
s@SendEventResponse' {} Maybe Text
a -> SendEventResponse
s {$sel:absoluteTime:SendEventResponse' :: Maybe Text
absoluteTime = Maybe Text
a} :: SendEventResponse)

-- | The ID of the response.
sendEventResponse_id :: Lens.Lens' SendEventResponse (Prelude.Maybe Prelude.Text)
sendEventResponse_id :: Lens' SendEventResponse (Maybe Text)
sendEventResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEventResponse' {Maybe Text
id :: Maybe Text
$sel:id:SendEventResponse' :: SendEventResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: SendEventResponse
s@SendEventResponse' {} Maybe Text
a -> SendEventResponse
s {$sel:id:SendEventResponse' :: Maybe Text
id = Maybe Text
a} :: SendEventResponse)

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

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