{-# 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.ApiGatewayV2.ExportApi
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- -- | Undocumented operation.
module Amazonka.ApiGatewayV2.ExportApi
  ( -- * Creating a Request
    ExportApi (..),
    newExportApi,

    -- * Request Lenses
    exportApi_exportVersion,
    exportApi_includeExtensions,
    exportApi_stageName,
    exportApi_specification,
    exportApi_outputType,
    exportApi_apiId,

    -- * Destructuring the Response
    ExportApiResponse (..),
    newExportApiResponse,

    -- * Response Lenses
    exportApiResponse_body,
    exportApiResponse_httpStatus,
  )
where

import Amazonka.ApiGatewayV2.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:/ 'newExportApi' smart constructor.
data ExportApi = ExportApi'
  { -- | The version of the API Gateway export algorithm. API Gateway uses the
    -- latest version by default. Currently, the only supported version is 1.0.
    ExportApi -> Maybe Text
exportVersion :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether to include
    -- <https://docs.aws.amazon.com//apigateway/latest/developerguide/api-gateway-swagger-extensions.html API Gateway extensions>
    -- in the exported API definition. API Gateway extensions are included by
    -- default.
    ExportApi -> Maybe Bool
includeExtensions :: Prelude.Maybe Prelude.Bool,
    -- | The name of the API stage to export. If you don\'t specify this
    -- property, a representation of the latest API configuration is exported.
    ExportApi -> Maybe Text
stageName :: Prelude.Maybe Prelude.Text,
    -- | The version of the API specification to use. OAS30, for OpenAPI 3.0, is
    -- the only supported value.
    ExportApi -> Text
specification :: Prelude.Text,
    -- | The output type of the exported definition file. Valid values are JSON
    -- and YAML.
    ExportApi -> Text
outputType :: Prelude.Text,
    -- | The API identifier.
    ExportApi -> Text
apiId :: Prelude.Text
  }
  deriving (ExportApi -> ExportApi -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportApi -> ExportApi -> Bool
$c/= :: ExportApi -> ExportApi -> Bool
== :: ExportApi -> ExportApi -> Bool
$c== :: ExportApi -> ExportApi -> Bool
Prelude.Eq, ReadPrec [ExportApi]
ReadPrec ExportApi
Int -> ReadS ExportApi
ReadS [ExportApi]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportApi]
$creadListPrec :: ReadPrec [ExportApi]
readPrec :: ReadPrec ExportApi
$creadPrec :: ReadPrec ExportApi
readList :: ReadS [ExportApi]
$creadList :: ReadS [ExportApi]
readsPrec :: Int -> ReadS ExportApi
$creadsPrec :: Int -> ReadS ExportApi
Prelude.Read, Int -> ExportApi -> ShowS
[ExportApi] -> ShowS
ExportApi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportApi] -> ShowS
$cshowList :: [ExportApi] -> ShowS
show :: ExportApi -> String
$cshow :: ExportApi -> String
showsPrec :: Int -> ExportApi -> ShowS
$cshowsPrec :: Int -> ExportApi -> ShowS
Prelude.Show, forall x. Rep ExportApi x -> ExportApi
forall x. ExportApi -> Rep ExportApi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportApi x -> ExportApi
$cfrom :: forall x. ExportApi -> Rep ExportApi x
Prelude.Generic)

-- |
-- Create a value of 'ExportApi' 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:
--
-- 'exportVersion', 'exportApi_exportVersion' - The version of the API Gateway export algorithm. API Gateway uses the
-- latest version by default. Currently, the only supported version is 1.0.
--
-- 'includeExtensions', 'exportApi_includeExtensions' - Specifies whether to include
-- <https://docs.aws.amazon.com//apigateway/latest/developerguide/api-gateway-swagger-extensions.html API Gateway extensions>
-- in the exported API definition. API Gateway extensions are included by
-- default.
--
-- 'stageName', 'exportApi_stageName' - The name of the API stage to export. If you don\'t specify this
-- property, a representation of the latest API configuration is exported.
--
-- 'specification', 'exportApi_specification' - The version of the API specification to use. OAS30, for OpenAPI 3.0, is
-- the only supported value.
--
-- 'outputType', 'exportApi_outputType' - The output type of the exported definition file. Valid values are JSON
-- and YAML.
--
-- 'apiId', 'exportApi_apiId' - The API identifier.
newExportApi ::
  -- | 'specification'
  Prelude.Text ->
  -- | 'outputType'
  Prelude.Text ->
  -- | 'apiId'
  Prelude.Text ->
  ExportApi
newExportApi :: Text -> Text -> Text -> ExportApi
newExportApi Text
pSpecification_ Text
pOutputType_ Text
pApiId_ =
  ExportApi'
    { $sel:exportVersion:ExportApi' :: Maybe Text
exportVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:includeExtensions:ExportApi' :: Maybe Bool
includeExtensions = forall a. Maybe a
Prelude.Nothing,
      $sel:stageName:ExportApi' :: Maybe Text
stageName = forall a. Maybe a
Prelude.Nothing,
      $sel:specification:ExportApi' :: Text
specification = Text
pSpecification_,
      $sel:outputType:ExportApi' :: Text
outputType = Text
pOutputType_,
      $sel:apiId:ExportApi' :: Text
apiId = Text
pApiId_
    }

-- | The version of the API Gateway export algorithm. API Gateway uses the
-- latest version by default. Currently, the only supported version is 1.0.
exportApi_exportVersion :: Lens.Lens' ExportApi (Prelude.Maybe Prelude.Text)
exportApi_exportVersion :: Lens' ExportApi (Maybe Text)
exportApi_exportVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportApi' {Maybe Text
exportVersion :: Maybe Text
$sel:exportVersion:ExportApi' :: ExportApi -> Maybe Text
exportVersion} -> Maybe Text
exportVersion) (\s :: ExportApi
s@ExportApi' {} Maybe Text
a -> ExportApi
s {$sel:exportVersion:ExportApi' :: Maybe Text
exportVersion = Maybe Text
a} :: ExportApi)

-- | Specifies whether to include
-- <https://docs.aws.amazon.com//apigateway/latest/developerguide/api-gateway-swagger-extensions.html API Gateway extensions>
-- in the exported API definition. API Gateway extensions are included by
-- default.
exportApi_includeExtensions :: Lens.Lens' ExportApi (Prelude.Maybe Prelude.Bool)
exportApi_includeExtensions :: Lens' ExportApi (Maybe Bool)
exportApi_includeExtensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportApi' {Maybe Bool
includeExtensions :: Maybe Bool
$sel:includeExtensions:ExportApi' :: ExportApi -> Maybe Bool
includeExtensions} -> Maybe Bool
includeExtensions) (\s :: ExportApi
s@ExportApi' {} Maybe Bool
a -> ExportApi
s {$sel:includeExtensions:ExportApi' :: Maybe Bool
includeExtensions = Maybe Bool
a} :: ExportApi)

-- | The name of the API stage to export. If you don\'t specify this
-- property, a representation of the latest API configuration is exported.
exportApi_stageName :: Lens.Lens' ExportApi (Prelude.Maybe Prelude.Text)
exportApi_stageName :: Lens' ExportApi (Maybe Text)
exportApi_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportApi' {Maybe Text
stageName :: Maybe Text
$sel:stageName:ExportApi' :: ExportApi -> Maybe Text
stageName} -> Maybe Text
stageName) (\s :: ExportApi
s@ExportApi' {} Maybe Text
a -> ExportApi
s {$sel:stageName:ExportApi' :: Maybe Text
stageName = Maybe Text
a} :: ExportApi)

-- | The version of the API specification to use. OAS30, for OpenAPI 3.0, is
-- the only supported value.
exportApi_specification :: Lens.Lens' ExportApi Prelude.Text
exportApi_specification :: Lens' ExportApi Text
exportApi_specification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportApi' {Text
specification :: Text
$sel:specification:ExportApi' :: ExportApi -> Text
specification} -> Text
specification) (\s :: ExportApi
s@ExportApi' {} Text
a -> ExportApi
s {$sel:specification:ExportApi' :: Text
specification = Text
a} :: ExportApi)

-- | The output type of the exported definition file. Valid values are JSON
-- and YAML.
exportApi_outputType :: Lens.Lens' ExportApi Prelude.Text
exportApi_outputType :: Lens' ExportApi Text
exportApi_outputType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportApi' {Text
outputType :: Text
$sel:outputType:ExportApi' :: ExportApi -> Text
outputType} -> Text
outputType) (\s :: ExportApi
s@ExportApi' {} Text
a -> ExportApi
s {$sel:outputType:ExportApi' :: Text
outputType = Text
a} :: ExportApi)

-- | The API identifier.
exportApi_apiId :: Lens.Lens' ExportApi Prelude.Text
exportApi_apiId :: Lens' ExportApi Text
exportApi_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportApi' {Text
apiId :: Text
$sel:apiId:ExportApi' :: ExportApi -> Text
apiId} -> Text
apiId) (\s :: ExportApi
s@ExportApi' {} Text
a -> ExportApi
s {$sel:apiId:ExportApi' :: Text
apiId = Text
a} :: ExportApi)

instance Core.AWSRequest ExportApi where
  type AWSResponse ExportApi = ExportApiResponse
  request :: (Service -> Service) -> ExportApi -> Request ExportApi
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ExportApi
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ExportApi)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBytes
      ( \Int
s ResponseHeaders
h ByteString
x ->
          Maybe ByteString -> Int -> ExportApiResponse
ExportApiResponse'
            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. a -> Maybe a
Prelude.Just (coerce :: forall a b. Coercible a b => a -> b
Prelude.coerce ByteString
x)))
            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 ExportApi where
  hashWithSalt :: Int -> ExportApi -> Int
hashWithSalt Int
_salt ExportApi' {Maybe Bool
Maybe Text
Text
apiId :: Text
outputType :: Text
specification :: Text
stageName :: Maybe Text
includeExtensions :: Maybe Bool
exportVersion :: Maybe Text
$sel:apiId:ExportApi' :: ExportApi -> Text
$sel:outputType:ExportApi' :: ExportApi -> Text
$sel:specification:ExportApi' :: ExportApi -> Text
$sel:stageName:ExportApi' :: ExportApi -> Maybe Text
$sel:includeExtensions:ExportApi' :: ExportApi -> Maybe Bool
$sel:exportVersion:ExportApi' :: ExportApi -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
exportVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeExtensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
specification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
outputType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId

instance Prelude.NFData ExportApi where
  rnf :: ExportApi -> ()
rnf ExportApi' {Maybe Bool
Maybe Text
Text
apiId :: Text
outputType :: Text
specification :: Text
stageName :: Maybe Text
includeExtensions :: Maybe Bool
exportVersion :: Maybe Text
$sel:apiId:ExportApi' :: ExportApi -> Text
$sel:outputType:ExportApi' :: ExportApi -> Text
$sel:specification:ExportApi' :: ExportApi -> Text
$sel:stageName:ExportApi' :: ExportApi -> Maybe Text
$sel:includeExtensions:ExportApi' :: ExportApi -> Maybe Bool
$sel:exportVersion:ExportApi' :: ExportApi -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
exportVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeExtensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
specification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
outputType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId

instance Data.ToHeaders ExportApi where
  toHeaders :: ExportApi -> 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.ToPath ExportApi where
  toPath :: ExportApi -> ByteString
toPath ExportApi' {Maybe Bool
Maybe Text
Text
apiId :: Text
outputType :: Text
specification :: Text
stageName :: Maybe Text
includeExtensions :: Maybe Bool
exportVersion :: Maybe Text
$sel:apiId:ExportApi' :: ExportApi -> Text
$sel:outputType:ExportApi' :: ExportApi -> Text
$sel:specification:ExportApi' :: ExportApi -> Text
$sel:stageName:ExportApi' :: ExportApi -> Maybe Text
$sel:includeExtensions:ExportApi' :: ExportApi -> Maybe Bool
$sel:exportVersion:ExportApi' :: ExportApi -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v2/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/exports/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
specification
      ]

instance Data.ToQuery ExportApi where
  toQuery :: ExportApi -> QueryString
toQuery ExportApi' {Maybe Bool
Maybe Text
Text
apiId :: Text
outputType :: Text
specification :: Text
stageName :: Maybe Text
includeExtensions :: Maybe Bool
exportVersion :: Maybe Text
$sel:apiId:ExportApi' :: ExportApi -> Text
$sel:outputType:ExportApi' :: ExportApi -> Text
$sel:specification:ExportApi' :: ExportApi -> Text
$sel:stageName:ExportApi' :: ExportApi -> Maybe Text
$sel:includeExtensions:ExportApi' :: ExportApi -> Maybe Bool
$sel:exportVersion:ExportApi' :: ExportApi -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"exportVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
exportVersion,
        ByteString
"includeExtensions" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeExtensions,
        ByteString
"stageName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
stageName,
        ByteString
"outputType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
outputType
      ]

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

-- |
-- Create a value of 'ExportApiResponse' 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:
--
-- 'body', 'exportApiResponse_body' - Undocumented member.
--
-- 'httpStatus', 'exportApiResponse_httpStatus' - The response's http status code.
newExportApiResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExportApiResponse
newExportApiResponse :: Int -> ExportApiResponse
newExportApiResponse Int
pHttpStatus_ =
  ExportApiResponse'
    { $sel:body:ExportApiResponse' :: Maybe ByteString
body = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExportApiResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
exportApiResponse_body :: Lens.Lens' ExportApiResponse (Prelude.Maybe Prelude.ByteString)
exportApiResponse_body :: Lens' ExportApiResponse (Maybe ByteString)
exportApiResponse_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportApiResponse' {Maybe ByteString
body :: Maybe ByteString
$sel:body:ExportApiResponse' :: ExportApiResponse -> Maybe ByteString
body} -> Maybe ByteString
body) (\s :: ExportApiResponse
s@ExportApiResponse' {} Maybe ByteString
a -> ExportApiResponse
s {$sel:body:ExportApiResponse' :: Maybe ByteString
body = Maybe ByteString
a} :: ExportApiResponse)

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

instance Prelude.NFData ExportApiResponse where
  rnf :: ExportApiResponse -> ()
rnf ExportApiResponse' {Int
Maybe ByteString
httpStatus :: Int
body :: Maybe ByteString
$sel:httpStatus:ExportApiResponse' :: ExportApiResponse -> Int
$sel:body:ExportApiResponse' :: ExportApiResponse -> Maybe ByteString
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ByteString
body
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus