{-# 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.Redshift.BatchDeleteClusterSnapshots
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a set of cluster snapshots.
module Amazonka.Redshift.BatchDeleteClusterSnapshots
  ( -- * Creating a Request
    BatchDeleteClusterSnapshots (..),
    newBatchDeleteClusterSnapshots,

    -- * Request Lenses
    batchDeleteClusterSnapshots_identifiers,

    -- * Destructuring the Response
    BatchDeleteClusterSnapshotsResponse (..),
    newBatchDeleteClusterSnapshotsResponse,

    -- * Response Lenses
    batchDeleteClusterSnapshotsResponse_errors,
    batchDeleteClusterSnapshotsResponse_resources,
    batchDeleteClusterSnapshotsResponse_httpStatus,
  )
where

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 Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newBatchDeleteClusterSnapshots' smart constructor.
data BatchDeleteClusterSnapshots = BatchDeleteClusterSnapshots'
  { -- | A list of identifiers for the snapshots that you want to delete.
    BatchDeleteClusterSnapshots -> [DeleteClusterSnapshotMessage]
identifiers :: [DeleteClusterSnapshotMessage]
  }
  deriving (BatchDeleteClusterSnapshots -> BatchDeleteClusterSnapshots -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDeleteClusterSnapshots -> BatchDeleteClusterSnapshots -> Bool
$c/= :: BatchDeleteClusterSnapshots -> BatchDeleteClusterSnapshots -> Bool
== :: BatchDeleteClusterSnapshots -> BatchDeleteClusterSnapshots -> Bool
$c== :: BatchDeleteClusterSnapshots -> BatchDeleteClusterSnapshots -> Bool
Prelude.Eq, ReadPrec [BatchDeleteClusterSnapshots]
ReadPrec BatchDeleteClusterSnapshots
Int -> ReadS BatchDeleteClusterSnapshots
ReadS [BatchDeleteClusterSnapshots]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDeleteClusterSnapshots]
$creadListPrec :: ReadPrec [BatchDeleteClusterSnapshots]
readPrec :: ReadPrec BatchDeleteClusterSnapshots
$creadPrec :: ReadPrec BatchDeleteClusterSnapshots
readList :: ReadS [BatchDeleteClusterSnapshots]
$creadList :: ReadS [BatchDeleteClusterSnapshots]
readsPrec :: Int -> ReadS BatchDeleteClusterSnapshots
$creadsPrec :: Int -> ReadS BatchDeleteClusterSnapshots
Prelude.Read, Int -> BatchDeleteClusterSnapshots -> ShowS
[BatchDeleteClusterSnapshots] -> ShowS
BatchDeleteClusterSnapshots -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDeleteClusterSnapshots] -> ShowS
$cshowList :: [BatchDeleteClusterSnapshots] -> ShowS
show :: BatchDeleteClusterSnapshots -> String
$cshow :: BatchDeleteClusterSnapshots -> String
showsPrec :: Int -> BatchDeleteClusterSnapshots -> ShowS
$cshowsPrec :: Int -> BatchDeleteClusterSnapshots -> ShowS
Prelude.Show, forall x.
Rep BatchDeleteClusterSnapshots x -> BatchDeleteClusterSnapshots
forall x.
BatchDeleteClusterSnapshots -> Rep BatchDeleteClusterSnapshots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchDeleteClusterSnapshots x -> BatchDeleteClusterSnapshots
$cfrom :: forall x.
BatchDeleteClusterSnapshots -> Rep BatchDeleteClusterSnapshots x
Prelude.Generic)

-- |
-- Create a value of 'BatchDeleteClusterSnapshots' 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:
--
-- 'identifiers', 'batchDeleteClusterSnapshots_identifiers' - A list of identifiers for the snapshots that you want to delete.
newBatchDeleteClusterSnapshots ::
  BatchDeleteClusterSnapshots
newBatchDeleteClusterSnapshots :: BatchDeleteClusterSnapshots
newBatchDeleteClusterSnapshots =
  BatchDeleteClusterSnapshots'
    { $sel:identifiers:BatchDeleteClusterSnapshots' :: [DeleteClusterSnapshotMessage]
identifiers =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | A list of identifiers for the snapshots that you want to delete.
batchDeleteClusterSnapshots_identifiers :: Lens.Lens' BatchDeleteClusterSnapshots [DeleteClusterSnapshotMessage]
batchDeleteClusterSnapshots_identifiers :: Lens' BatchDeleteClusterSnapshots [DeleteClusterSnapshotMessage]
batchDeleteClusterSnapshots_identifiers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteClusterSnapshots' {[DeleteClusterSnapshotMessage]
identifiers :: [DeleteClusterSnapshotMessage]
$sel:identifiers:BatchDeleteClusterSnapshots' :: BatchDeleteClusterSnapshots -> [DeleteClusterSnapshotMessage]
identifiers} -> [DeleteClusterSnapshotMessage]
identifiers) (\s :: BatchDeleteClusterSnapshots
s@BatchDeleteClusterSnapshots' {} [DeleteClusterSnapshotMessage]
a -> BatchDeleteClusterSnapshots
s {$sel:identifiers:BatchDeleteClusterSnapshots' :: [DeleteClusterSnapshotMessage]
identifiers = [DeleteClusterSnapshotMessage]
a} :: BatchDeleteClusterSnapshots) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchDeleteClusterSnapshots where
  type
    AWSResponse BatchDeleteClusterSnapshots =
      BatchDeleteClusterSnapshotsResponse
  request :: (Service -> Service)
-> BatchDeleteClusterSnapshots
-> Request BatchDeleteClusterSnapshots
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy BatchDeleteClusterSnapshots
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchDeleteClusterSnapshots)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"BatchDeleteClusterSnapshotsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [SnapshotErrorMessage]
-> Maybe [Text] -> Int -> BatchDeleteClusterSnapshotsResponse
BatchDeleteClusterSnapshotsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Errors"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"SnapshotErrorMessage")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Resources"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"String")
                        )
            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 BatchDeleteClusterSnapshots where
  hashWithSalt :: Int -> BatchDeleteClusterSnapshots -> Int
hashWithSalt Int
_salt BatchDeleteClusterSnapshots' {[DeleteClusterSnapshotMessage]
identifiers :: [DeleteClusterSnapshotMessage]
$sel:identifiers:BatchDeleteClusterSnapshots' :: BatchDeleteClusterSnapshots -> [DeleteClusterSnapshotMessage]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [DeleteClusterSnapshotMessage]
identifiers

instance Prelude.NFData BatchDeleteClusterSnapshots where
  rnf :: BatchDeleteClusterSnapshots -> ()
rnf BatchDeleteClusterSnapshots' {[DeleteClusterSnapshotMessage]
identifiers :: [DeleteClusterSnapshotMessage]
$sel:identifiers:BatchDeleteClusterSnapshots' :: BatchDeleteClusterSnapshots -> [DeleteClusterSnapshotMessage]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [DeleteClusterSnapshotMessage]
identifiers

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

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

instance Data.ToQuery BatchDeleteClusterSnapshots where
  toQuery :: BatchDeleteClusterSnapshots -> QueryString
toQuery BatchDeleteClusterSnapshots' {[DeleteClusterSnapshotMessage]
identifiers :: [DeleteClusterSnapshotMessage]
$sel:identifiers:BatchDeleteClusterSnapshots' :: BatchDeleteClusterSnapshots -> [DeleteClusterSnapshotMessage]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"BatchDeleteClusterSnapshots" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"Identifiers"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList
            ByteString
"DeleteClusterSnapshotMessage"
            [DeleteClusterSnapshotMessage]
identifiers
      ]

-- | /See:/ 'newBatchDeleteClusterSnapshotsResponse' smart constructor.
data BatchDeleteClusterSnapshotsResponse = BatchDeleteClusterSnapshotsResponse'
  { -- | A list of any errors returned.
    BatchDeleteClusterSnapshotsResponse -> Maybe [SnapshotErrorMessage]
errors :: Prelude.Maybe [SnapshotErrorMessage],
    -- | A list of the snapshot identifiers that were deleted.
    BatchDeleteClusterSnapshotsResponse -> Maybe [Text]
resources :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    BatchDeleteClusterSnapshotsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchDeleteClusterSnapshotsResponse
-> BatchDeleteClusterSnapshotsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDeleteClusterSnapshotsResponse
-> BatchDeleteClusterSnapshotsResponse -> Bool
$c/= :: BatchDeleteClusterSnapshotsResponse
-> BatchDeleteClusterSnapshotsResponse -> Bool
== :: BatchDeleteClusterSnapshotsResponse
-> BatchDeleteClusterSnapshotsResponse -> Bool
$c== :: BatchDeleteClusterSnapshotsResponse
-> BatchDeleteClusterSnapshotsResponse -> Bool
Prelude.Eq, ReadPrec [BatchDeleteClusterSnapshotsResponse]
ReadPrec BatchDeleteClusterSnapshotsResponse
Int -> ReadS BatchDeleteClusterSnapshotsResponse
ReadS [BatchDeleteClusterSnapshotsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDeleteClusterSnapshotsResponse]
$creadListPrec :: ReadPrec [BatchDeleteClusterSnapshotsResponse]
readPrec :: ReadPrec BatchDeleteClusterSnapshotsResponse
$creadPrec :: ReadPrec BatchDeleteClusterSnapshotsResponse
readList :: ReadS [BatchDeleteClusterSnapshotsResponse]
$creadList :: ReadS [BatchDeleteClusterSnapshotsResponse]
readsPrec :: Int -> ReadS BatchDeleteClusterSnapshotsResponse
$creadsPrec :: Int -> ReadS BatchDeleteClusterSnapshotsResponse
Prelude.Read, Int -> BatchDeleteClusterSnapshotsResponse -> ShowS
[BatchDeleteClusterSnapshotsResponse] -> ShowS
BatchDeleteClusterSnapshotsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDeleteClusterSnapshotsResponse] -> ShowS
$cshowList :: [BatchDeleteClusterSnapshotsResponse] -> ShowS
show :: BatchDeleteClusterSnapshotsResponse -> String
$cshow :: BatchDeleteClusterSnapshotsResponse -> String
showsPrec :: Int -> BatchDeleteClusterSnapshotsResponse -> ShowS
$cshowsPrec :: Int -> BatchDeleteClusterSnapshotsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchDeleteClusterSnapshotsResponse x
-> BatchDeleteClusterSnapshotsResponse
forall x.
BatchDeleteClusterSnapshotsResponse
-> Rep BatchDeleteClusterSnapshotsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchDeleteClusterSnapshotsResponse x
-> BatchDeleteClusterSnapshotsResponse
$cfrom :: forall x.
BatchDeleteClusterSnapshotsResponse
-> Rep BatchDeleteClusterSnapshotsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchDeleteClusterSnapshotsResponse' 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:
--
-- 'errors', 'batchDeleteClusterSnapshotsResponse_errors' - A list of any errors returned.
--
-- 'resources', 'batchDeleteClusterSnapshotsResponse_resources' - A list of the snapshot identifiers that were deleted.
--
-- 'httpStatus', 'batchDeleteClusterSnapshotsResponse_httpStatus' - The response's http status code.
newBatchDeleteClusterSnapshotsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchDeleteClusterSnapshotsResponse
newBatchDeleteClusterSnapshotsResponse :: Int -> BatchDeleteClusterSnapshotsResponse
newBatchDeleteClusterSnapshotsResponse Int
pHttpStatus_ =
  BatchDeleteClusterSnapshotsResponse'
    { $sel:errors:BatchDeleteClusterSnapshotsResponse' :: Maybe [SnapshotErrorMessage]
errors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resources:BatchDeleteClusterSnapshotsResponse' :: Maybe [Text]
resources = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchDeleteClusterSnapshotsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of any errors returned.
batchDeleteClusterSnapshotsResponse_errors :: Lens.Lens' BatchDeleteClusterSnapshotsResponse (Prelude.Maybe [SnapshotErrorMessage])
batchDeleteClusterSnapshotsResponse_errors :: Lens'
  BatchDeleteClusterSnapshotsResponse (Maybe [SnapshotErrorMessage])
batchDeleteClusterSnapshotsResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteClusterSnapshotsResponse' {Maybe [SnapshotErrorMessage]
errors :: Maybe [SnapshotErrorMessage]
$sel:errors:BatchDeleteClusterSnapshotsResponse' :: BatchDeleteClusterSnapshotsResponse -> Maybe [SnapshotErrorMessage]
errors} -> Maybe [SnapshotErrorMessage]
errors) (\s :: BatchDeleteClusterSnapshotsResponse
s@BatchDeleteClusterSnapshotsResponse' {} Maybe [SnapshotErrorMessage]
a -> BatchDeleteClusterSnapshotsResponse
s {$sel:errors:BatchDeleteClusterSnapshotsResponse' :: Maybe [SnapshotErrorMessage]
errors = Maybe [SnapshotErrorMessage]
a} :: BatchDeleteClusterSnapshotsResponse) 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 list of the snapshot identifiers that were deleted.
batchDeleteClusterSnapshotsResponse_resources :: Lens.Lens' BatchDeleteClusterSnapshotsResponse (Prelude.Maybe [Prelude.Text])
batchDeleteClusterSnapshotsResponse_resources :: Lens' BatchDeleteClusterSnapshotsResponse (Maybe [Text])
batchDeleteClusterSnapshotsResponse_resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteClusterSnapshotsResponse' {Maybe [Text]
resources :: Maybe [Text]
$sel:resources:BatchDeleteClusterSnapshotsResponse' :: BatchDeleteClusterSnapshotsResponse -> Maybe [Text]
resources} -> Maybe [Text]
resources) (\s :: BatchDeleteClusterSnapshotsResponse
s@BatchDeleteClusterSnapshotsResponse' {} Maybe [Text]
a -> BatchDeleteClusterSnapshotsResponse
s {$sel:resources:BatchDeleteClusterSnapshotsResponse' :: Maybe [Text]
resources = Maybe [Text]
a} :: BatchDeleteClusterSnapshotsResponse) 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

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

instance
  Prelude.NFData
    BatchDeleteClusterSnapshotsResponse
  where
  rnf :: BatchDeleteClusterSnapshotsResponse -> ()
rnf BatchDeleteClusterSnapshotsResponse' {Int
Maybe [Text]
Maybe [SnapshotErrorMessage]
httpStatus :: Int
resources :: Maybe [Text]
errors :: Maybe [SnapshotErrorMessage]
$sel:httpStatus:BatchDeleteClusterSnapshotsResponse' :: BatchDeleteClusterSnapshotsResponse -> Int
$sel:resources:BatchDeleteClusterSnapshotsResponse' :: BatchDeleteClusterSnapshotsResponse -> Maybe [Text]
$sel:errors:BatchDeleteClusterSnapshotsResponse' :: BatchDeleteClusterSnapshotsResponse -> Maybe [SnapshotErrorMessage]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [SnapshotErrorMessage]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
resources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus