wai-lambda 0.1.0.0 → 0.1.1.0
raw patch · 3 files changed
+147/−107 lines, 3 filesdep +deepseq
Dependencies added: deepseq
Files
- README.md +1/−1
- src/Network/Wai/Handler/Lambda.hs +141/−101
- wai-lambda.cabal +5/−5
README.md view
@@ -31,7 +31,7 @@ This doesn't require any particular Lambda environment. By following the instructions in the [build](#build) section the resulting `zip` file uploaded-to AWS Lambda is typically be smaller than 1MB. For basic webapps the request+to AWS Lambda is typically smaller than 1MB. For basic webapps the request handling duration (as reported by AWS) is between 1 and 5 milliseconds. * [**Install**](#install) with either Cabal, stack or Nix.
src/Network/Wai/Handler/Lambda.hs view
@@ -1,15 +1,24 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-} module Network.Wai.Handler.Lambda where import Control.Concurrent (forkIO)+import Control.DeepSeq (NFData) import Control.Monad-import Data.Aeson ((.:), (.:?), (.!=))+import Data.Aeson ((.:)) import Data.Bifunctor import Data.Function (fix)+import Data.List (partition)+import Data.Maybe (fromMaybe)+import GHC.Generics (Generic) import Network.Wai (Application) import System.Directory (renameFile) import System.IO.Unsafe@@ -36,12 +45,26 @@ import qualified Network.Wai.Internal as Wai import qualified System.IO.Temp as Temp +-- | The representation of the response sent back to API Gateway. type RawResponse = (H.Status, H.ResponseHeaders, BS.ByteString) +-- | The settings for running an 'Application'.+--+-- See also:+-- * 'runSettings'+--+-- For simplicity use the following setters with 'defaultSettings':+-- * 'setTimeoutSeconds'+-- * 'setHandleTimeout'+-- * 'setHandleException'+-- data Settings = Settings { timeoutValue :: Int+ -- ^ How many microseconds before we declare a timeout , handleTimeout :: BS.ByteString -> IO RawResponse+ -- ^ How to handle a timeout , handleException :: BS.ByteString -> SomeException -> IO RawResponse+ -- ^ How to handle an exception thrown by the 'Application' } -- | Run an 'Application'.@@ -184,115 +207,126 @@ obj .: "responseFile" <*> (obj .: "request" >>= parseRequest) +data ApiGatewayRequestV2 = ApiGatewayRequestV2+ { body :: !(Maybe T.Text)+ , headers :: !(HMap.HashMap T.Text T.Text)+ , rawQueryString :: !(Maybe T.Text)+ , requestContext :: !RequestContext+ , cookies :: !(Maybe [T.Text])+ , isBase64Encoded :: !Bool+ }+ deriving (Show, Generic, Aeson.ToJSON, Aeson.FromJSON, NFData)++data RequestContext = RequestContext+ { accountId :: !T.Text+ , apiId :: !T.Text+ , domainName :: !T.Text+ , http :: Http+ , requestId :: !T.Text+ }+ deriving (Show, Generic, Aeson.ToJSON, Aeson.FromJSON, NFData)++data Http = Http+ { method :: !T.Text+ , path :: !T.Text+ , protocol :: !T.Text+ , sourceIp :: !T.Text+ }+ deriving (Show, Generic, Aeson.ToJSON, Aeson.FromJSON, NFData)+ -- | Parser for a 'Wai.Request'. -- -- The input is an AWS API Gateway request event: -- https://docs.aws.amazon.com/lambda/latest/dg/eventsources.html#eventsources-api-gateway-request-parseRequest :: Aeson.Value -> Aeson.Parser (IO Wai.Request)-parseRequest = Aeson.withObject "request" $ \obj -> do-- -- "httpMethod": "GET"- requestMethod <- obj .: "httpMethod" >>=- Aeson.withText "requestMethod" (pure . T.encodeUtf8)-- -- We don't get data about the version, just assume- httpVersion <- pure H.http11-- -- "queryStringParameters": {- -- "name": "me"- -- },- -- XXX: default to empty object for the query params as Lambda doesn't set- -- 'queryStringParameters' if there are no query parameters- queryParams <- obj .:? "queryStringParameters" .!= Aeson.Object HMap.empty >>=- Aeson.withObject "queryParams" (- fmap- (fmap (first T.encodeUtf8) . HMap.toList ) .- traverse (Aeson.withText "queryParam" (pure . T.encodeUtf8))- )-- rawQueryString <- pure $ H.renderSimpleQuery True queryParams-- -- "path": "/test/hello",- path <- obj .: "path" >>=- Aeson.withText "path" (pure . T.encodeUtf8)+parseRequest :: Aeson.Object -> Aeson.Parser (IO Wai.Request)+parseRequest obj = do+ ApiGatewayRequestV2+ { body+ , headers+ , rawQueryString+ , cookies+ , requestContext = RequestContext+ { http = Http+ { method+ , protocol+ , path+ , sourceIp+ }+ }+ } <- Aeson.parseJSON (Aeson.Object obj) - rawPathInfo <- pure $ path <> rawQueryString+ -- We don't get data about the version, just assume+ httpVersion <- case CI.mk protocol of+ "http/0.9" -> pure H.http09+ "http/1.0" -> pure H.http10+ "http/1.1" -> pure H.http11+ "http/2.0" -> pure H.http20+ _ -> fail $ "Unknown http protocol " <> T.unpack protocol - -- "headers": {- -- "Accept": "text/html,application/xhtml+xml,...",- -- ...- -- "X-Forwarded-Proto": "https"- -- },- requestHeaders <- obj .: "headers" >>=- Aeson.withObject "headers" (- fmap- (fmap (first (CI.mk . T.encodeUtf8)) . HMap.toList) .- traverse (Aeson.withText "header" (pure . T.encodeUtf8))- )+ -- "headers": {+ -- "Accept": "text/html,application/xhtml+xml,...",+ -- ...+ -- "X-Forwarded-Proto": "https"+ -- },+ let+ cookieHeaders = (\c -> (H.hCookie, T.encodeUtf8 c)) <$> fromMaybe [] cookies+ otherHeaders = (\(k,v) -> (CI.mk (T.encodeUtf8 k),T.encodeUtf8 v)) <$> HMap.toList headers+ requestHeaders = otherHeaders <> cookieHeaders - isSecure <- pure $ case lookup "X-Forwarded-Proto" requestHeaders of- Just "https" -> True- _ -> False+ isSecure <- pure $ case lookup "X-Forwarded-Proto" requestHeaders of+ Just "https" -> True+ _ -> False + let rawPathInfo = T.encodeUtf8 path+ pathInfo <- pure $ H.decodePathSegments rawPathInfo - -- "requestContext": {- -- ...- -- "identity": {- -- ...- -- "sourceIp": "192.168.100.1",- -- },- -- ...- -- },- remoteHost <- obj .: "requestContext" >>=- Aeson.withObject "requestContext" (\obj' ->- obj' .: "identity" >>=- Aeson.withObject "identity" (\idt -> do- sourceIp <- case HMap.lookup "sourceIp" idt of- Nothing -> fail "no sourceIp"- Just (Aeson.String x) -> pure $ T.unpack x- Just _ -> fail "bad type for sourceIp"- ip <- case readMaybe sourceIp of- Just ip -> pure ip- Nothing -> fail "cannot parse sourceIp"+ remoteHost <- case readMaybe @IP.IP (T.unpack sourceIp) of+ Just (IP.IPv4 ip) -> pure $ Socket.SockAddrInet 0 (IP.toHostAddress ip)+ Just (IP.IPv6 ip) -> pure $ Socket.SockAddrInet6 0 0 (IP.toHostAddress6 ip) 0+ _ -> fail $ "Could not parse ip address: " <> T.unpack sourceIp - pure $ case ip of- IP.IPv4 ip4 ->- Socket.SockAddrInet- 0 -- default port- (IP.toHostAddress ip4)- IP.IPv6 ip6 ->- Socket.SockAddrInet6- 0 -- default port- 0 -- flow info- (IP.toHostAddress6 ip6)- 0 -- scope id- )- )+ let+ rawQueryStringBytes = maybe "" T.encodeUtf8 rawQueryString+ queryString = H.parseQuery (rawQueryStringBytes) - pathInfo <- pure $ H.decodePathSegments path- queryString <- pure $ H.parseQuery rawQueryString+ -- XXX: default to empty body as Lambda doesn't always set one (e.g. GET+ -- requests)+ let requestBodyRaw = maybe "" T.encodeUtf8 body+ requestBodyLength <- pure $+ Wai.KnownLength $ fromIntegral $ BS.length requestBodyRaw - -- XXX: default to empty body as Lambda doesn't always set one (e.g. GET- -- requests)- requestBodyRaw <- obj .:? "body" .!= Aeson.String "" >>=- Aeson.withText "body" (pure . T.encodeUtf8)- requestBodyLength <- pure $- Wai.KnownLength $ fromIntegral $ BS.length requestBodyRaw+ vault <- pure $ Vault.insert originalRequestKey obj Vault.empty - vault <- pure $ Vault.insert originalRequestKey obj Vault.empty+ requestHeaderHost <- pure $ lookup "host" requestHeaders+ requestHeaderRange <- pure $ lookup "range" requestHeaders+ requestHeaderReferer <- pure $ lookup "referer" requestHeaders+ requestHeaderUserAgent <- pure $ lookup "User-Agent" requestHeaders - requestHeaderHost <- pure $ lookup "host" requestHeaders- requestHeaderRange <- pure $ lookup "range" requestHeaders- requestHeaderReferer <- pure $ lookup "referer" requestHeaders- requestHeaderUserAgent <- pure $ lookup "User-Agent" requestHeaders+ pure $ do+ requestBodyMVar <- newMVar requestBodyRaw+ let requestBody = do+ tryTakeMVar requestBodyMVar >>= \case+ Just bs -> pure bs+ Nothing -> pure BS.empty - pure $ do- requestBodyMVar <- newMVar requestBodyRaw- let requestBody = do- tryTakeMVar requestBodyMVar >>= \case- Just bs -> pure bs- Nothing -> pure BS.empty- pure $ Wai.Request {..}+ pure $ Wai.Request+ { requestMethod = T.encodeUtf8 method+ , httpVersion+ , rawPathInfo+ , rawQueryString = rawQueryStringBytes+ , queryString+ , requestBodyLength+ , requestHeaderHost+ , requestHeaderUserAgent+ , requestHeaderRange+ , requestHeaderReferer+ , requestHeaders+ , isSecure+ , remoteHost+ , pathInfo+ , requestBody+ , vault+ } originalRequestKey :: Vault.Key Aeson.Object originalRequestKey = unsafePerformIO Vault.newKey@@ -315,12 +349,18 @@ -- | Make an API Gateway response from status, headers and body. -- https://docs.aws.amazon.com/lambda/latest/dg/eventsources.html#eventsources-api-gateway-response toJSONResponse :: H.Status -> H.ResponseHeaders -> BS.ByteString -> Aeson.Object-toJSONResponse st hdrs body = HMap.fromList- [ ("statusCode", Aeson.Number (fromIntegral (H.statusCode st)))- , ("headers", Aeson.toJSON $ HMap.fromList $- (bimap T.decodeUtf8 T.decodeUtf8 . first CI.original) <$> hdrs)- , ("body", Aeson.String (T.decodeUtf8 body))- ]+toJSONResponse st hdrs body =+ let+ (setCookieHeaders, otherHeaders) = partition (\(k,_) -> k == "set-cookie") hdrs+ Aeson.Object obj =+ Aeson.object+ [ ("statusCode", Aeson.Number (fromIntegral (H.statusCode st)))+ , ("headers", Aeson.toJSON $ HMap.fromList $+ (bimap T.decodeUtf8 T.decodeUtf8 . first CI.original) <$> otherHeaders)+ , ("cookies", Aeson.toJSON (T.decodeUtf8 . snd <$> setCookieHeaders))+ , ("body", Aeson.String (T.decodeUtf8 body))+ ]+ in obj ------------------------------------------------------------------------------- -- Auxiliary
wai-lambda.cabal view
@@ -1,13 +1,11 @@-cabal-version: >= 1.10+cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.29.7.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack------ hash: bdba09ec63c6108d8b0ae25f59ab61765a732917d3c89f71307185aad1462185 name: wai-lambda-version: 0.1.0.0+version: 0.1.1.0 synopsis: Haskell Webapps on AWS Lambda description: . @@ -46,6 +44,7 @@ , binary , bytestring , case-insensitive+ , deepseq , directory , http-types , iproute@@ -69,6 +68,7 @@ , binary , bytestring , case-insensitive+ , deepseq , directory , http-types , iproute