{-# 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.CloudTrail.ListImportFailures
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of failures for the specified import.
--
-- This operation returns paginated results.
module Amazonka.CloudTrail.ListImportFailures
  ( -- * Creating a Request
    ListImportFailures (..),
    newListImportFailures,

    -- * Request Lenses
    listImportFailures_maxResults,
    listImportFailures_nextToken,
    listImportFailures_importId,

    -- * Destructuring the Response
    ListImportFailuresResponse (..),
    newListImportFailuresResponse,

    -- * Response Lenses
    listImportFailuresResponse_failures,
    listImportFailuresResponse_nextToken,
    listImportFailuresResponse_httpStatus,
  )
where

import Amazonka.CloudTrail.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:/ 'newListImportFailures' smart constructor.
data ListImportFailures = ListImportFailures'
  { -- | The maximum number of failures to display on a single page.
    ListImportFailures -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token you can use to get the next page of import failures.
    ListImportFailures -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the import.
    ListImportFailures -> Text
importId :: Prelude.Text
  }
  deriving (ListImportFailures -> ListImportFailures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImportFailures -> ListImportFailures -> Bool
$c/= :: ListImportFailures -> ListImportFailures -> Bool
== :: ListImportFailures -> ListImportFailures -> Bool
$c== :: ListImportFailures -> ListImportFailures -> Bool
Prelude.Eq, ReadPrec [ListImportFailures]
ReadPrec ListImportFailures
Int -> ReadS ListImportFailures
ReadS [ListImportFailures]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImportFailures]
$creadListPrec :: ReadPrec [ListImportFailures]
readPrec :: ReadPrec ListImportFailures
$creadPrec :: ReadPrec ListImportFailures
readList :: ReadS [ListImportFailures]
$creadList :: ReadS [ListImportFailures]
readsPrec :: Int -> ReadS ListImportFailures
$creadsPrec :: Int -> ReadS ListImportFailures
Prelude.Read, Int -> ListImportFailures -> ShowS
[ListImportFailures] -> ShowS
ListImportFailures -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImportFailures] -> ShowS
$cshowList :: [ListImportFailures] -> ShowS
show :: ListImportFailures -> String
$cshow :: ListImportFailures -> String
showsPrec :: Int -> ListImportFailures -> ShowS
$cshowsPrec :: Int -> ListImportFailures -> ShowS
Prelude.Show, forall x. Rep ListImportFailures x -> ListImportFailures
forall x. ListImportFailures -> Rep ListImportFailures x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImportFailures x -> ListImportFailures
$cfrom :: forall x. ListImportFailures -> Rep ListImportFailures x
Prelude.Generic)

-- |
-- Create a value of 'ListImportFailures' 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:
--
-- 'maxResults', 'listImportFailures_maxResults' - The maximum number of failures to display on a single page.
--
-- 'nextToken', 'listImportFailures_nextToken' - A token you can use to get the next page of import failures.
--
-- 'importId', 'listImportFailures_importId' - The ID of the import.
newListImportFailures ::
  -- | 'importId'
  Prelude.Text ->
  ListImportFailures
newListImportFailures :: Text -> ListImportFailures
newListImportFailures Text
pImportId_ =
  ListImportFailures'
    { $sel:maxResults:ListImportFailures' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImportFailures' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:importId:ListImportFailures' :: Text
importId = Text
pImportId_
    }

-- | The maximum number of failures to display on a single page.
listImportFailures_maxResults :: Lens.Lens' ListImportFailures (Prelude.Maybe Prelude.Natural)
listImportFailures_maxResults :: Lens' ListImportFailures (Maybe Natural)
listImportFailures_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportFailures' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListImportFailures' :: ListImportFailures -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListImportFailures
s@ListImportFailures' {} Maybe Natural
a -> ListImportFailures
s {$sel:maxResults:ListImportFailures' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListImportFailures)

-- | A token you can use to get the next page of import failures.
listImportFailures_nextToken :: Lens.Lens' ListImportFailures (Prelude.Maybe Prelude.Text)
listImportFailures_nextToken :: Lens' ListImportFailures (Maybe Text)
listImportFailures_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportFailures' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImportFailures' :: ListImportFailures -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImportFailures
s@ListImportFailures' {} Maybe Text
a -> ListImportFailures
s {$sel:nextToken:ListImportFailures' :: Maybe Text
nextToken = Maybe Text
a} :: ListImportFailures)

-- | The ID of the import.
listImportFailures_importId :: Lens.Lens' ListImportFailures Prelude.Text
listImportFailures_importId :: Lens' ListImportFailures Text
listImportFailures_importId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportFailures' {Text
importId :: Text
$sel:importId:ListImportFailures' :: ListImportFailures -> Text
importId} -> Text
importId) (\s :: ListImportFailures
s@ListImportFailures' {} Text
a -> ListImportFailures
s {$sel:importId:ListImportFailures' :: Text
importId = Text
a} :: ListImportFailures)

instance Core.AWSPager ListImportFailures where
  page :: ListImportFailures
-> AWSResponse ListImportFailures -> Maybe ListImportFailures
page ListImportFailures
rq AWSResponse ListImportFailures
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListImportFailures
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListImportFailuresResponse (Maybe Text)
listImportFailuresResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListImportFailures
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListImportFailuresResponse (Maybe [ImportFailureListItem])
listImportFailuresResponse_failures
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListImportFailures
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListImportFailures (Maybe Text)
listImportFailures_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListImportFailures
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListImportFailuresResponse (Maybe Text)
listImportFailuresResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListImportFailures where
  type
    AWSResponse ListImportFailures =
      ListImportFailuresResponse
  request :: (Service -> Service)
-> ListImportFailures -> Request ListImportFailures
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 ListImportFailures
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListImportFailures)))
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 [ImportFailureListItem]
-> Maybe Text -> Int -> ListImportFailuresResponse
ListImportFailuresResponse'
            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
"Failures" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            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 ListImportFailures where
  hashWithSalt :: Int -> ListImportFailures -> Int
hashWithSalt Int
_salt ListImportFailures' {Maybe Natural
Maybe Text
Text
importId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:importId:ListImportFailures' :: ListImportFailures -> Text
$sel:nextToken:ListImportFailures' :: ListImportFailures -> Maybe Text
$sel:maxResults:ListImportFailures' :: ListImportFailures -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
importId

instance Prelude.NFData ListImportFailures where
  rnf :: ListImportFailures -> ()
rnf ListImportFailures' {Maybe Natural
Maybe Text
Text
importId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:importId:ListImportFailures' :: ListImportFailures -> Text
$sel:nextToken:ListImportFailures' :: ListImportFailures -> Maybe Text
$sel:maxResults:ListImportFailures' :: ListImportFailures -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
importId

instance Data.ToHeaders ListImportFailures where
  toHeaders :: ListImportFailures -> 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
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.ListImportFailures" ::
                          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 ListImportFailures where
  toJSON :: ListImportFailures -> Value
toJSON ListImportFailures' {Maybe Natural
Maybe Text
Text
importId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:importId:ListImportFailures' :: ListImportFailures -> Text
$sel:nextToken:ListImportFailures' :: ListImportFailures -> Maybe Text
$sel:maxResults:ListImportFailures' :: ListImportFailures -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"ImportId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
importId)
          ]
      )

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

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

-- | /See:/ 'newListImportFailuresResponse' smart constructor.
data ListImportFailuresResponse = ListImportFailuresResponse'
  { -- | Contains information about the import failures.
    ListImportFailuresResponse -> Maybe [ImportFailureListItem]
failures :: Prelude.Maybe [ImportFailureListItem],
    -- | A token you can use to get the next page of results.
    ListImportFailuresResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListImportFailuresResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListImportFailuresResponse -> ListImportFailuresResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImportFailuresResponse -> ListImportFailuresResponse -> Bool
$c/= :: ListImportFailuresResponse -> ListImportFailuresResponse -> Bool
== :: ListImportFailuresResponse -> ListImportFailuresResponse -> Bool
$c== :: ListImportFailuresResponse -> ListImportFailuresResponse -> Bool
Prelude.Eq, ReadPrec [ListImportFailuresResponse]
ReadPrec ListImportFailuresResponse
Int -> ReadS ListImportFailuresResponse
ReadS [ListImportFailuresResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImportFailuresResponse]
$creadListPrec :: ReadPrec [ListImportFailuresResponse]
readPrec :: ReadPrec ListImportFailuresResponse
$creadPrec :: ReadPrec ListImportFailuresResponse
readList :: ReadS [ListImportFailuresResponse]
$creadList :: ReadS [ListImportFailuresResponse]
readsPrec :: Int -> ReadS ListImportFailuresResponse
$creadsPrec :: Int -> ReadS ListImportFailuresResponse
Prelude.Read, Int -> ListImportFailuresResponse -> ShowS
[ListImportFailuresResponse] -> ShowS
ListImportFailuresResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImportFailuresResponse] -> ShowS
$cshowList :: [ListImportFailuresResponse] -> ShowS
show :: ListImportFailuresResponse -> String
$cshow :: ListImportFailuresResponse -> String
showsPrec :: Int -> ListImportFailuresResponse -> ShowS
$cshowsPrec :: Int -> ListImportFailuresResponse -> ShowS
Prelude.Show, forall x.
Rep ListImportFailuresResponse x -> ListImportFailuresResponse
forall x.
ListImportFailuresResponse -> Rep ListImportFailuresResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListImportFailuresResponse x -> ListImportFailuresResponse
$cfrom :: forall x.
ListImportFailuresResponse -> Rep ListImportFailuresResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListImportFailuresResponse' 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:
--
-- 'failures', 'listImportFailuresResponse_failures' - Contains information about the import failures.
--
-- 'nextToken', 'listImportFailuresResponse_nextToken' - A token you can use to get the next page of results.
--
-- 'httpStatus', 'listImportFailuresResponse_httpStatus' - The response's http status code.
newListImportFailuresResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListImportFailuresResponse
newListImportFailuresResponse :: Int -> ListImportFailuresResponse
newListImportFailuresResponse Int
pHttpStatus_ =
  ListImportFailuresResponse'
    { $sel:failures:ListImportFailuresResponse' :: Maybe [ImportFailureListItem]
failures =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImportFailuresResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListImportFailuresResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains information about the import failures.
listImportFailuresResponse_failures :: Lens.Lens' ListImportFailuresResponse (Prelude.Maybe [ImportFailureListItem])
listImportFailuresResponse_failures :: Lens' ListImportFailuresResponse (Maybe [ImportFailureListItem])
listImportFailuresResponse_failures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportFailuresResponse' {Maybe [ImportFailureListItem]
failures :: Maybe [ImportFailureListItem]
$sel:failures:ListImportFailuresResponse' :: ListImportFailuresResponse -> Maybe [ImportFailureListItem]
failures} -> Maybe [ImportFailureListItem]
failures) (\s :: ListImportFailuresResponse
s@ListImportFailuresResponse' {} Maybe [ImportFailureListItem]
a -> ListImportFailuresResponse
s {$sel:failures:ListImportFailuresResponse' :: Maybe [ImportFailureListItem]
failures = Maybe [ImportFailureListItem]
a} :: ListImportFailuresResponse) 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

-- | A token you can use to get the next page of results.
listImportFailuresResponse_nextToken :: Lens.Lens' ListImportFailuresResponse (Prelude.Maybe Prelude.Text)
listImportFailuresResponse_nextToken :: Lens' ListImportFailuresResponse (Maybe Text)
listImportFailuresResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportFailuresResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImportFailuresResponse' :: ListImportFailuresResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImportFailuresResponse
s@ListImportFailuresResponse' {} Maybe Text
a -> ListImportFailuresResponse
s {$sel:nextToken:ListImportFailuresResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListImportFailuresResponse)

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

instance Prelude.NFData ListImportFailuresResponse where
  rnf :: ListImportFailuresResponse -> ()
rnf ListImportFailuresResponse' {Int
Maybe [ImportFailureListItem]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
failures :: Maybe [ImportFailureListItem]
$sel:httpStatus:ListImportFailuresResponse' :: ListImportFailuresResponse -> Int
$sel:nextToken:ListImportFailuresResponse' :: ListImportFailuresResponse -> Maybe Text
$sel:failures:ListImportFailuresResponse' :: ListImportFailuresResponse -> Maybe [ImportFailureListItem]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ImportFailureListItem]
failures
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus