{-# LANGUAGE CPP #-}
module AWS.Lambda.Events.ApiGateway.ProxyResponse
( ProxyResponse(..)
, response
, addHeader
, setHeader
, ProxyBody(..)
, textPlain
, applicationJson
, genericBinary
, module Network.HTTP.Types.Status
) where
import Data.Aeson (FromJSON(..), ToJSON, encode,
object, toJSON, withObject, (.:),
(.:?), (.=))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64 as B64
import Data.CaseInsensitive (CI, FoldCase, mk, original)
import qualified Data.CaseInsensitive as CI
import Data.Foldable (fold)
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Network.HTTP.Types.Header (hContentType)
import Network.HTTP.Types.Status (Status (..), accepted202,
badGateway502, badRequest400,
conflict409, continue100,
created201, expectationFailed417,
forbidden403, found302,
gatewayTimeout504, gone410,
httpVersionNotSupported505,
imATeapot418,
internalServerError500,
lengthRequired411,
methodNotAllowed405,
movedPermanently301,
multipleChoices300,
networkAuthenticationRequired511,
noContent204, nonAuthoritative203,
notAcceptable406, notFound404,
notImplemented501, notModified304,
ok200, partialContent206,
paymentRequired402,
permanentRedirect308,
preconditionFailed412,
preconditionRequired428,
proxyAuthenticationRequired407,
requestEntityTooLarge413,
requestHeaderFieldsTooLarge431,
requestTimeout408,
requestURITooLong414,
requestedRangeNotSatisfiable416,
resetContent205, seeOther303,
serviceUnavailable503, status100,
status101, status200, status201,
status202, status203, status204,
status205, status206, status300,
status301, status302, status303,
status304, status305, status307,
status308, status400, status401,
status402, status403, status404,
status405, status406, status407,
status408, status409, status410,
status411, status412, status413,
status414, status415, status416,
status417, status418, status422,
status426, status428, status429,
status431, status500, status501,
status502, status503, status504,
status505, status511,
switchingProtocols101,
temporaryRedirect307,
tooManyRequests429, unauthorized401,
unprocessableEntity422,
unsupportedMediaType415,
upgradeRequired426, useProxy305)
import GHC.Generics (Generic (..))
(<&>) :: Functor f => f a -> (a -> b) -> f b
<&> :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
(<&>) f a
x a -> b
f = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
infixl 1 <&>
data ProxyBody = ProxyBody
{ ProxyBody -> Text
contentType :: T.Text
, ProxyBody -> Text
serialized :: T.Text
, ProxyBody -> Bool
isBase64Encoded :: Bool
} deriving (ProxyBody -> ProxyBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyBody -> ProxyBody -> Bool
$c/= :: ProxyBody -> ProxyBody -> Bool
== :: ProxyBody -> ProxyBody -> Bool
$c== :: ProxyBody -> ProxyBody -> Bool
Eq, forall x. Rep ProxyBody x -> ProxyBody
forall x. ProxyBody -> Rep ProxyBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProxyBody x -> ProxyBody
$cfrom :: forall x. ProxyBody -> Rep ProxyBody x
Generic, Int -> ProxyBody -> ShowS
[ProxyBody] -> ShowS
ProxyBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyBody] -> ShowS
$cshowList :: [ProxyBody] -> ShowS
show :: ProxyBody -> String
$cshow :: ProxyBody -> String
showsPrec :: Int -> ProxyBody -> ShowS
$cshowsPrec :: Int -> ProxyBody -> ShowS
Show)
data ProxyResponse = ProxyResponse
{ ProxyResponse -> Status
status :: Status
, :: HashMap (CI T.Text) [T.Text]
, ProxyResponse -> ProxyBody
body :: ProxyBody
} deriving (ProxyResponse -> ProxyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyResponse -> ProxyResponse -> Bool
$c/= :: ProxyResponse -> ProxyResponse -> Bool
== :: ProxyResponse -> ProxyResponse -> Bool
$c== :: ProxyResponse -> ProxyResponse -> Bool
Eq, forall x. Rep ProxyResponse x -> ProxyResponse
forall x. ProxyResponse -> Rep ProxyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProxyResponse x -> ProxyResponse
$cfrom :: forall x. ProxyResponse -> Rep ProxyResponse x
Generic, Int -> ProxyResponse -> ShowS
[ProxyResponse] -> ShowS
ProxyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyResponse] -> ShowS
$cshowList :: [ProxyResponse] -> ShowS
show :: ProxyResponse -> String
$cshow :: ProxyResponse -> String
showsPrec :: Int -> ProxyResponse -> ShowS
$cshowsPrec :: Int -> ProxyResponse -> ShowS
Show)
toCIHashMap :: (Eq k, FoldCase k, Hashable k) => HashMap k a -> HashMap (CI k) a
toCIHashMap :: forall k a.
(Eq k, FoldCase k, Hashable k) =>
HashMap k a -> HashMap (CI k) a
toCIHashMap = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FoldCase s => s -> CI s
mk) forall a. Monoid a => a
mempty
response :: Status -> ProxyBody -> ProxyResponse
response :: Status -> ProxyBody -> ProxyResponse
response =
forall a b c. (a -> b -> c) -> b -> a -> c
flip Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse forall a. Monoid a => a
mempty
addHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse
Text
header Text
value (ProxyResponse Status
s HashMap (CI Text) [Text]
mvh ProxyBody
b) =
Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
s (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
H.insertWith forall a. Semigroup a => a -> a -> a
(<>) (forall s. FoldCase s => s -> CI s
mk Text
header) [Text
value] HashMap (CI Text) [Text]
mvh) ProxyBody
b
setHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse
Text
header Text
value (ProxyResponse Status
s HashMap (CI Text) [Text]
mvh ProxyBody
b) =
Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
s (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (forall s. FoldCase s => s -> CI s
mk Text
header) [Text
value] HashMap (CI Text) [Text]
mvh) ProxyBody
b
genericBinary :: T.Text -> ByteString -> ProxyBody
genericBinary :: Text -> ByteString -> ProxyBody
genericBinary Text
contentType ByteString
x =
Text -> Text -> Bool -> ProxyBody
ProxyBody Text
contentType (ByteString -> Text
TE.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
x) Bool
True
textPlain :: T.Text -> ProxyBody
textPlain :: Text -> ProxyBody
textPlain Text
x = Text -> Text -> Bool -> ProxyBody
ProxyBody Text
"text/plain; charset=utf-8" Text
x Bool
False
applicationJson :: ToJSON a => a -> ProxyBody
applicationJson :: forall a. ToJSON a => a -> ProxyBody
applicationJson a
x =
Text -> Text -> Bool -> ProxyBody
ProxyBody
Text
"application/json; charset=utf-8"
(Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TLE.decodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode a
x)
Bool
False
instance ToJSON ProxyResponse where
toJSON :: ProxyResponse -> Value
toJSON (ProxyResponse Status
status HashMap (CI Text) [Text]
mvh (ProxyBody Text
contentType Text
body Bool
isBase64Encoded)) =
let unCI :: HashMap (CI Text) v -> HashMap Text v
unCI = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
original) forall a. Monoid a => a
mempty
in [Pair] -> Value
object
[ Key
"statusCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status -> Int
statusCode Status
status
, Key
"multiValueHeaders" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
H.insertWith
(\[Text]
_ [Text]
old -> [Text]
old)
(Text
"Content-Type" :: T.Text)
[Text
contentType]
(forall {v}. HashMap (CI Text) v -> HashMap Text v
unCI HashMap (CI Text) [Text]
mvh)
, Key
"body" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
body
, Key
"isBase64Encoded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
isBase64Encoded
]
instance FromJSON ProxyResponse where
parseJSON :: Value -> Parser ProxyResponse
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProxyResponse" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
HashMap (CI Text) [Text]
headers <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"multiValueHeaders" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall k a.
(Eq k, FoldCase k, Hashable k) =>
HashMap k a -> HashMap (CI k) a
toCIHashMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
let contentTypeHeader :: CI Text
contentTypeHeader = forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map ByteString -> Text
TE.decodeUtf8 HeaderName
hContentType
contentType :: Text
contentType = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup CI Text
contentTypeHeader HashMap (CI Text) [Text]
headers of
Just (Text
h:[Text]
_) -> Text
h
Maybe [Text]
_ -> Text
"application/octet-stream"
headers' :: HashMap (CI Text) [Text]
headers' = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete CI Text
contentTypeHeader HashMap (CI Text) [Text]
headers
Status
status <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statusCode" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Enum a => Int -> a
toEnum
ProxyBody
proxyBody <- Text -> Text -> Bool -> ProxyBody
ProxyBody Text
contentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isBase64Encoded"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
status HashMap (CI Text) [Text]
headers' ProxyBody
proxyBody