{-# 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 #-}
module Amazonka.APIGateway.GetExport
(
GetExport (..),
newGetExport,
getExport_accepts,
getExport_parameters,
getExport_restApiId,
getExport_stageName,
getExport_exportType,
GetExportResponse (..),
newGetExportResponse,
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
data GetExport = GetExport'
{
GetExport -> Maybe Text
accepts :: Prelude.Maybe Prelude.Text,
GetExport -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
GetExport -> Text
restApiId :: Prelude.Text,
GetExport -> Text
stageName :: Prelude.Text,
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)
newGetExport ::
Prelude.Text ->
Prelude.Text ->
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_
}
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)
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
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)
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)
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
)
]
data GetExportResponse = GetExportResponse'
{
GetExportResponse -> Maybe ByteString
body :: Prelude.Maybe Prelude.ByteString,
GetExportResponse -> Maybe Text
contentDisposition :: Prelude.Maybe Prelude.Text,
GetExportResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
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)
newGetExportResponse ::
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_
}
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)
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)
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)
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