{-# 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.EMR.AddInstanceGroups
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds one or more instance groups to a running cluster.
module Amazonka.EMR.AddInstanceGroups
  ( -- * Creating a Request
    AddInstanceGroups (..),
    newAddInstanceGroups,

    -- * Request Lenses
    addInstanceGroups_instanceGroups,
    addInstanceGroups_jobFlowId,

    -- * Destructuring the Response
    AddInstanceGroupsResponse (..),
    newAddInstanceGroupsResponse,

    -- * Response Lenses
    addInstanceGroupsResponse_clusterArn,
    addInstanceGroupsResponse_instanceGroupIds,
    addInstanceGroupsResponse_jobFlowId,
    addInstanceGroupsResponse_httpStatus,
  )
where

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

-- | Input to an AddInstanceGroups call.
--
-- /See:/ 'newAddInstanceGroups' smart constructor.
data AddInstanceGroups = AddInstanceGroups'
  { -- | Instance groups to add.
    AddInstanceGroups -> [InstanceGroupConfig]
instanceGroups :: [InstanceGroupConfig],
    -- | Job flow in which to add the instance groups.
    AddInstanceGroups -> Text
jobFlowId :: Prelude.Text
  }
  deriving (AddInstanceGroups -> AddInstanceGroups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddInstanceGroups -> AddInstanceGroups -> Bool
$c/= :: AddInstanceGroups -> AddInstanceGroups -> Bool
== :: AddInstanceGroups -> AddInstanceGroups -> Bool
$c== :: AddInstanceGroups -> AddInstanceGroups -> Bool
Prelude.Eq, ReadPrec [AddInstanceGroups]
ReadPrec AddInstanceGroups
Int -> ReadS AddInstanceGroups
ReadS [AddInstanceGroups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddInstanceGroups]
$creadListPrec :: ReadPrec [AddInstanceGroups]
readPrec :: ReadPrec AddInstanceGroups
$creadPrec :: ReadPrec AddInstanceGroups
readList :: ReadS [AddInstanceGroups]
$creadList :: ReadS [AddInstanceGroups]
readsPrec :: Int -> ReadS AddInstanceGroups
$creadsPrec :: Int -> ReadS AddInstanceGroups
Prelude.Read, Int -> AddInstanceGroups -> ShowS
[AddInstanceGroups] -> ShowS
AddInstanceGroups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddInstanceGroups] -> ShowS
$cshowList :: [AddInstanceGroups] -> ShowS
show :: AddInstanceGroups -> String
$cshow :: AddInstanceGroups -> String
showsPrec :: Int -> AddInstanceGroups -> ShowS
$cshowsPrec :: Int -> AddInstanceGroups -> ShowS
Prelude.Show, forall x. Rep AddInstanceGroups x -> AddInstanceGroups
forall x. AddInstanceGroups -> Rep AddInstanceGroups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddInstanceGroups x -> AddInstanceGroups
$cfrom :: forall x. AddInstanceGroups -> Rep AddInstanceGroups x
Prelude.Generic)

-- |
-- Create a value of 'AddInstanceGroups' 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:
--
-- 'instanceGroups', 'addInstanceGroups_instanceGroups' - Instance groups to add.
--
-- 'jobFlowId', 'addInstanceGroups_jobFlowId' - Job flow in which to add the instance groups.
newAddInstanceGroups ::
  -- | 'jobFlowId'
  Prelude.Text ->
  AddInstanceGroups
newAddInstanceGroups :: Text -> AddInstanceGroups
newAddInstanceGroups Text
pJobFlowId_ =
  AddInstanceGroups'
    { $sel:instanceGroups:AddInstanceGroups' :: [InstanceGroupConfig]
instanceGroups = forall a. Monoid a => a
Prelude.mempty,
      $sel:jobFlowId:AddInstanceGroups' :: Text
jobFlowId = Text
pJobFlowId_
    }

-- | Instance groups to add.
addInstanceGroups_instanceGroups :: Lens.Lens' AddInstanceGroups [InstanceGroupConfig]
addInstanceGroups_instanceGroups :: Lens' AddInstanceGroups [InstanceGroupConfig]
addInstanceGroups_instanceGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddInstanceGroups' {[InstanceGroupConfig]
instanceGroups :: [InstanceGroupConfig]
$sel:instanceGroups:AddInstanceGroups' :: AddInstanceGroups -> [InstanceGroupConfig]
instanceGroups} -> [InstanceGroupConfig]
instanceGroups) (\s :: AddInstanceGroups
s@AddInstanceGroups' {} [InstanceGroupConfig]
a -> AddInstanceGroups
s {$sel:instanceGroups:AddInstanceGroups' :: [InstanceGroupConfig]
instanceGroups = [InstanceGroupConfig]
a} :: AddInstanceGroups) 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

-- | Job flow in which to add the instance groups.
addInstanceGroups_jobFlowId :: Lens.Lens' AddInstanceGroups Prelude.Text
addInstanceGroups_jobFlowId :: Lens' AddInstanceGroups Text
addInstanceGroups_jobFlowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddInstanceGroups' {Text
jobFlowId :: Text
$sel:jobFlowId:AddInstanceGroups' :: AddInstanceGroups -> Text
jobFlowId} -> Text
jobFlowId) (\s :: AddInstanceGroups
s@AddInstanceGroups' {} Text
a -> AddInstanceGroups
s {$sel:jobFlowId:AddInstanceGroups' :: Text
jobFlowId = Text
a} :: AddInstanceGroups)

instance Core.AWSRequest AddInstanceGroups where
  type
    AWSResponse AddInstanceGroups =
      AddInstanceGroupsResponse
  request :: (Service -> Service)
-> AddInstanceGroups -> Request AddInstanceGroups
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 AddInstanceGroups
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddInstanceGroups)))
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] -> Maybe Text -> Int -> AddInstanceGroupsResponse
AddInstanceGroupsResponse'
            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
"ClusterArn")
            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
"InstanceGroupIds"
                            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
"JobFlowId")
            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 AddInstanceGroups where
  hashWithSalt :: Int -> AddInstanceGroups -> Int
hashWithSalt Int
_salt AddInstanceGroups' {[InstanceGroupConfig]
Text
jobFlowId :: Text
instanceGroups :: [InstanceGroupConfig]
$sel:jobFlowId:AddInstanceGroups' :: AddInstanceGroups -> Text
$sel:instanceGroups:AddInstanceGroups' :: AddInstanceGroups -> [InstanceGroupConfig]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [InstanceGroupConfig]
instanceGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobFlowId

instance Prelude.NFData AddInstanceGroups where
  rnf :: AddInstanceGroups -> ()
rnf AddInstanceGroups' {[InstanceGroupConfig]
Text
jobFlowId :: Text
instanceGroups :: [InstanceGroupConfig]
$sel:jobFlowId:AddInstanceGroups' :: AddInstanceGroups -> Text
$sel:instanceGroups:AddInstanceGroups' :: AddInstanceGroups -> [InstanceGroupConfig]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [InstanceGroupConfig]
instanceGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobFlowId

instance Data.ToHeaders AddInstanceGroups where
  toHeaders :: AddInstanceGroups -> 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
"ElasticMapReduce.AddInstanceGroups" ::
                          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 AddInstanceGroups where
  toJSON :: AddInstanceGroups -> Value
toJSON AddInstanceGroups' {[InstanceGroupConfig]
Text
jobFlowId :: Text
instanceGroups :: [InstanceGroupConfig]
$sel:jobFlowId:AddInstanceGroups' :: AddInstanceGroups -> Text
$sel:instanceGroups:AddInstanceGroups' :: AddInstanceGroups -> [InstanceGroupConfig]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"InstanceGroups" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [InstanceGroupConfig]
instanceGroups),
            forall a. a -> Maybe a
Prelude.Just (Key
"JobFlowId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobFlowId)
          ]
      )

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

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

-- | Output from an AddInstanceGroups call.
--
-- /See:/ 'newAddInstanceGroupsResponse' smart constructor.
data AddInstanceGroupsResponse = AddInstanceGroupsResponse'
  { -- | The Amazon Resource Name of the cluster.
    AddInstanceGroupsResponse -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | Instance group IDs of the newly created instance groups.
    AddInstanceGroupsResponse -> Maybe [Text]
instanceGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The job flow ID in which the instance groups are added.
    AddInstanceGroupsResponse -> Maybe Text
jobFlowId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AddInstanceGroupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddInstanceGroupsResponse -> AddInstanceGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddInstanceGroupsResponse -> AddInstanceGroupsResponse -> Bool
$c/= :: AddInstanceGroupsResponse -> AddInstanceGroupsResponse -> Bool
== :: AddInstanceGroupsResponse -> AddInstanceGroupsResponse -> Bool
$c== :: AddInstanceGroupsResponse -> AddInstanceGroupsResponse -> Bool
Prelude.Eq, ReadPrec [AddInstanceGroupsResponse]
ReadPrec AddInstanceGroupsResponse
Int -> ReadS AddInstanceGroupsResponse
ReadS [AddInstanceGroupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddInstanceGroupsResponse]
$creadListPrec :: ReadPrec [AddInstanceGroupsResponse]
readPrec :: ReadPrec AddInstanceGroupsResponse
$creadPrec :: ReadPrec AddInstanceGroupsResponse
readList :: ReadS [AddInstanceGroupsResponse]
$creadList :: ReadS [AddInstanceGroupsResponse]
readsPrec :: Int -> ReadS AddInstanceGroupsResponse
$creadsPrec :: Int -> ReadS AddInstanceGroupsResponse
Prelude.Read, Int -> AddInstanceGroupsResponse -> ShowS
[AddInstanceGroupsResponse] -> ShowS
AddInstanceGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddInstanceGroupsResponse] -> ShowS
$cshowList :: [AddInstanceGroupsResponse] -> ShowS
show :: AddInstanceGroupsResponse -> String
$cshow :: AddInstanceGroupsResponse -> String
showsPrec :: Int -> AddInstanceGroupsResponse -> ShowS
$cshowsPrec :: Int -> AddInstanceGroupsResponse -> ShowS
Prelude.Show, forall x.
Rep AddInstanceGroupsResponse x -> AddInstanceGroupsResponse
forall x.
AddInstanceGroupsResponse -> Rep AddInstanceGroupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddInstanceGroupsResponse x -> AddInstanceGroupsResponse
$cfrom :: forall x.
AddInstanceGroupsResponse -> Rep AddInstanceGroupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddInstanceGroupsResponse' 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:
--
-- 'clusterArn', 'addInstanceGroupsResponse_clusterArn' - The Amazon Resource Name of the cluster.
--
-- 'instanceGroupIds', 'addInstanceGroupsResponse_instanceGroupIds' - Instance group IDs of the newly created instance groups.
--
-- 'jobFlowId', 'addInstanceGroupsResponse_jobFlowId' - The job flow ID in which the instance groups are added.
--
-- 'httpStatus', 'addInstanceGroupsResponse_httpStatus' - The response's http status code.
newAddInstanceGroupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddInstanceGroupsResponse
newAddInstanceGroupsResponse :: Int -> AddInstanceGroupsResponse
newAddInstanceGroupsResponse Int
pHttpStatus_ =
  AddInstanceGroupsResponse'
    { $sel:clusterArn:AddInstanceGroupsResponse' :: Maybe Text
clusterArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:instanceGroupIds:AddInstanceGroupsResponse' :: Maybe [Text]
instanceGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:jobFlowId:AddInstanceGroupsResponse' :: Maybe Text
jobFlowId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddInstanceGroupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name of the cluster.
addInstanceGroupsResponse_clusterArn :: Lens.Lens' AddInstanceGroupsResponse (Prelude.Maybe Prelude.Text)
addInstanceGroupsResponse_clusterArn :: Lens' AddInstanceGroupsResponse (Maybe Text)
addInstanceGroupsResponse_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddInstanceGroupsResponse' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:AddInstanceGroupsResponse' :: AddInstanceGroupsResponse -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: AddInstanceGroupsResponse
s@AddInstanceGroupsResponse' {} Maybe Text
a -> AddInstanceGroupsResponse
s {$sel:clusterArn:AddInstanceGroupsResponse' :: Maybe Text
clusterArn = Maybe Text
a} :: AddInstanceGroupsResponse)

-- | Instance group IDs of the newly created instance groups.
addInstanceGroupsResponse_instanceGroupIds :: Lens.Lens' AddInstanceGroupsResponse (Prelude.Maybe [Prelude.Text])
addInstanceGroupsResponse_instanceGroupIds :: Lens' AddInstanceGroupsResponse (Maybe [Text])
addInstanceGroupsResponse_instanceGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddInstanceGroupsResponse' {Maybe [Text]
instanceGroupIds :: Maybe [Text]
$sel:instanceGroupIds:AddInstanceGroupsResponse' :: AddInstanceGroupsResponse -> Maybe [Text]
instanceGroupIds} -> Maybe [Text]
instanceGroupIds) (\s :: AddInstanceGroupsResponse
s@AddInstanceGroupsResponse' {} Maybe [Text]
a -> AddInstanceGroupsResponse
s {$sel:instanceGroupIds:AddInstanceGroupsResponse' :: Maybe [Text]
instanceGroupIds = Maybe [Text]
a} :: AddInstanceGroupsResponse) 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 job flow ID in which the instance groups are added.
addInstanceGroupsResponse_jobFlowId :: Lens.Lens' AddInstanceGroupsResponse (Prelude.Maybe Prelude.Text)
addInstanceGroupsResponse_jobFlowId :: Lens' AddInstanceGroupsResponse (Maybe Text)
addInstanceGroupsResponse_jobFlowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddInstanceGroupsResponse' {Maybe Text
jobFlowId :: Maybe Text
$sel:jobFlowId:AddInstanceGroupsResponse' :: AddInstanceGroupsResponse -> Maybe Text
jobFlowId} -> Maybe Text
jobFlowId) (\s :: AddInstanceGroupsResponse
s@AddInstanceGroupsResponse' {} Maybe Text
a -> AddInstanceGroupsResponse
s {$sel:jobFlowId:AddInstanceGroupsResponse' :: Maybe Text
jobFlowId = Maybe Text
a} :: AddInstanceGroupsResponse)

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

instance Prelude.NFData AddInstanceGroupsResponse where
  rnf :: AddInstanceGroupsResponse -> ()
rnf AddInstanceGroupsResponse' {Int
Maybe [Text]
Maybe Text
httpStatus :: Int
jobFlowId :: Maybe Text
instanceGroupIds :: Maybe [Text]
clusterArn :: Maybe Text
$sel:httpStatus:AddInstanceGroupsResponse' :: AddInstanceGroupsResponse -> Int
$sel:jobFlowId:AddInstanceGroupsResponse' :: AddInstanceGroupsResponse -> Maybe Text
$sel:instanceGroupIds:AddInstanceGroupsResponse' :: AddInstanceGroupsResponse -> Maybe [Text]
$sel:clusterArn:AddInstanceGroupsResponse' :: AddInstanceGroupsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
instanceGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobFlowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus