{-# 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.MacieV2.UpdateAllowList
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the settings for an allow list.
module Amazonka.MacieV2.UpdateAllowList
  ( -- * Creating a Request
    UpdateAllowList (..),
    newUpdateAllowList,

    -- * Request Lenses
    updateAllowList_description,
    updateAllowList_id,
    updateAllowList_criteria,
    updateAllowList_name,

    -- * Destructuring the Response
    UpdateAllowListResponse (..),
    newUpdateAllowListResponse,

    -- * Response Lenses
    updateAllowListResponse_arn,
    updateAllowListResponse_id,
    updateAllowListResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateAllowList' smart constructor.
data UpdateAllowList = UpdateAllowList'
  { -- | A custom description of the allow list. The description can contain as
    -- many as 512 characters.
    UpdateAllowList -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the Amazon Macie resource that the request
    -- applies to.
    UpdateAllowList -> Text
id :: Prelude.Text,
    -- | The criteria that specify the text or text pattern to ignore. The
    -- criteria can be the location and name of an S3 object that lists
    -- specific text to ignore (s3WordsList), or a regular expression that
    -- defines a text pattern to ignore (regex).
    --
    -- You can change a list\'s underlying criteria, such as the name of the S3
    -- object or the regular expression to use. However, you can\'t change the
    -- type from s3WordsList to regex or the other way around.
    UpdateAllowList -> AllowListCriteria
criteria :: AllowListCriteria,
    -- | A custom name for the allow list. The name can contain as many as 128
    -- characters.
    UpdateAllowList -> Text
name :: Prelude.Text
  }
  deriving (UpdateAllowList -> UpdateAllowList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAllowList -> UpdateAllowList -> Bool
$c/= :: UpdateAllowList -> UpdateAllowList -> Bool
== :: UpdateAllowList -> UpdateAllowList -> Bool
$c== :: UpdateAllowList -> UpdateAllowList -> Bool
Prelude.Eq, ReadPrec [UpdateAllowList]
ReadPrec UpdateAllowList
Int -> ReadS UpdateAllowList
ReadS [UpdateAllowList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAllowList]
$creadListPrec :: ReadPrec [UpdateAllowList]
readPrec :: ReadPrec UpdateAllowList
$creadPrec :: ReadPrec UpdateAllowList
readList :: ReadS [UpdateAllowList]
$creadList :: ReadS [UpdateAllowList]
readsPrec :: Int -> ReadS UpdateAllowList
$creadsPrec :: Int -> ReadS UpdateAllowList
Prelude.Read, Int -> UpdateAllowList -> ShowS
[UpdateAllowList] -> ShowS
UpdateAllowList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAllowList] -> ShowS
$cshowList :: [UpdateAllowList] -> ShowS
show :: UpdateAllowList -> String
$cshow :: UpdateAllowList -> String
showsPrec :: Int -> UpdateAllowList -> ShowS
$cshowsPrec :: Int -> UpdateAllowList -> ShowS
Prelude.Show, forall x. Rep UpdateAllowList x -> UpdateAllowList
forall x. UpdateAllowList -> Rep UpdateAllowList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAllowList x -> UpdateAllowList
$cfrom :: forall x. UpdateAllowList -> Rep UpdateAllowList x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAllowList' 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:
--
-- 'description', 'updateAllowList_description' - A custom description of the allow list. The description can contain as
-- many as 512 characters.
--
-- 'id', 'updateAllowList_id' - The unique identifier for the Amazon Macie resource that the request
-- applies to.
--
-- 'criteria', 'updateAllowList_criteria' - The criteria that specify the text or text pattern to ignore. The
-- criteria can be the location and name of an S3 object that lists
-- specific text to ignore (s3WordsList), or a regular expression that
-- defines a text pattern to ignore (regex).
--
-- You can change a list\'s underlying criteria, such as the name of the S3
-- object or the regular expression to use. However, you can\'t change the
-- type from s3WordsList to regex or the other way around.
--
-- 'name', 'updateAllowList_name' - A custom name for the allow list. The name can contain as many as 128
-- characters.
newUpdateAllowList ::
  -- | 'id'
  Prelude.Text ->
  -- | 'criteria'
  AllowListCriteria ->
  -- | 'name'
  Prelude.Text ->
  UpdateAllowList
newUpdateAllowList :: Text -> AllowListCriteria -> Text -> UpdateAllowList
newUpdateAllowList Text
pId_ AllowListCriteria
pCriteria_ Text
pName_ =
  UpdateAllowList'
    { $sel:description:UpdateAllowList' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateAllowList' :: Text
id = Text
pId_,
      $sel:criteria:UpdateAllowList' :: AllowListCriteria
criteria = AllowListCriteria
pCriteria_,
      $sel:name:UpdateAllowList' :: Text
name = Text
pName_
    }

-- | A custom description of the allow list. The description can contain as
-- many as 512 characters.
updateAllowList_description :: Lens.Lens' UpdateAllowList (Prelude.Maybe Prelude.Text)
updateAllowList_description :: Lens' UpdateAllowList (Maybe Text)
updateAllowList_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAllowList' {Maybe Text
description :: Maybe Text
$sel:description:UpdateAllowList' :: UpdateAllowList -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateAllowList
s@UpdateAllowList' {} Maybe Text
a -> UpdateAllowList
s {$sel:description:UpdateAllowList' :: Maybe Text
description = Maybe Text
a} :: UpdateAllowList)

-- | The unique identifier for the Amazon Macie resource that the request
-- applies to.
updateAllowList_id :: Lens.Lens' UpdateAllowList Prelude.Text
updateAllowList_id :: Lens' UpdateAllowList Text
updateAllowList_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAllowList' {Text
id :: Text
$sel:id:UpdateAllowList' :: UpdateAllowList -> Text
id} -> Text
id) (\s :: UpdateAllowList
s@UpdateAllowList' {} Text
a -> UpdateAllowList
s {$sel:id:UpdateAllowList' :: Text
id = Text
a} :: UpdateAllowList)

-- | The criteria that specify the text or text pattern to ignore. The
-- criteria can be the location and name of an S3 object that lists
-- specific text to ignore (s3WordsList), or a regular expression that
-- defines a text pattern to ignore (regex).
--
-- You can change a list\'s underlying criteria, such as the name of the S3
-- object or the regular expression to use. However, you can\'t change the
-- type from s3WordsList to regex or the other way around.
updateAllowList_criteria :: Lens.Lens' UpdateAllowList AllowListCriteria
updateAllowList_criteria :: Lens' UpdateAllowList AllowListCriteria
updateAllowList_criteria = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAllowList' {AllowListCriteria
criteria :: AllowListCriteria
$sel:criteria:UpdateAllowList' :: UpdateAllowList -> AllowListCriteria
criteria} -> AllowListCriteria
criteria) (\s :: UpdateAllowList
s@UpdateAllowList' {} AllowListCriteria
a -> UpdateAllowList
s {$sel:criteria:UpdateAllowList' :: AllowListCriteria
criteria = AllowListCriteria
a} :: UpdateAllowList)

-- | A custom name for the allow list. The name can contain as many as 128
-- characters.
updateAllowList_name :: Lens.Lens' UpdateAllowList Prelude.Text
updateAllowList_name :: Lens' UpdateAllowList Text
updateAllowList_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAllowList' {Text
name :: Text
$sel:name:UpdateAllowList' :: UpdateAllowList -> Text
name} -> Text
name) (\s :: UpdateAllowList
s@UpdateAllowList' {} Text
a -> UpdateAllowList
s {$sel:name:UpdateAllowList' :: Text
name = Text
a} :: UpdateAllowList)

instance Core.AWSRequest UpdateAllowList where
  type
    AWSResponse UpdateAllowList =
      UpdateAllowListResponse
  request :: (Service -> Service) -> UpdateAllowList -> Request UpdateAllowList
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 UpdateAllowList
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateAllowList)))
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 -> UpdateAllowListResponse
UpdateAllowListResponse'
            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
"arn")
            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 UpdateAllowList where
  hashWithSalt :: Int -> UpdateAllowList -> Int
hashWithSalt Int
_salt UpdateAllowList' {Maybe Text
Text
AllowListCriteria
name :: Text
criteria :: AllowListCriteria
id :: Text
description :: Maybe Text
$sel:name:UpdateAllowList' :: UpdateAllowList -> Text
$sel:criteria:UpdateAllowList' :: UpdateAllowList -> AllowListCriteria
$sel:id:UpdateAllowList' :: UpdateAllowList -> Text
$sel:description:UpdateAllowList' :: UpdateAllowList -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AllowListCriteria
criteria
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateAllowList where
  rnf :: UpdateAllowList -> ()
rnf UpdateAllowList' {Maybe Text
Text
AllowListCriteria
name :: Text
criteria :: AllowListCriteria
id :: Text
description :: Maybe Text
$sel:name:UpdateAllowList' :: UpdateAllowList -> Text
$sel:criteria:UpdateAllowList' :: UpdateAllowList -> AllowListCriteria
$sel:id:UpdateAllowList' :: UpdateAllowList -> Text
$sel:description:UpdateAllowList' :: UpdateAllowList -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AllowListCriteria
criteria
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders UpdateAllowList where
  toHeaders :: UpdateAllowList -> 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.ToJSON UpdateAllowList where
  toJSON :: UpdateAllowList -> Value
toJSON UpdateAllowList' {Maybe Text
Text
AllowListCriteria
name :: Text
criteria :: AllowListCriteria
id :: Text
description :: Maybe Text
$sel:name:UpdateAllowList' :: UpdateAllowList -> Text
$sel:criteria:UpdateAllowList' :: UpdateAllowList -> AllowListCriteria
$sel:id:UpdateAllowList' :: UpdateAllowList -> Text
$sel:description:UpdateAllowList' :: UpdateAllowList -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" 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
description,
            forall a. a -> Maybe a
Prelude.Just (Key
"criteria" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AllowListCriteria
criteria),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath UpdateAllowList where
  toPath :: UpdateAllowList -> ByteString
toPath UpdateAllowList' {Maybe Text
Text
AllowListCriteria
name :: Text
criteria :: AllowListCriteria
id :: Text
description :: Maybe Text
$sel:name:UpdateAllowList' :: UpdateAllowList -> Text
$sel:criteria:UpdateAllowList' :: UpdateAllowList -> AllowListCriteria
$sel:id:UpdateAllowList' :: UpdateAllowList -> Text
$sel:description:UpdateAllowList' :: UpdateAllowList -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/allow-lists/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

-- | /See:/ 'newUpdateAllowListResponse' smart constructor.
data UpdateAllowListResponse = UpdateAllowListResponse'
  { -- | The Amazon Resource Name (ARN) of the allow list.
    UpdateAllowListResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the allow list.
    UpdateAllowListResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateAllowListResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateAllowListResponse -> UpdateAllowListResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAllowListResponse -> UpdateAllowListResponse -> Bool
$c/= :: UpdateAllowListResponse -> UpdateAllowListResponse -> Bool
== :: UpdateAllowListResponse -> UpdateAllowListResponse -> Bool
$c== :: UpdateAllowListResponse -> UpdateAllowListResponse -> Bool
Prelude.Eq, ReadPrec [UpdateAllowListResponse]
ReadPrec UpdateAllowListResponse
Int -> ReadS UpdateAllowListResponse
ReadS [UpdateAllowListResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAllowListResponse]
$creadListPrec :: ReadPrec [UpdateAllowListResponse]
readPrec :: ReadPrec UpdateAllowListResponse
$creadPrec :: ReadPrec UpdateAllowListResponse
readList :: ReadS [UpdateAllowListResponse]
$creadList :: ReadS [UpdateAllowListResponse]
readsPrec :: Int -> ReadS UpdateAllowListResponse
$creadsPrec :: Int -> ReadS UpdateAllowListResponse
Prelude.Read, Int -> UpdateAllowListResponse -> ShowS
[UpdateAllowListResponse] -> ShowS
UpdateAllowListResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAllowListResponse] -> ShowS
$cshowList :: [UpdateAllowListResponse] -> ShowS
show :: UpdateAllowListResponse -> String
$cshow :: UpdateAllowListResponse -> String
showsPrec :: Int -> UpdateAllowListResponse -> ShowS
$cshowsPrec :: Int -> UpdateAllowListResponse -> ShowS
Prelude.Show, forall x. Rep UpdateAllowListResponse x -> UpdateAllowListResponse
forall x. UpdateAllowListResponse -> Rep UpdateAllowListResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAllowListResponse x -> UpdateAllowListResponse
$cfrom :: forall x. UpdateAllowListResponse -> Rep UpdateAllowListResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAllowListResponse' 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:
--
-- 'arn', 'updateAllowListResponse_arn' - The Amazon Resource Name (ARN) of the allow list.
--
-- 'id', 'updateAllowListResponse_id' - The unique identifier for the allow list.
--
-- 'httpStatus', 'updateAllowListResponse_httpStatus' - The response's http status code.
newUpdateAllowListResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAllowListResponse
newUpdateAllowListResponse :: Int -> UpdateAllowListResponse
newUpdateAllowListResponse Int
pHttpStatus_ =
  UpdateAllowListResponse'
    { $sel:arn:UpdateAllowListResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateAllowListResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAllowListResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the allow list.
updateAllowListResponse_arn :: Lens.Lens' UpdateAllowListResponse (Prelude.Maybe Prelude.Text)
updateAllowListResponse_arn :: Lens' UpdateAllowListResponse (Maybe Text)
updateAllowListResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAllowListResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:UpdateAllowListResponse' :: UpdateAllowListResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: UpdateAllowListResponse
s@UpdateAllowListResponse' {} Maybe Text
a -> UpdateAllowListResponse
s {$sel:arn:UpdateAllowListResponse' :: Maybe Text
arn = Maybe Text
a} :: UpdateAllowListResponse)

-- | The unique identifier for the allow list.
updateAllowListResponse_id :: Lens.Lens' UpdateAllowListResponse (Prelude.Maybe Prelude.Text)
updateAllowListResponse_id :: Lens' UpdateAllowListResponse (Maybe Text)
updateAllowListResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAllowListResponse' {Maybe Text
id :: Maybe Text
$sel:id:UpdateAllowListResponse' :: UpdateAllowListResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: UpdateAllowListResponse
s@UpdateAllowListResponse' {} Maybe Text
a -> UpdateAllowListResponse
s {$sel:id:UpdateAllowListResponse' :: Maybe Text
id = Maybe Text
a} :: UpdateAllowListResponse)

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

instance Prelude.NFData UpdateAllowListResponse where
  rnf :: UpdateAllowListResponse -> ()
rnf UpdateAllowListResponse' {Int
Maybe Text
httpStatus :: Int
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:UpdateAllowListResponse' :: UpdateAllowListResponse -> Int
$sel:id:UpdateAllowListResponse' :: UpdateAllowListResponse -> Maybe Text
$sel:arn:UpdateAllowListResponse' :: UpdateAllowListResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      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