{-# 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
<&> :: f a -> (a -> b) -> f b
(<&>) f a
x a -> b
f = a -> b
f (a -> b) -> f a -> f b
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
(ProxyBody -> ProxyBody -> Bool)
-> (ProxyBody -> ProxyBody -> Bool) -> Eq ProxyBody
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. ProxyBody -> Rep ProxyBody x)
-> (forall x. Rep ProxyBody x -> ProxyBody) -> Generic ProxyBody
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
(Int -> ProxyBody -> ShowS)
-> (ProxyBody -> String)
-> ([ProxyBody] -> ShowS)
-> Show ProxyBody
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
(ProxyResponse -> ProxyResponse -> Bool)
-> (ProxyResponse -> ProxyResponse -> Bool) -> Eq ProxyResponse
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. ProxyResponse -> Rep ProxyResponse x)
-> (forall x. Rep ProxyResponse x -> ProxyResponse)
-> Generic ProxyResponse
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
(Int -> ProxyResponse -> ShowS)
-> (ProxyResponse -> String)
-> ([ProxyResponse] -> ShowS)
-> Show ProxyResponse
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 :: HashMap k a -> HashMap (CI k) a
toCIHashMap = (k -> a -> HashMap (CI k) a -> HashMap (CI k) a)
-> HashMap (CI k) a -> HashMap k a -> HashMap (CI k) a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (CI k -> a -> HashMap (CI k) a -> HashMap (CI k) a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (CI k -> a -> HashMap (CI k) a -> HashMap (CI k) a)
-> (k -> CI k) -> k -> a -> HashMap (CI k) a -> HashMap (CI k) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> CI k
forall s. FoldCase s => s -> CI s
mk) HashMap (CI k) a
forall a. Monoid a => a
mempty
response :: Status -> ProxyBody -> ProxyResponse
response :: Status -> ProxyBody -> ProxyResponse
response =
(Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse)
-> HashMap (CI Text) [Text] -> Status -> ProxyBody -> ProxyResponse
forall a b c. (a -> b -> c) -> b -> a -> c
flip Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse HashMap (CI Text) [Text]
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 (([Text] -> [Text] -> [Text])
-> CI Text
-> [Text]
-> HashMap (CI Text) [Text]
-> HashMap (CI Text) [Text]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
H.insertWith [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>) (Text -> CI Text
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 (CI Text
-> [Text] -> HashMap (CI Text) [Text] -> HashMap (CI Text) [Text]
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (Text -> CI Text
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 (ByteString -> Text) -> ByteString -> Text
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 :: a -> ProxyBody
applicationJson a
x =
Text -> Text -> Bool -> ProxyBody
ProxyBody
Text
"application/json; charset=utf-8"
(Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ a -> ByteString
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 = (CI Text -> v -> HashMap Text v -> HashMap Text v)
-> HashMap Text v -> HashMap (CI Text) v -> HashMap Text v
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey (Text -> v -> HashMap Text v -> HashMap Text v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (Text -> v -> HashMap Text v -> HashMap Text v)
-> (CI Text -> Text)
-> CI Text
-> v
-> HashMap Text v
-> HashMap Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
original) HashMap Text v
forall a. Monoid a => a
mempty
in [Pair] -> Value
object
[ Key
"statusCode" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status -> Int
statusCode Status
status
, Key
"multiValueHeaders" Key -> HashMap Text [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
([Text] -> [Text] -> [Text])
-> Text -> [Text] -> HashMap Text [Text] -> HashMap Text [Text]
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]
(HashMap (CI Text) [Text] -> HashMap Text [Text]
forall v. HashMap (CI Text) v -> HashMap Text v
unCI HashMap (CI Text) [Text]
mvh)
, Key
"body" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
body
, Key
"isBase64Encoded" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
isBase64Encoded
]
instance FromJSON ProxyResponse where
parseJSON :: Value -> Parser ProxyResponse
parseJSON = String
-> (Object -> Parser ProxyResponse)
-> Value
-> Parser ProxyResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProxyResponse" ((Object -> Parser ProxyResponse) -> Value -> Parser ProxyResponse)
-> (Object -> Parser ProxyResponse)
-> Value
-> Parser ProxyResponse
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
HashMap (CI Text) [Text]
headers <- Object
v Object -> Key -> Parser (Maybe (HashMap Text [Text]))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"multiValueHeaders" Parser (Maybe (HashMap Text [Text]))
-> (Maybe (HashMap Text [Text]) -> HashMap (CI Text) [Text])
-> Parser (HashMap (CI Text) [Text])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HashMap Text [Text] -> HashMap (CI Text) [Text]
forall k a.
(Eq k, FoldCase k, Hashable k) =>
HashMap k a -> HashMap (CI k) a
toCIHashMap (HashMap Text [Text] -> HashMap (CI Text) [Text])
-> (Maybe (HashMap Text [Text]) -> HashMap Text [Text])
-> Maybe (HashMap Text [Text])
-> HashMap (CI Text) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (HashMap Text [Text]) -> HashMap Text [Text]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
let contentTypeHeader :: CI Text
contentTypeHeader = (ByteString -> Text) -> CI ByteString -> CI Text
forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map ByteString -> Text
TE.decodeUtf8 CI ByteString
hContentType
contentType :: Text
contentType = case CI Text -> HashMap (CI Text) [Text] -> Maybe [Text]
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 (h:_) -> Text
h
Maybe [Text]
_ -> Text
"application/octet-stream"
headers' :: HashMap (CI Text) [Text]
headers' = CI Text -> HashMap (CI Text) [Text] -> HashMap (CI Text) [Text]
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 Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statusCode" Parser Int -> (Int -> Status) -> Parser Status
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> Status
forall a. Enum a => Int -> a
toEnum
ProxyBody
proxyBody <- Text -> Text -> Bool -> ProxyBody
ProxyBody Text
contentType
(Text -> Bool -> ProxyBody)
-> Parser Text -> Parser (Bool -> ProxyBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
Parser (Bool -> ProxyBody) -> Parser Bool -> Parser ProxyBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isBase64Encoded"
ProxyResponse -> Parser ProxyResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProxyResponse -> Parser ProxyResponse)
-> ProxyResponse -> Parser ProxyResponse
forall a b. (a -> b) -> a -> b
$ Status -> HashMap (CI Text) [Text] -> ProxyBody -> ProxyResponse
ProxyResponse Status
status HashMap (CI Text) [Text]
headers' ProxyBody
proxyBody