@@ -14,11 +14,14 @@ module Aws.Lambda.Wai
14
14
ALBWaiHandler ,
15
15
ignoreALBPathPart ,
16
16
ignoreNothing ,
17
+ waiHandler ,
18
+ runMultipleWaiApplications ,
17
19
)
18
20
where
19
21
20
22
import Aws.Lambda
21
23
import Control.Concurrent.MVar
24
+ import Control.Monad (forM , forM_ )
22
25
import Data.Aeson
23
26
import Data.Aeson.Types
24
27
import Data.Bifunctor (Bifunctor (bimap ))
@@ -27,6 +30,7 @@ import Data.ByteString (ByteString)
27
30
import qualified Data.ByteString as BS
28
31
import qualified Data.ByteString.Lazy as BL
29
32
import qualified Data.CaseInsensitive as CI
33
+ import Data.HashMap.Strict (HashMap )
30
34
import qualified Data.HashMap.Strict as HMap
31
35
import Data.IORef
32
36
import qualified Data.IP as IP
@@ -48,6 +52,8 @@ type ApiGatewayWaiHandler = ApiGatewayRequest Text -> Context Application -> IO
48
52
49
53
type ALBWaiHandler = ALBRequest Text -> Context Application -> IO (Either (ALBResponse Text ) (ALBResponse Text ))
50
54
55
+ type GenericWaiHandler = Value -> Context Application -> IO (Either Value Value )
56
+
51
57
newtype ALBIgnoredPathPortion = ALBIgnoredPathPortion { unALBIgnoredPathPortion :: Text }
52
58
53
59
data WaiLambdaProxyType
@@ -62,21 +68,57 @@ runWaiAsProxiedHttpLambda ::
62
68
IO ()
63
69
runWaiAsProxiedHttpLambda options ignoredAlbPath handlerName mkApp =
64
70
runLambdaHaskellRuntime options mkApp id $
65
- addStandaloneLambdaHandler handlerName $ \ (request :: Value ) context ->
66
- case parse parseIsAlb request of
67
- Success isAlb -> do
68
- if isAlb
69
- then case fromJSON @ (ALBRequest Text ) request of
70
- Success albRequest ->
71
- bimap toJSON toJSON <$> albWaiHandler ignoredAlbPath albRequest context
72
- Error err -> error $ " Could not parse the request as a valid ALB request: " <> err
73
- else case fromJSON @ (ApiGatewayRequest Text ) request of
74
- Success apiGwRequest ->
75
- bimap toJSON toJSON <$> apiGatewayWaiHandler apiGwRequest context
76
- Error err -> error $ " Could not parse the request as a valid API Gateway request: " <> err
77
- Error err ->
78
- error $
79
- " Could not parse the request as a valid API Gateway or ALB proxy request: " <> err
71
+ addStandaloneLambdaHandler handlerName (waiHandler ignoredAlbPath)
72
+
73
+ runMultipleWaiApplications ::
74
+ DispatcherOptions ->
75
+ HashMap HandlerName (Maybe ALBIgnoredPathPortion , IO Application ) ->
76
+ IO ()
77
+ runMultipleWaiApplications options handlersAndApps = do
78
+ runLambdaHaskellRuntime options initializeApplications id $
79
+ forM_ (HMap. keys handlersAndApps) $ \ handler ->
80
+ addStandaloneLambdaHandler handler $ \ request context ->
81
+ multiApplicationWaiHandler handler request context
82
+ where
83
+ initializeApplications :: IO (HashMap HandlerName (Maybe ALBIgnoredPathPortion , Application ))
84
+ initializeApplications = do
85
+ HMap. fromList
86
+ <$> forM
87
+ (HMap. toList handlersAndApps)
88
+ (\ (handler, (alb, mkApp)) -> mkApp >>= \ app -> return (handler, (alb, app)))
89
+
90
+ multiApplicationWaiHandler ::
91
+ HandlerName ->
92
+ Value ->
93
+ Context (HashMap HandlerName (Maybe ALBIgnoredPathPortion , Application )) ->
94
+ IO (Either Value Value )
95
+ multiApplicationWaiHandler handlerName request context = do
96
+ appMay <- HMap. lookup handlerName <$> readIORef (customContext context)
97
+ case appMay of
98
+ Just (ignoredAlbPart, app) -> do
99
+ applicationRef <- newIORef app
100
+ waiHandler ignoredAlbPart request (context {customContext = applicationRef})
101
+ Nothing ->
102
+ fail $ " No application was registered for handler '" <> T. unpack (unHandlerName handlerName) <> " '."
103
+
104
+ waiHandler ::
105
+ Maybe ALBIgnoredPathPortion ->
106
+ GenericWaiHandler
107
+ waiHandler ignoredAlbPath request context =
108
+ case parse parseIsAlb request of
109
+ Success isAlb -> do
110
+ if isAlb
111
+ then case fromJSON @ (ALBRequest Text ) request of
112
+ Success albRequest ->
113
+ bimap toJSON toJSON <$> albWaiHandler ignoredAlbPath albRequest context
114
+ Error err -> error $ " Could not parse the request as a valid ALB request: " <> err
115
+ else case fromJSON @ (ApiGatewayRequest Text ) request of
116
+ Success apiGwRequest ->
117
+ bimap toJSON toJSON <$> apiGatewayWaiHandler apiGwRequest context
118
+ Error err -> error $ " Could not parse the request as a valid API Gateway request: " <> err
119
+ Error err ->
120
+ error $
121
+ " Could not parse the request as a valid API Gateway or ALB proxy request: " <> err
80
122
where
81
123
parseIsAlb :: Value -> Parser Bool
82
124
parseIsAlb = withObject " Request" $ \ obj -> do
0 commit comments