{-# 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.MarketplaceMetering.RegisterUsage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Paid container software products sold through AWS Marketplace must
-- integrate with the AWS Marketplace Metering Service and call the
-- @RegisterUsage@ operation for software entitlement and metering. Free
-- and BYOL products for Amazon ECS or Amazon EKS aren\'t required to call
-- @RegisterUsage@, but you may choose to do so if you would like to
-- receive usage data in your seller reports. The sections below explain
-- the behavior of @RegisterUsage@. @RegisterUsage@ performs two primary
-- functions: metering and entitlement.
--
-- -   /Entitlement/: @RegisterUsage@ allows you to verify that the
--     customer running your paid software is subscribed to your product on
--     AWS Marketplace, enabling you to guard against unauthorized use.
--     Your container image that integrates with @RegisterUsage@ is only
--     required to guard against unauthorized use at container startup, as
--     such a @CustomerNotSubscribedException@ or
--     @PlatformNotSupportedException@ will only be thrown on the initial
--     call to @RegisterUsage@. Subsequent calls from the same Amazon ECS
--     task instance (e.g. task-id) or Amazon EKS pod will not throw a
--     @CustomerNotSubscribedException@, even if the customer unsubscribes
--     while the Amazon ECS task or Amazon EKS pod is still running.
--
-- -   /Metering/: @RegisterUsage@ meters software use per ECS task, per
--     hour, or per pod for Amazon EKS with usage prorated to the second. A
--     minimum of 1 minute of usage applies to tasks that are short lived.
--     For example, if a customer has a 10 node Amazon ECS or Amazon EKS
--     cluster and a service configured as a Daemon Set, then Amazon ECS or
--     Amazon EKS will launch a task on all 10 cluster nodes and the
--     customer will be charged: (10 * hourly_rate). Metering for software
--     use is automatically handled by the AWS Marketplace Metering Control
--     Plane -- your software is not required to perform any metering
--     specific actions, other than call @RegisterUsage@ once for metering
--     of software use to commence. The AWS Marketplace Metering Control
--     Plane will also continue to bill customers for running ECS tasks and
--     Amazon EKS pods, regardless of the customers subscription state,
--     removing the need for your software to perform entitlement checks at
--     runtime.
module Amazonka.MarketplaceMetering.RegisterUsage
  ( -- * Creating a Request
    RegisterUsage (..),
    newRegisterUsage,

    -- * Request Lenses
    registerUsage_nonce,
    registerUsage_productCode,
    registerUsage_publicKeyVersion,

    -- * Destructuring the Response
    RegisterUsageResponse (..),
    newRegisterUsageResponse,

    -- * Response Lenses
    registerUsageResponse_publicKeyRotationTimestamp,
    registerUsageResponse_signature,
    registerUsageResponse_httpStatus,
  )
where

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

-- | /See:/ 'newRegisterUsage' smart constructor.
data RegisterUsage = RegisterUsage'
  { -- | (Optional) To scope down the registration to a specific running software
    -- instance and guard against replay attacks.
    RegisterUsage -> Maybe Text
nonce :: Prelude.Maybe Prelude.Text,
    -- | Product code is used to uniquely identify a product in AWS Marketplace.
    -- The product code should be the same as the one used during the
    -- publishing of a new product.
    RegisterUsage -> Text
productCode :: Prelude.Text,
    -- | Public Key Version provided by AWS Marketplace
    RegisterUsage -> Natural
publicKeyVersion :: Prelude.Natural
  }
  deriving (RegisterUsage -> RegisterUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterUsage -> RegisterUsage -> Bool
$c/= :: RegisterUsage -> RegisterUsage -> Bool
== :: RegisterUsage -> RegisterUsage -> Bool
$c== :: RegisterUsage -> RegisterUsage -> Bool
Prelude.Eq, ReadPrec [RegisterUsage]
ReadPrec RegisterUsage
Int -> ReadS RegisterUsage
ReadS [RegisterUsage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterUsage]
$creadListPrec :: ReadPrec [RegisterUsage]
readPrec :: ReadPrec RegisterUsage
$creadPrec :: ReadPrec RegisterUsage
readList :: ReadS [RegisterUsage]
$creadList :: ReadS [RegisterUsage]
readsPrec :: Int -> ReadS RegisterUsage
$creadsPrec :: Int -> ReadS RegisterUsage
Prelude.Read, Int -> RegisterUsage -> ShowS
[RegisterUsage] -> ShowS
RegisterUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterUsage] -> ShowS
$cshowList :: [RegisterUsage] -> ShowS
show :: RegisterUsage -> String
$cshow :: RegisterUsage -> String
showsPrec :: Int -> RegisterUsage -> ShowS
$cshowsPrec :: Int -> RegisterUsage -> ShowS
Prelude.Show, forall x. Rep RegisterUsage x -> RegisterUsage
forall x. RegisterUsage -> Rep RegisterUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterUsage x -> RegisterUsage
$cfrom :: forall x. RegisterUsage -> Rep RegisterUsage x
Prelude.Generic)

-- |
-- Create a value of 'RegisterUsage' 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:
--
-- 'nonce', 'registerUsage_nonce' - (Optional) To scope down the registration to a specific running software
-- instance and guard against replay attacks.
--
-- 'productCode', 'registerUsage_productCode' - Product code is used to uniquely identify a product in AWS Marketplace.
-- The product code should be the same as the one used during the
-- publishing of a new product.
--
-- 'publicKeyVersion', 'registerUsage_publicKeyVersion' - Public Key Version provided by AWS Marketplace
newRegisterUsage ::
  -- | 'productCode'
  Prelude.Text ->
  -- | 'publicKeyVersion'
  Prelude.Natural ->
  RegisterUsage
newRegisterUsage :: Text -> Natural -> RegisterUsage
newRegisterUsage Text
pProductCode_ Natural
pPublicKeyVersion_ =
  RegisterUsage'
    { $sel:nonce:RegisterUsage' :: Maybe Text
nonce = forall a. Maybe a
Prelude.Nothing,
      $sel:productCode:RegisterUsage' :: Text
productCode = Text
pProductCode_,
      $sel:publicKeyVersion:RegisterUsage' :: Natural
publicKeyVersion = Natural
pPublicKeyVersion_
    }

-- | (Optional) To scope down the registration to a specific running software
-- instance and guard against replay attacks.
registerUsage_nonce :: Lens.Lens' RegisterUsage (Prelude.Maybe Prelude.Text)
registerUsage_nonce :: Lens' RegisterUsage (Maybe Text)
registerUsage_nonce = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterUsage' {Maybe Text
nonce :: Maybe Text
$sel:nonce:RegisterUsage' :: RegisterUsage -> Maybe Text
nonce} -> Maybe Text
nonce) (\s :: RegisterUsage
s@RegisterUsage' {} Maybe Text
a -> RegisterUsage
s {$sel:nonce:RegisterUsage' :: Maybe Text
nonce = Maybe Text
a} :: RegisterUsage)

-- | Product code is used to uniquely identify a product in AWS Marketplace.
-- The product code should be the same as the one used during the
-- publishing of a new product.
registerUsage_productCode :: Lens.Lens' RegisterUsage Prelude.Text
registerUsage_productCode :: Lens' RegisterUsage Text
registerUsage_productCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterUsage' {Text
productCode :: Text
$sel:productCode:RegisterUsage' :: RegisterUsage -> Text
productCode} -> Text
productCode) (\s :: RegisterUsage
s@RegisterUsage' {} Text
a -> RegisterUsage
s {$sel:productCode:RegisterUsage' :: Text
productCode = Text
a} :: RegisterUsage)

-- | Public Key Version provided by AWS Marketplace
registerUsage_publicKeyVersion :: Lens.Lens' RegisterUsage Prelude.Natural
registerUsage_publicKeyVersion :: Lens' RegisterUsage Natural
registerUsage_publicKeyVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterUsage' {Natural
publicKeyVersion :: Natural
$sel:publicKeyVersion:RegisterUsage' :: RegisterUsage -> Natural
publicKeyVersion} -> Natural
publicKeyVersion) (\s :: RegisterUsage
s@RegisterUsage' {} Natural
a -> RegisterUsage
s {$sel:publicKeyVersion:RegisterUsage' :: Natural
publicKeyVersion = Natural
a} :: RegisterUsage)

instance Core.AWSRequest RegisterUsage where
  type
    AWSResponse RegisterUsage =
      RegisterUsageResponse
  request :: (Service -> Service) -> RegisterUsage -> Request RegisterUsage
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 RegisterUsage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RegisterUsage)))
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 POSIX -> Maybe Text -> Int -> RegisterUsageResponse
RegisterUsageResponse'
            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
"PublicKeyRotationTimestamp")
            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
"Signature")
            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 RegisterUsage where
  hashWithSalt :: Int -> RegisterUsage -> Int
hashWithSalt Int
_salt RegisterUsage' {Natural
Maybe Text
Text
publicKeyVersion :: Natural
productCode :: Text
nonce :: Maybe Text
$sel:publicKeyVersion:RegisterUsage' :: RegisterUsage -> Natural
$sel:productCode:RegisterUsage' :: RegisterUsage -> Text
$sel:nonce:RegisterUsage' :: RegisterUsage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nonce
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
productCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
publicKeyVersion

instance Prelude.NFData RegisterUsage where
  rnf :: RegisterUsage -> ()
rnf RegisterUsage' {Natural
Maybe Text
Text
publicKeyVersion :: Natural
productCode :: Text
nonce :: Maybe Text
$sel:publicKeyVersion:RegisterUsage' :: RegisterUsage -> Natural
$sel:productCode:RegisterUsage' :: RegisterUsage -> Text
$sel:nonce:RegisterUsage' :: RegisterUsage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nonce
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
productCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
publicKeyVersion

instance Data.ToHeaders RegisterUsage where
  toHeaders :: RegisterUsage -> 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
"AWSMPMeteringService.RegisterUsage" ::
                          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 RegisterUsage where
  toJSON :: RegisterUsage -> Value
toJSON RegisterUsage' {Natural
Maybe Text
Text
publicKeyVersion :: Natural
productCode :: Text
nonce :: Maybe Text
$sel:publicKeyVersion:RegisterUsage' :: RegisterUsage -> Natural
$sel:productCode:RegisterUsage' :: RegisterUsage -> Text
$sel:nonce:RegisterUsage' :: RegisterUsage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Nonce" 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
nonce,
            forall a. a -> Maybe a
Prelude.Just (Key
"ProductCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
productCode),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PublicKeyVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
publicKeyVersion)
          ]
      )

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

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

-- | /See:/ 'newRegisterUsageResponse' smart constructor.
data RegisterUsageResponse = RegisterUsageResponse'
  { -- | (Optional) Only included when public key version has expired
    RegisterUsageResponse -> Maybe POSIX
publicKeyRotationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | JWT Token
    RegisterUsageResponse -> Maybe Text
signature :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterUsageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterUsageResponse -> RegisterUsageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterUsageResponse -> RegisterUsageResponse -> Bool
$c/= :: RegisterUsageResponse -> RegisterUsageResponse -> Bool
== :: RegisterUsageResponse -> RegisterUsageResponse -> Bool
$c== :: RegisterUsageResponse -> RegisterUsageResponse -> Bool
Prelude.Eq, ReadPrec [RegisterUsageResponse]
ReadPrec RegisterUsageResponse
Int -> ReadS RegisterUsageResponse
ReadS [RegisterUsageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterUsageResponse]
$creadListPrec :: ReadPrec [RegisterUsageResponse]
readPrec :: ReadPrec RegisterUsageResponse
$creadPrec :: ReadPrec RegisterUsageResponse
readList :: ReadS [RegisterUsageResponse]
$creadList :: ReadS [RegisterUsageResponse]
readsPrec :: Int -> ReadS RegisterUsageResponse
$creadsPrec :: Int -> ReadS RegisterUsageResponse
Prelude.Read, Int -> RegisterUsageResponse -> ShowS
[RegisterUsageResponse] -> ShowS
RegisterUsageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterUsageResponse] -> ShowS
$cshowList :: [RegisterUsageResponse] -> ShowS
show :: RegisterUsageResponse -> String
$cshow :: RegisterUsageResponse -> String
showsPrec :: Int -> RegisterUsageResponse -> ShowS
$cshowsPrec :: Int -> RegisterUsageResponse -> ShowS
Prelude.Show, forall x. Rep RegisterUsageResponse x -> RegisterUsageResponse
forall x. RegisterUsageResponse -> Rep RegisterUsageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterUsageResponse x -> RegisterUsageResponse
$cfrom :: forall x. RegisterUsageResponse -> Rep RegisterUsageResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterUsageResponse' 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:
--
-- 'publicKeyRotationTimestamp', 'registerUsageResponse_publicKeyRotationTimestamp' - (Optional) Only included when public key version has expired
--
-- 'signature', 'registerUsageResponse_signature' - JWT Token
--
-- 'httpStatus', 'registerUsageResponse_httpStatus' - The response's http status code.
newRegisterUsageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterUsageResponse
newRegisterUsageResponse :: Int -> RegisterUsageResponse
newRegisterUsageResponse Int
pHttpStatus_ =
  RegisterUsageResponse'
    { $sel:publicKeyRotationTimestamp:RegisterUsageResponse' :: Maybe POSIX
publicKeyRotationTimestamp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:signature:RegisterUsageResponse' :: Maybe Text
signature = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RegisterUsageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | (Optional) Only included when public key version has expired
registerUsageResponse_publicKeyRotationTimestamp :: Lens.Lens' RegisterUsageResponse (Prelude.Maybe Prelude.UTCTime)
registerUsageResponse_publicKeyRotationTimestamp :: Lens' RegisterUsageResponse (Maybe UTCTime)
registerUsageResponse_publicKeyRotationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterUsageResponse' {Maybe POSIX
publicKeyRotationTimestamp :: Maybe POSIX
$sel:publicKeyRotationTimestamp:RegisterUsageResponse' :: RegisterUsageResponse -> Maybe POSIX
publicKeyRotationTimestamp} -> Maybe POSIX
publicKeyRotationTimestamp) (\s :: RegisterUsageResponse
s@RegisterUsageResponse' {} Maybe POSIX
a -> RegisterUsageResponse
s {$sel:publicKeyRotationTimestamp:RegisterUsageResponse' :: Maybe POSIX
publicKeyRotationTimestamp = Maybe POSIX
a} :: RegisterUsageResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | JWT Token
registerUsageResponse_signature :: Lens.Lens' RegisterUsageResponse (Prelude.Maybe Prelude.Text)
registerUsageResponse_signature :: Lens' RegisterUsageResponse (Maybe Text)
registerUsageResponse_signature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterUsageResponse' {Maybe Text
signature :: Maybe Text
$sel:signature:RegisterUsageResponse' :: RegisterUsageResponse -> Maybe Text
signature} -> Maybe Text
signature) (\s :: RegisterUsageResponse
s@RegisterUsageResponse' {} Maybe Text
a -> RegisterUsageResponse
s {$sel:signature:RegisterUsageResponse' :: Maybe Text
signature = Maybe Text
a} :: RegisterUsageResponse)

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

instance Prelude.NFData RegisterUsageResponse where
  rnf :: RegisterUsageResponse -> ()
rnf RegisterUsageResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
signature :: Maybe Text
publicKeyRotationTimestamp :: Maybe POSIX
$sel:httpStatus:RegisterUsageResponse' :: RegisterUsageResponse -> Int
$sel:signature:RegisterUsageResponse' :: RegisterUsageResponse -> Maybe Text
$sel:publicKeyRotationTimestamp:RegisterUsageResponse' :: RegisterUsageResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
publicKeyRotationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
signature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus