{-# 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.APIGateway.GetExport
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Exports a deployed version of a RestApi in a specified format.
module Amazonka.APIGateway.GetExport
  ( -- * Creating a Request
    GetExport (..),
    newGetExport,

    -- * Request Lenses
    getExport_accepts,
    getExport_parameters,
    getExport_restApiId,
    getExport_stageName,
    getExport_exportType,

    -- * Destructuring the Response
    GetExportResponse (..),
    newGetExportResponse,

    -- * Response Lenses
    getExportResponse_body,
    getExportResponse_contentDisposition,
    getExportResponse_contentType,
    getExportResponse_httpStatus,
  )
where

import Amazonka.APIGateway.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

-- | Request a new export of a RestApi for a particular Stage.
--
-- /See:/ 'newGetExport' smart constructor.
data GetExport = GetExport'
  { -- | The content-type of the export, for example @application\/json@.
    -- Currently @application\/json@ and @application\/yaml@ are supported for
    -- @exportType@ of@oas30@ and @swagger@. This should be specified in the
    -- @Accept@ header for direct API requests.
    GetExport -> Maybe Text
accepts :: Prelude.Maybe Prelude.Text,
    -- | A key-value map of query string parameters that specify properties of
    -- the export, depending on the requested @exportType@. For @exportType@
    -- @oas30@ and @swagger@, any combination of the following parameters are
    -- supported: @extensions=\'integrations\'@ or @extensions=\'apigateway\'@
    -- will export the API with x-amazon-apigateway-integration extensions.
    -- @extensions=\'authorizers\'@ will export the API with
    -- x-amazon-apigateway-authorizer extensions. @postman@ will export the API
    -- with Postman extensions, allowing for import to the Postman tool
    GetExport -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The string identifier of the associated RestApi.
    GetExport -> Text
restApiId :: Prelude.Text,
    -- | The name of the Stage that will be exported.
    GetExport -> Text
stageName :: Prelude.Text,
    -- | The type of export. Acceptable values are \'oas30\' for OpenAPI 3.0.x
    -- and \'swagger\' for Swagger\/OpenAPI 2.0.
    GetExport -> Text
exportType :: Prelude.Text
  }
  deriving (GetExport -> GetExport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExport -> GetExport -> Bool
$c/= :: GetExport -> GetExport -> Bool
== :: GetExport -> GetExport -> Bool
$c== :: GetExport -> GetExport -> Bool
Prelude.Eq, ReadPrec [GetExport]
ReadPrec GetExport
Int -> ReadS GetExport
ReadS [GetExport]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetExport]
$creadListPrec :: ReadPrec [GetExport]
readPrec :: ReadPrec GetExport
$creadPrec :: ReadPrec GetExport
readList :: ReadS [GetExport]
$creadList :: ReadS [GetExport]
readsPrec :: Int -> ReadS GetExport
$creadsPrec :: Int -> ReadS GetExport
Prelude.Read, Int -> GetExport -> ShowS
[GetExport] -> ShowS
GetExport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExport] -> ShowS
$cshowList :: [GetExport] -> ShowS
show :: GetExport -> String
$cshow :: GetExport -> String
showsPrec :: Int -> GetExport -> ShowS
$cshowsPrec :: Int -> GetExport -> ShowS
Prelude.Show, forall x. Rep GetExport x -> GetExport
forall x. GetExport -> Rep GetExport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetExport x -> GetExport
$cfrom :: forall x. GetExport -> Rep GetExport x
Prelude.Generic)

-- |
-- Create a value of 'GetExport' 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:
--
-- 'accepts', 'getExport_accepts' - The content-type of the export, for example @application\/json@.
-- Currently @application\/json@ and @application\/yaml@ are supported for
-- @exportType@ of@oas30@ and @swagger@. This should be specified in the
-- @Accept@ header for direct API requests.
--
-- 'parameters', 'getExport_parameters' - A key-value map of query string parameters that specify properties of
-- the export, depending on the requested @exportType@. For @exportType@
-- @oas30@ and @swagger@, any combination of the following parameters are
-- supported: @extensions=\'integrations\'@ or @extensions=\'apigateway\'@
-- will export the API with x-amazon-apigateway-integration extensions.
-- @extensions=\'authorizers\'@ will export the API with
-- x-amazon-apigateway-authorizer extensions. @postman@ will export the API
-- with Postman extensions, allowing for import to the Postman tool
--
-- 'restApiId', 'getExport_restApiId' - The string identifier of the associated RestApi.
--
-- 'stageName', 'getExport_stageName' - The name of the Stage that will be exported.
--
-- 'exportType', 'getExport_exportType' - The type of export. Acceptable values are \'oas30\' for OpenAPI 3.0.x
-- and \'swagger\' for Swagger\/OpenAPI 2.0.
newGetExport ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'stageName'
  Prelude.Text ->
  -- | 'exportType'
  Prelude.Text ->
  GetExport
newGetExport :: Text -> Text -> Text -> GetExport
newGetExport Text
pRestApiId_ Text
pStageName_ Text
pExportType_ =
  GetExport'
    { $sel:accepts:GetExport' :: Maybe Text
accepts = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:GetExport' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:GetExport' :: Text
restApiId = Text
pRestApiId_,
      $sel:stageName:GetExport' :: Text
stageName = Text
pStageName_,
      $sel:exportType:GetExport' :: Text
exportType = Text
pExportType_
    }

-- | The content-type of the export, for example @application\/json@.
-- Currently @application\/json@ and @application\/yaml@ are supported for
-- @exportType@ of@oas30@ and @swagger@. This should be specified in the
-- @Accept@ header for direct API requests.
getExport_accepts :: Lens.Lens' GetExport (Prelude.Maybe Prelude.Text)
getExport_accepts :: Lens' GetExport (Maybe Text)
getExport_accepts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExport' {Maybe Text
accepts :: Maybe Text
$sel:accepts:GetExport' :: GetExport -> Maybe Text
accepts} -> Maybe Text
accepts) (\s :: GetExport
s@GetExport' {} Maybe Text
a -> GetExport
s {$sel:accepts:GetExport' :: Maybe Text
accepts = Maybe Text
a} :: GetExport)

-- | A key-value map of query string parameters that specify properties of
-- the export, depending on the requested @exportType@. For @exportType@
-- @oas30@ and @swagger@, any combination of the following parameters are
-- supported: @extensions=\'integrations\'@ or @extensions=\'apigateway\'@
-- will export the API with x-amazon-apigateway-integration extensions.
-- @extensions=\'authorizers\'@ will export the API with
-- x-amazon-apigateway-authorizer extensions. @postman@ will export the API
-- with Postman extensions, allowing for import to the Postman tool
getExport_parameters :: Lens.Lens' GetExport (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getExport_parameters :: Lens' GetExport (Maybe (HashMap Text Text))
getExport_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExport' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:GetExport' :: GetExport -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: GetExport
s@GetExport' {} Maybe (HashMap Text Text)
a -> GetExport
s {$sel:parameters:GetExport' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: GetExport) 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 string identifier of the associated RestApi.
getExport_restApiId :: Lens.Lens' GetExport Prelude.Text
getExport_restApiId :: Lens' GetExport Text
getExport_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExport' {Text
restApiId :: Text
$sel:restApiId:GetExport' :: GetExport -> Text
restApiId} -> Text
restApiId) (\s :: GetExport
s@GetExport' {} Text
a -> GetExport
s {$sel:restApiId:GetExport' :: Text
restApiId = Text
a} :: GetExport)

-- | The name of the Stage that will be exported.
getExport_stageName :: Lens.Lens' GetExport Prelude.Text
getExport_stageName :: Lens' GetExport Text
getExport_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExport' {Text
stageName :: Text
$sel:stageName:GetExport' :: GetExport -> Text
stageName} -> Text
stageName) (\s :: GetExport
s@GetExport' {} Text
a -> GetExport
s {$sel:stageName:GetExport' :: Text
stageName = Text
a} :: GetExport)

-- | The type of export. Acceptable values are \'oas30\' for OpenAPI 3.0.x
-- and \'swagger\' for Swagger\/OpenAPI 2.0.
getExport_exportType :: Lens.Lens' GetExport Prelude.Text
getExport_exportType :: Lens' GetExport Text
getExport_exportType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExport' {Text
exportType :: Text
$sel:exportType:GetExport' :: GetExport -> Text
exportType} -> Text
exportType) (\s :: GetExport
s@GetExport' {} Text
a -> GetExport
s {$sel:exportType:GetExport' :: Text
exportType = Text
a} :: GetExport)

instance Core.AWSRequest GetExport where
  type AWSResponse GetExport = GetExportResponse
  request :: (Service -> Service) -> GetExport -> Request GetExport
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 GetExport
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetExport)))
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
-> Maybe Text -> Maybe Text -> Int -> GetExportResponse
GetExportResponse'
            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.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Disposition")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            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 GetExport where
  hashWithSalt :: Int -> GetExport -> Int
hashWithSalt Int
_salt GetExport' {Maybe Text
Maybe (HashMap Text Text)
Text
exportType :: Text
stageName :: Text
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
accepts :: Maybe Text
$sel:exportType:GetExport' :: GetExport -> Text
$sel:stageName:GetExport' :: GetExport -> Text
$sel:restApiId:GetExport' :: GetExport -> Text
$sel:parameters:GetExport' :: GetExport -> Maybe (HashMap Text Text)
$sel:accepts:GetExport' :: GetExport -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accepts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
exportType

instance Prelude.NFData GetExport where
  rnf :: GetExport -> ()
rnf GetExport' {Maybe Text
Maybe (HashMap Text Text)
Text
exportType :: Text
stageName :: Text
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
accepts :: Maybe Text
$sel:exportType:GetExport' :: GetExport -> Text
$sel:stageName:GetExport' :: GetExport -> Text
$sel:restApiId:GetExport' :: GetExport -> Text
$sel:parameters:GetExport' :: GetExport -> Maybe (HashMap Text Text)
$sel:accepts:GetExport' :: GetExport -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accepts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
exportType

instance Data.ToHeaders GetExport where
  toHeaders :: GetExport -> ResponseHeaders
toHeaders GetExport' {Maybe Text
Maybe (HashMap Text Text)
Text
exportType :: Text
stageName :: Text
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
accepts :: Maybe Text
$sel:exportType:GetExport' :: GetExport -> Text
$sel:stageName:GetExport' :: GetExport -> Text
$sel:restApiId:GetExport' :: GetExport -> Text
$sel:parameters:GetExport' :: GetExport -> Maybe (HashMap Text Text)
$sel:accepts:GetExport' :: GetExport -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Accept" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
accepts,
        HeaderName
"Accept"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
      ]

instance Data.ToPath GetExport where
  toPath :: GetExport -> ByteString
toPath GetExport' {Maybe Text
Maybe (HashMap Text Text)
Text
exportType :: Text
stageName :: Text
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
accepts :: Maybe Text
$sel:exportType:GetExport' :: GetExport -> Text
$sel:stageName:GetExport' :: GetExport -> Text
$sel:restApiId:GetExport' :: GetExport -> Text
$sel:parameters:GetExport' :: GetExport -> Maybe (HashMap Text Text)
$sel:accepts:GetExport' :: GetExport -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/stages/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
stageName,
        ByteString
"/exports/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
exportType
      ]

instance Data.ToQuery GetExport where
  toQuery :: GetExport -> QueryString
toQuery GetExport' {Maybe Text
Maybe (HashMap Text Text)
Text
exportType :: Text
stageName :: Text
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
accepts :: Maybe Text
$sel:exportType:GetExport' :: GetExport -> Text
$sel:stageName:GetExport' :: GetExport -> Text
$sel:restApiId:GetExport' :: GetExport -> Text
$sel:parameters:GetExport' :: GetExport -> Maybe (HashMap Text Text)
$sel:accepts:GetExport' :: GetExport -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"parameters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall k v.
(ToQuery k, ToQuery v) =>
ByteString
-> ByteString -> ByteString -> HashMap k v -> QueryString
Data.toQueryMap ByteString
"entry" ByteString
"key" ByteString
"value"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
parameters
            )
      ]

-- | The binary blob response to GetExport, which contains the generated SDK.
--
-- /See:/ 'newGetExportResponse' smart constructor.
data GetExportResponse = GetExportResponse'
  { -- | The binary blob response to GetExport, which contains the export.
    GetExportResponse -> Maybe ByteString
body :: Prelude.Maybe Prelude.ByteString,
    -- | The content-disposition header value in the HTTP response.
    GetExportResponse -> Maybe Text
contentDisposition :: Prelude.Maybe Prelude.Text,
    -- | The content-type header value in the HTTP response. This will correspond
    -- to a valid \'accept\' type in the request.
    GetExportResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetExportResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetExportResponse -> GetExportResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExportResponse -> GetExportResponse -> Bool
$c/= :: GetExportResponse -> GetExportResponse -> Bool
== :: GetExportResponse -> GetExportResponse -> Bool
$c== :: GetExportResponse -> GetExportResponse -> Bool
Prelude.Eq, Int -> GetExportResponse -> ShowS
[GetExportResponse] -> ShowS
GetExportResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExportResponse] -> ShowS
$cshowList :: [GetExportResponse] -> ShowS
show :: GetExportResponse -> String
$cshow :: GetExportResponse -> String
showsPrec :: Int -> GetExportResponse -> ShowS
$cshowsPrec :: Int -> GetExportResponse -> ShowS
Prelude.Show, forall x. Rep GetExportResponse x -> GetExportResponse
forall x. GetExportResponse -> Rep GetExportResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetExportResponse x -> GetExportResponse
$cfrom :: forall x. GetExportResponse -> Rep GetExportResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetExportResponse' 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', 'getExportResponse_body' - The binary blob response to GetExport, which contains the export.
--
-- 'contentDisposition', 'getExportResponse_contentDisposition' - The content-disposition header value in the HTTP response.
--
-- 'contentType', 'getExportResponse_contentType' - The content-type header value in the HTTP response. This will correspond
-- to a valid \'accept\' type in the request.
--
-- 'httpStatus', 'getExportResponse_httpStatus' - The response's http status code.
newGetExportResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetExportResponse
newGetExportResponse :: Int -> GetExportResponse
newGetExportResponse Int
pHttpStatus_ =
  GetExportResponse'
    { $sel:body:GetExportResponse' :: Maybe ByteString
body = forall a. Maybe a
Prelude.Nothing,
      $sel:contentDisposition:GetExportResponse' :: Maybe Text
contentDisposition = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:GetExportResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetExportResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The binary blob response to GetExport, which contains the export.
getExportResponse_body :: Lens.Lens' GetExportResponse (Prelude.Maybe Prelude.ByteString)
getExportResponse_body :: Lens' GetExportResponse (Maybe ByteString)
getExportResponse_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExportResponse' {Maybe ByteString
body :: Maybe ByteString
$sel:body:GetExportResponse' :: GetExportResponse -> Maybe ByteString
body} -> Maybe ByteString
body) (\s :: GetExportResponse
s@GetExportResponse' {} Maybe ByteString
a -> GetExportResponse
s {$sel:body:GetExportResponse' :: Maybe ByteString
body = Maybe ByteString
a} :: GetExportResponse)

-- | The content-disposition header value in the HTTP response.
getExportResponse_contentDisposition :: Lens.Lens' GetExportResponse (Prelude.Maybe Prelude.Text)
getExportResponse_contentDisposition :: Lens' GetExportResponse (Maybe Text)
getExportResponse_contentDisposition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExportResponse' {Maybe Text
contentDisposition :: Maybe Text
$sel:contentDisposition:GetExportResponse' :: GetExportResponse -> Maybe Text
contentDisposition} -> Maybe Text
contentDisposition) (\s :: GetExportResponse
s@GetExportResponse' {} Maybe Text
a -> GetExportResponse
s {$sel:contentDisposition:GetExportResponse' :: Maybe Text
contentDisposition = Maybe Text
a} :: GetExportResponse)

-- | The content-type header value in the HTTP response. This will correspond
-- to a valid \'accept\' type in the request.
getExportResponse_contentType :: Lens.Lens' GetExportResponse (Prelude.Maybe Prelude.Text)
getExportResponse_contentType :: Lens' GetExportResponse (Maybe Text)
getExportResponse_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExportResponse' {Maybe Text
contentType :: Maybe Text
$sel:contentType:GetExportResponse' :: GetExportResponse -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: GetExportResponse
s@GetExportResponse' {} Maybe Text
a -> GetExportResponse
s {$sel:contentType:GetExportResponse' :: Maybe Text
contentType = Maybe Text
a} :: GetExportResponse)

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

instance Prelude.NFData GetExportResponse where
  rnf :: GetExportResponse -> ()
rnf GetExportResponse' {Int
Maybe ByteString
Maybe Text
httpStatus :: Int
contentType :: Maybe Text
contentDisposition :: Maybe Text
body :: Maybe ByteString
$sel:httpStatus:GetExportResponse' :: GetExportResponse -> Int
$sel:contentType:GetExportResponse' :: GetExportResponse -> Maybe Text
$sel:contentDisposition:GetExportResponse' :: GetExportResponse -> Maybe Text
$sel:body:GetExportResponse' :: GetExportResponse -> 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 Maybe Text
contentDisposition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus