{-# 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.Chime.PutEventsConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an events configuration that allows a bot to receive outgoing
-- events sent by Amazon Chime. Choose either an HTTPS endpoint or a Lambda
-- function ARN. For more information, see Bot.
module Amazonka.Chime.PutEventsConfiguration
  ( -- * Creating a Request
    PutEventsConfiguration (..),
    newPutEventsConfiguration,

    -- * Request Lenses
    putEventsConfiguration_lambdaFunctionArn,
    putEventsConfiguration_outboundEventsHTTPSEndpoint,
    putEventsConfiguration_accountId,
    putEventsConfiguration_botId,

    -- * Destructuring the Response
    PutEventsConfigurationResponse (..),
    newPutEventsConfigurationResponse,

    -- * Response Lenses
    putEventsConfigurationResponse_eventsConfiguration,
    putEventsConfigurationResponse_httpStatus,
  )
where

import Amazonka.Chime.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:/ 'newPutEventsConfiguration' smart constructor.
data PutEventsConfiguration = PutEventsConfiguration'
  { -- | Lambda function ARN that allows the bot to receive outgoing events.
    PutEventsConfiguration -> Maybe (Sensitive Text)
lambdaFunctionArn :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | HTTPS endpoint that allows the bot to receive outgoing events.
    PutEventsConfiguration -> Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Chime account ID.
    PutEventsConfiguration -> Text
accountId :: Prelude.Text,
    -- | The bot ID.
    PutEventsConfiguration -> Text
botId :: Prelude.Text
  }
  deriving (PutEventsConfiguration -> PutEventsConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEventsConfiguration -> PutEventsConfiguration -> Bool
$c/= :: PutEventsConfiguration -> PutEventsConfiguration -> Bool
== :: PutEventsConfiguration -> PutEventsConfiguration -> Bool
$c== :: PutEventsConfiguration -> PutEventsConfiguration -> Bool
Prelude.Eq, Int -> PutEventsConfiguration -> ShowS
[PutEventsConfiguration] -> ShowS
PutEventsConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEventsConfiguration] -> ShowS
$cshowList :: [PutEventsConfiguration] -> ShowS
show :: PutEventsConfiguration -> String
$cshow :: PutEventsConfiguration -> String
showsPrec :: Int -> PutEventsConfiguration -> ShowS
$cshowsPrec :: Int -> PutEventsConfiguration -> ShowS
Prelude.Show, forall x. Rep PutEventsConfiguration x -> PutEventsConfiguration
forall x. PutEventsConfiguration -> Rep PutEventsConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutEventsConfiguration x -> PutEventsConfiguration
$cfrom :: forall x. PutEventsConfiguration -> Rep PutEventsConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PutEventsConfiguration' 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:
--
-- 'lambdaFunctionArn', 'putEventsConfiguration_lambdaFunctionArn' - Lambda function ARN that allows the bot to receive outgoing events.
--
-- 'outboundEventsHTTPSEndpoint', 'putEventsConfiguration_outboundEventsHTTPSEndpoint' - HTTPS endpoint that allows the bot to receive outgoing events.
--
-- 'accountId', 'putEventsConfiguration_accountId' - The Amazon Chime account ID.
--
-- 'botId', 'putEventsConfiguration_botId' - The bot ID.
newPutEventsConfiguration ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'botId'
  Prelude.Text ->
  PutEventsConfiguration
newPutEventsConfiguration :: Text -> Text -> PutEventsConfiguration
newPutEventsConfiguration Text
pAccountId_ Text
pBotId_ =
  PutEventsConfiguration'
    { $sel:lambdaFunctionArn:PutEventsConfiguration' :: Maybe (Sensitive Text)
lambdaFunctionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:outboundEventsHTTPSEndpoint:PutEventsConfiguration' :: Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:PutEventsConfiguration' :: Text
accountId = Text
pAccountId_,
      $sel:botId:PutEventsConfiguration' :: Text
botId = Text
pBotId_
    }

-- | Lambda function ARN that allows the bot to receive outgoing events.
putEventsConfiguration_lambdaFunctionArn :: Lens.Lens' PutEventsConfiguration (Prelude.Maybe Prelude.Text)
putEventsConfiguration_lambdaFunctionArn :: Lens' PutEventsConfiguration (Maybe Text)
putEventsConfiguration_lambdaFunctionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEventsConfiguration' {Maybe (Sensitive Text)
lambdaFunctionArn :: Maybe (Sensitive Text)
$sel:lambdaFunctionArn:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
lambdaFunctionArn} -> Maybe (Sensitive Text)
lambdaFunctionArn) (\s :: PutEventsConfiguration
s@PutEventsConfiguration' {} Maybe (Sensitive Text)
a -> PutEventsConfiguration
s {$sel:lambdaFunctionArn:PutEventsConfiguration' :: Maybe (Sensitive Text)
lambdaFunctionArn = Maybe (Sensitive Text)
a} :: PutEventsConfiguration) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | HTTPS endpoint that allows the bot to receive outgoing events.
putEventsConfiguration_outboundEventsHTTPSEndpoint :: Lens.Lens' PutEventsConfiguration (Prelude.Maybe Prelude.Text)
putEventsConfiguration_outboundEventsHTTPSEndpoint :: Lens' PutEventsConfiguration (Maybe Text)
putEventsConfiguration_outboundEventsHTTPSEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEventsConfiguration' {Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint :: Maybe (Sensitive Text)
$sel:outboundEventsHTTPSEndpoint:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint} -> Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint) (\s :: PutEventsConfiguration
s@PutEventsConfiguration' {} Maybe (Sensitive Text)
a -> PutEventsConfiguration
s {$sel:outboundEventsHTTPSEndpoint:PutEventsConfiguration' :: Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint = Maybe (Sensitive Text)
a} :: PutEventsConfiguration) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The Amazon Chime account ID.
putEventsConfiguration_accountId :: Lens.Lens' PutEventsConfiguration Prelude.Text
putEventsConfiguration_accountId :: Lens' PutEventsConfiguration Text
putEventsConfiguration_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEventsConfiguration' {Text
accountId :: Text
$sel:accountId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
accountId} -> Text
accountId) (\s :: PutEventsConfiguration
s@PutEventsConfiguration' {} Text
a -> PutEventsConfiguration
s {$sel:accountId:PutEventsConfiguration' :: Text
accountId = Text
a} :: PutEventsConfiguration)

-- | The bot ID.
putEventsConfiguration_botId :: Lens.Lens' PutEventsConfiguration Prelude.Text
putEventsConfiguration_botId :: Lens' PutEventsConfiguration Text
putEventsConfiguration_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEventsConfiguration' {Text
botId :: Text
$sel:botId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
botId} -> Text
botId) (\s :: PutEventsConfiguration
s@PutEventsConfiguration' {} Text
a -> PutEventsConfiguration
s {$sel:botId:PutEventsConfiguration' :: Text
botId = Text
a} :: PutEventsConfiguration)

instance Core.AWSRequest PutEventsConfiguration where
  type
    AWSResponse PutEventsConfiguration =
      PutEventsConfigurationResponse
  request :: (Service -> Service)
-> PutEventsConfiguration -> Request PutEventsConfiguration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutEventsConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutEventsConfiguration)))
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 EventsConfiguration -> Int -> PutEventsConfigurationResponse
PutEventsConfigurationResponse'
            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
"EventsConfiguration")
            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 PutEventsConfiguration where
  hashWithSalt :: Int -> PutEventsConfiguration -> Int
hashWithSalt Int
_salt PutEventsConfiguration' {Maybe (Sensitive Text)
Text
botId :: Text
accountId :: Text
outboundEventsHTTPSEndpoint :: Maybe (Sensitive Text)
lambdaFunctionArn :: Maybe (Sensitive Text)
$sel:botId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:accountId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:outboundEventsHTTPSEndpoint:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
$sel:lambdaFunctionArn:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
lambdaFunctionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botId

instance Prelude.NFData PutEventsConfiguration where
  rnf :: PutEventsConfiguration -> ()
rnf PutEventsConfiguration' {Maybe (Sensitive Text)
Text
botId :: Text
accountId :: Text
outboundEventsHTTPSEndpoint :: Maybe (Sensitive Text)
lambdaFunctionArn :: Maybe (Sensitive Text)
$sel:botId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:accountId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:outboundEventsHTTPSEndpoint:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
$sel:lambdaFunctionArn:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
lambdaFunctionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
outboundEventsHTTPSEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botId

instance Data.ToHeaders PutEventsConfiguration where
  toHeaders :: PutEventsConfiguration -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON PutEventsConfiguration where
  toJSON :: PutEventsConfiguration -> Value
toJSON PutEventsConfiguration' {Maybe (Sensitive Text)
Text
botId :: Text
accountId :: Text
outboundEventsHTTPSEndpoint :: Maybe (Sensitive Text)
lambdaFunctionArn :: Maybe (Sensitive Text)
$sel:botId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:accountId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:outboundEventsHTTPSEndpoint:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
$sel:lambdaFunctionArn:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"LambdaFunctionArn" 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 (Sensitive Text)
lambdaFunctionArn,
            (Key
"OutboundEventsHTTPSEndpoint" 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 (Sensitive Text)
outboundEventsHTTPSEndpoint
          ]
      )

instance Data.ToPath PutEventsConfiguration where
  toPath :: PutEventsConfiguration -> ByteString
toPath PutEventsConfiguration' {Maybe (Sensitive Text)
Text
botId :: Text
accountId :: Text
outboundEventsHTTPSEndpoint :: Maybe (Sensitive Text)
lambdaFunctionArn :: Maybe (Sensitive Text)
$sel:botId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:accountId:PutEventsConfiguration' :: PutEventsConfiguration -> Text
$sel:outboundEventsHTTPSEndpoint:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
$sel:lambdaFunctionArn:PutEventsConfiguration' :: PutEventsConfiguration -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botId,
        ByteString
"/events-configuration"
      ]

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

-- | /See:/ 'newPutEventsConfigurationResponse' smart constructor.
data PutEventsConfigurationResponse = PutEventsConfigurationResponse'
  { PutEventsConfigurationResponse -> Maybe EventsConfiguration
eventsConfiguration :: Prelude.Maybe EventsConfiguration,
    -- | The response's http status code.
    PutEventsConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutEventsConfigurationResponse
-> PutEventsConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEventsConfigurationResponse
-> PutEventsConfigurationResponse -> Bool
$c/= :: PutEventsConfigurationResponse
-> PutEventsConfigurationResponse -> Bool
== :: PutEventsConfigurationResponse
-> PutEventsConfigurationResponse -> Bool
$c== :: PutEventsConfigurationResponse
-> PutEventsConfigurationResponse -> Bool
Prelude.Eq, Int -> PutEventsConfigurationResponse -> ShowS
[PutEventsConfigurationResponse] -> ShowS
PutEventsConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEventsConfigurationResponse] -> ShowS
$cshowList :: [PutEventsConfigurationResponse] -> ShowS
show :: PutEventsConfigurationResponse -> String
$cshow :: PutEventsConfigurationResponse -> String
showsPrec :: Int -> PutEventsConfigurationResponse -> ShowS
$cshowsPrec :: Int -> PutEventsConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep PutEventsConfigurationResponse x
-> PutEventsConfigurationResponse
forall x.
PutEventsConfigurationResponse
-> Rep PutEventsConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutEventsConfigurationResponse x
-> PutEventsConfigurationResponse
$cfrom :: forall x.
PutEventsConfigurationResponse
-> Rep PutEventsConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutEventsConfigurationResponse' 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:
--
-- 'eventsConfiguration', 'putEventsConfigurationResponse_eventsConfiguration' - Undocumented member.
--
-- 'httpStatus', 'putEventsConfigurationResponse_httpStatus' - The response's http status code.
newPutEventsConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutEventsConfigurationResponse
newPutEventsConfigurationResponse :: Int -> PutEventsConfigurationResponse
newPutEventsConfigurationResponse Int
pHttpStatus_ =
  PutEventsConfigurationResponse'
    { $sel:eventsConfiguration:PutEventsConfigurationResponse' :: Maybe EventsConfiguration
eventsConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutEventsConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
putEventsConfigurationResponse_eventsConfiguration :: Lens.Lens' PutEventsConfigurationResponse (Prelude.Maybe EventsConfiguration)
putEventsConfigurationResponse_eventsConfiguration :: Lens' PutEventsConfigurationResponse (Maybe EventsConfiguration)
putEventsConfigurationResponse_eventsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEventsConfigurationResponse' {Maybe EventsConfiguration
eventsConfiguration :: Maybe EventsConfiguration
$sel:eventsConfiguration:PutEventsConfigurationResponse' :: PutEventsConfigurationResponse -> Maybe EventsConfiguration
eventsConfiguration} -> Maybe EventsConfiguration
eventsConfiguration) (\s :: PutEventsConfigurationResponse
s@PutEventsConfigurationResponse' {} Maybe EventsConfiguration
a -> PutEventsConfigurationResponse
s {$sel:eventsConfiguration:PutEventsConfigurationResponse' :: Maybe EventsConfiguration
eventsConfiguration = Maybe EventsConfiguration
a} :: PutEventsConfigurationResponse)

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

instance
  Prelude.NFData
    PutEventsConfigurationResponse
  where
  rnf :: PutEventsConfigurationResponse -> ()
rnf PutEventsConfigurationResponse' {Int
Maybe EventsConfiguration
httpStatus :: Int
eventsConfiguration :: Maybe EventsConfiguration
$sel:httpStatus:PutEventsConfigurationResponse' :: PutEventsConfigurationResponse -> Int
$sel:eventsConfiguration:PutEventsConfigurationResponse' :: PutEventsConfigurationResponse -> Maybe EventsConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EventsConfiguration
eventsConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus