{-# 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.MigrationHub.AssociateCreatedArtifact
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a created artifact of an AWS cloud resource, the target
-- receiving the migration, with the migration task performed by a
-- migration tool. This API has the following traits:
--
-- -   Migration tools can call the @AssociateCreatedArtifact@ operation to
--     indicate which AWS artifact is associated with a migration task.
--
-- -   The created artifact name must be provided in ARN (Amazon Resource
--     Name) format which will contain information about type and region;
--     for example:
--     @arn:aws:ec2:us-east-1:488216288981:image\/ami-6d0ba87b@.
--
-- -   Examples of the AWS resource behind the created artifact are,
--     AMI\'s, EC2 instance, or DMS endpoint, etc.
module Amazonka.MigrationHub.AssociateCreatedArtifact
  ( -- * Creating a Request
    AssociateCreatedArtifact (..),
    newAssociateCreatedArtifact,

    -- * Request Lenses
    associateCreatedArtifact_dryRun,
    associateCreatedArtifact_progressUpdateStream,
    associateCreatedArtifact_migrationTaskName,
    associateCreatedArtifact_createdArtifact,

    -- * Destructuring the Response
    AssociateCreatedArtifactResponse (..),
    newAssociateCreatedArtifactResponse,

    -- * Response Lenses
    associateCreatedArtifactResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAssociateCreatedArtifact' smart constructor.
data AssociateCreatedArtifact = AssociateCreatedArtifact'
  { -- | Optional boolean flag to indicate whether any effect should take place.
    -- Used to test if the caller has permission to make the call.
    AssociateCreatedArtifact -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The name of the ProgressUpdateStream.
    AssociateCreatedArtifact -> Text
progressUpdateStream :: Prelude.Text,
    -- | Unique identifier that references the migration task. /Do not store
    -- personal data in this field./
    AssociateCreatedArtifact -> Text
migrationTaskName :: Prelude.Text,
    -- | An ARN of the AWS resource related to the migration (e.g., AMI, EC2
    -- instance, RDS instance, etc.)
    AssociateCreatedArtifact -> CreatedArtifact
createdArtifact :: CreatedArtifact
  }
  deriving (AssociateCreatedArtifact -> AssociateCreatedArtifact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateCreatedArtifact -> AssociateCreatedArtifact -> Bool
$c/= :: AssociateCreatedArtifact -> AssociateCreatedArtifact -> Bool
== :: AssociateCreatedArtifact -> AssociateCreatedArtifact -> Bool
$c== :: AssociateCreatedArtifact -> AssociateCreatedArtifact -> Bool
Prelude.Eq, ReadPrec [AssociateCreatedArtifact]
ReadPrec AssociateCreatedArtifact
Int -> ReadS AssociateCreatedArtifact
ReadS [AssociateCreatedArtifact]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateCreatedArtifact]
$creadListPrec :: ReadPrec [AssociateCreatedArtifact]
readPrec :: ReadPrec AssociateCreatedArtifact
$creadPrec :: ReadPrec AssociateCreatedArtifact
readList :: ReadS [AssociateCreatedArtifact]
$creadList :: ReadS [AssociateCreatedArtifact]
readsPrec :: Int -> ReadS AssociateCreatedArtifact
$creadsPrec :: Int -> ReadS AssociateCreatedArtifact
Prelude.Read, Int -> AssociateCreatedArtifact -> ShowS
[AssociateCreatedArtifact] -> ShowS
AssociateCreatedArtifact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateCreatedArtifact] -> ShowS
$cshowList :: [AssociateCreatedArtifact] -> ShowS
show :: AssociateCreatedArtifact -> String
$cshow :: AssociateCreatedArtifact -> String
showsPrec :: Int -> AssociateCreatedArtifact -> ShowS
$cshowsPrec :: Int -> AssociateCreatedArtifact -> ShowS
Prelude.Show, forall x.
Rep AssociateCreatedArtifact x -> AssociateCreatedArtifact
forall x.
AssociateCreatedArtifact -> Rep AssociateCreatedArtifact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateCreatedArtifact x -> AssociateCreatedArtifact
$cfrom :: forall x.
AssociateCreatedArtifact -> Rep AssociateCreatedArtifact x
Prelude.Generic)

-- |
-- Create a value of 'AssociateCreatedArtifact' 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:
--
-- 'dryRun', 'associateCreatedArtifact_dryRun' - Optional boolean flag to indicate whether any effect should take place.
-- Used to test if the caller has permission to make the call.
--
-- 'progressUpdateStream', 'associateCreatedArtifact_progressUpdateStream' - The name of the ProgressUpdateStream.
--
-- 'migrationTaskName', 'associateCreatedArtifact_migrationTaskName' - Unique identifier that references the migration task. /Do not store
-- personal data in this field./
--
-- 'createdArtifact', 'associateCreatedArtifact_createdArtifact' - An ARN of the AWS resource related to the migration (e.g., AMI, EC2
-- instance, RDS instance, etc.)
newAssociateCreatedArtifact ::
  -- | 'progressUpdateStream'
  Prelude.Text ->
  -- | 'migrationTaskName'
  Prelude.Text ->
  -- | 'createdArtifact'
  CreatedArtifact ->
  AssociateCreatedArtifact
newAssociateCreatedArtifact :: Text -> Text -> CreatedArtifact -> AssociateCreatedArtifact
newAssociateCreatedArtifact
  Text
pProgressUpdateStream_
  Text
pMigrationTaskName_
  CreatedArtifact
pCreatedArtifact_ =
    AssociateCreatedArtifact'
      { $sel:dryRun:AssociateCreatedArtifact' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:progressUpdateStream:AssociateCreatedArtifact' :: Text
progressUpdateStream = Text
pProgressUpdateStream_,
        $sel:migrationTaskName:AssociateCreatedArtifact' :: Text
migrationTaskName = Text
pMigrationTaskName_,
        $sel:createdArtifact:AssociateCreatedArtifact' :: CreatedArtifact
createdArtifact = CreatedArtifact
pCreatedArtifact_
      }

-- | Optional boolean flag to indicate whether any effect should take place.
-- Used to test if the caller has permission to make the call.
associateCreatedArtifact_dryRun :: Lens.Lens' AssociateCreatedArtifact (Prelude.Maybe Prelude.Bool)
associateCreatedArtifact_dryRun :: Lens' AssociateCreatedArtifact (Maybe Bool)
associateCreatedArtifact_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCreatedArtifact' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: AssociateCreatedArtifact
s@AssociateCreatedArtifact' {} Maybe Bool
a -> AssociateCreatedArtifact
s {$sel:dryRun:AssociateCreatedArtifact' :: Maybe Bool
dryRun = Maybe Bool
a} :: AssociateCreatedArtifact)

-- | The name of the ProgressUpdateStream.
associateCreatedArtifact_progressUpdateStream :: Lens.Lens' AssociateCreatedArtifact Prelude.Text
associateCreatedArtifact_progressUpdateStream :: Lens' AssociateCreatedArtifact Text
associateCreatedArtifact_progressUpdateStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCreatedArtifact' {Text
progressUpdateStream :: Text
$sel:progressUpdateStream:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
progressUpdateStream} -> Text
progressUpdateStream) (\s :: AssociateCreatedArtifact
s@AssociateCreatedArtifact' {} Text
a -> AssociateCreatedArtifact
s {$sel:progressUpdateStream:AssociateCreatedArtifact' :: Text
progressUpdateStream = Text
a} :: AssociateCreatedArtifact)

-- | Unique identifier that references the migration task. /Do not store
-- personal data in this field./
associateCreatedArtifact_migrationTaskName :: Lens.Lens' AssociateCreatedArtifact Prelude.Text
associateCreatedArtifact_migrationTaskName :: Lens' AssociateCreatedArtifact Text
associateCreatedArtifact_migrationTaskName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCreatedArtifact' {Text
migrationTaskName :: Text
$sel:migrationTaskName:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
migrationTaskName} -> Text
migrationTaskName) (\s :: AssociateCreatedArtifact
s@AssociateCreatedArtifact' {} Text
a -> AssociateCreatedArtifact
s {$sel:migrationTaskName:AssociateCreatedArtifact' :: Text
migrationTaskName = Text
a} :: AssociateCreatedArtifact)

-- | An ARN of the AWS resource related to the migration (e.g., AMI, EC2
-- instance, RDS instance, etc.)
associateCreatedArtifact_createdArtifact :: Lens.Lens' AssociateCreatedArtifact CreatedArtifact
associateCreatedArtifact_createdArtifact :: Lens' AssociateCreatedArtifact CreatedArtifact
associateCreatedArtifact_createdArtifact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCreatedArtifact' {CreatedArtifact
createdArtifact :: CreatedArtifact
$sel:createdArtifact:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> CreatedArtifact
createdArtifact} -> CreatedArtifact
createdArtifact) (\s :: AssociateCreatedArtifact
s@AssociateCreatedArtifact' {} CreatedArtifact
a -> AssociateCreatedArtifact
s {$sel:createdArtifact:AssociateCreatedArtifact' :: CreatedArtifact
createdArtifact = CreatedArtifact
a} :: AssociateCreatedArtifact)

instance Core.AWSRequest AssociateCreatedArtifact where
  type
    AWSResponse AssociateCreatedArtifact =
      AssociateCreatedArtifactResponse
  request :: (Service -> Service)
-> AssociateCreatedArtifact -> Request AssociateCreatedArtifact
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 AssociateCreatedArtifact
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateCreatedArtifact)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociateCreatedArtifactResponse
AssociateCreatedArtifactResponse'
            forall (f :: * -> *) a b. Functor 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 AssociateCreatedArtifact where
  hashWithSalt :: Int -> AssociateCreatedArtifact -> Int
hashWithSalt Int
_salt AssociateCreatedArtifact' {Maybe Bool
Text
CreatedArtifact
createdArtifact :: CreatedArtifact
migrationTaskName :: Text
progressUpdateStream :: Text
dryRun :: Maybe Bool
$sel:createdArtifact:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> CreatedArtifact
$sel:migrationTaskName:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
$sel:progressUpdateStream:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
$sel:dryRun:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
progressUpdateStream
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
migrationTaskName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CreatedArtifact
createdArtifact

instance Prelude.NFData AssociateCreatedArtifact where
  rnf :: AssociateCreatedArtifact -> ()
rnf AssociateCreatedArtifact' {Maybe Bool
Text
CreatedArtifact
createdArtifact :: CreatedArtifact
migrationTaskName :: Text
progressUpdateStream :: Text
dryRun :: Maybe Bool
$sel:createdArtifact:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> CreatedArtifact
$sel:migrationTaskName:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
$sel:progressUpdateStream:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
$sel:dryRun:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
progressUpdateStream
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
migrationTaskName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CreatedArtifact
createdArtifact

instance Data.ToHeaders AssociateCreatedArtifact where
  toHeaders :: AssociateCreatedArtifact -> 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
"AWSMigrationHub.AssociateCreatedArtifact" ::
                          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 AssociateCreatedArtifact where
  toJSON :: AssociateCreatedArtifact -> Value
toJSON AssociateCreatedArtifact' {Maybe Bool
Text
CreatedArtifact
createdArtifact :: CreatedArtifact
migrationTaskName :: Text
progressUpdateStream :: Text
dryRun :: Maybe Bool
$sel:createdArtifact:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> CreatedArtifact
$sel:migrationTaskName:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
$sel:progressUpdateStream:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Text
$sel:dryRun:AssociateCreatedArtifact' :: AssociateCreatedArtifact -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DryRun" 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 Bool
dryRun,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ProgressUpdateStream"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
progressUpdateStream
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"MigrationTaskName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
migrationTaskName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CreatedArtifact" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CreatedArtifact
createdArtifact)
          ]
      )

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

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

-- | /See:/ 'newAssociateCreatedArtifactResponse' smart constructor.
data AssociateCreatedArtifactResponse = AssociateCreatedArtifactResponse'
  { -- | The response's http status code.
    AssociateCreatedArtifactResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateCreatedArtifactResponse
-> AssociateCreatedArtifactResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateCreatedArtifactResponse
-> AssociateCreatedArtifactResponse -> Bool
$c/= :: AssociateCreatedArtifactResponse
-> AssociateCreatedArtifactResponse -> Bool
== :: AssociateCreatedArtifactResponse
-> AssociateCreatedArtifactResponse -> Bool
$c== :: AssociateCreatedArtifactResponse
-> AssociateCreatedArtifactResponse -> Bool
Prelude.Eq, ReadPrec [AssociateCreatedArtifactResponse]
ReadPrec AssociateCreatedArtifactResponse
Int -> ReadS AssociateCreatedArtifactResponse
ReadS [AssociateCreatedArtifactResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateCreatedArtifactResponse]
$creadListPrec :: ReadPrec [AssociateCreatedArtifactResponse]
readPrec :: ReadPrec AssociateCreatedArtifactResponse
$creadPrec :: ReadPrec AssociateCreatedArtifactResponse
readList :: ReadS [AssociateCreatedArtifactResponse]
$creadList :: ReadS [AssociateCreatedArtifactResponse]
readsPrec :: Int -> ReadS AssociateCreatedArtifactResponse
$creadsPrec :: Int -> ReadS AssociateCreatedArtifactResponse
Prelude.Read, Int -> AssociateCreatedArtifactResponse -> ShowS
[AssociateCreatedArtifactResponse] -> ShowS
AssociateCreatedArtifactResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateCreatedArtifactResponse] -> ShowS
$cshowList :: [AssociateCreatedArtifactResponse] -> ShowS
show :: AssociateCreatedArtifactResponse -> String
$cshow :: AssociateCreatedArtifactResponse -> String
showsPrec :: Int -> AssociateCreatedArtifactResponse -> ShowS
$cshowsPrec :: Int -> AssociateCreatedArtifactResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateCreatedArtifactResponse x
-> AssociateCreatedArtifactResponse
forall x.
AssociateCreatedArtifactResponse
-> Rep AssociateCreatedArtifactResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateCreatedArtifactResponse x
-> AssociateCreatedArtifactResponse
$cfrom :: forall x.
AssociateCreatedArtifactResponse
-> Rep AssociateCreatedArtifactResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateCreatedArtifactResponse' 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:
--
-- 'httpStatus', 'associateCreatedArtifactResponse_httpStatus' - The response's http status code.
newAssociateCreatedArtifactResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateCreatedArtifactResponse
newAssociateCreatedArtifactResponse :: Int -> AssociateCreatedArtifactResponse
newAssociateCreatedArtifactResponse Int
pHttpStatus_ =
  AssociateCreatedArtifactResponse'
    { $sel:httpStatus:AssociateCreatedArtifactResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    AssociateCreatedArtifactResponse
  where
  rnf :: AssociateCreatedArtifactResponse -> ()
rnf AssociateCreatedArtifactResponse' {Int
httpStatus :: Int
$sel:httpStatus:AssociateCreatedArtifactResponse' :: AssociateCreatedArtifactResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus