Make nodeMiddleware optional

This commit is contained in:
sigma-andex 2022-08-23 20:38:38 +01:00
parent 7fb9ed53b9
commit f08f606149
2 changed files with 19 additions and 12 deletions

View File

@ -7,8 +7,7 @@ module HTTPurple.Request
, fromHTTPRequestExt , fromHTTPRequestExt
, fromHTTPRequestUnit , fromHTTPRequestUnit
, fullPath , fullPath
) ) where
where
import Prelude import Prelude
@ -61,6 +60,7 @@ type RequestR route r =
type Request route = { | RequestR route () } type Request route = { | RequestR route () }
type ExtRequest route ext = { | RequestR route ext } type ExtRequest route ext = { | RequestR route ext }
newtype ExtRequestNT :: Type -> Row Type -> Type newtype ExtRequestNT :: Type -> Row Type -> Type
newtype ExtRequestNT route ext = ExtRequestNT { | RequestR route ext } newtype ExtRequestNT route ext = ExtRequestNT { | RequestR route ext }

View File

@ -82,7 +82,7 @@ type ExtRoutingSettingsR route output r =
type MiddlewareSettingsR :: Row Type -> Row Type -> Row Type type MiddlewareSettingsR :: Row Type -> Row Type -> Row Type
type MiddlewareSettingsR input output = type MiddlewareSettingsR input output =
( nodeMiddleware :: NodeMiddlewareStack input output ( nodeMiddleware :: Maybe (NodeMiddlewareStack input output)
) )
type ExtRoutingSettings :: Type -> Row Type -> Row Type -> Type type ExtRoutingSettings :: Type -> Row Type -> Row Type -> Type
@ -129,7 +129,7 @@ handleRequestUnit router request httpresponse =
>>= (onError500 router) >>= (onError500 router)
>>= send httpresponse >>= send httpresponse
handleExtRequestNT :: handleExtRequest ::
forall ctx ctxRL thru route. forall ctx ctxRL thru route.
Union ctx thru ctx => Union ctx thru ctx =>
RowToList ctx ctxRL => RowToList ctx ctxRL =>
@ -142,26 +142,33 @@ handleExtRequestNT ::
HTTP.Request -> HTTP.Request ->
HTTP.Response -> HTTP.Response ->
Aff Unit Aff Unit
handleExtRequestNT { route, router, notFoundHandler } req resp = do handleExtRequest { route, router, notFoundHandler } req resp = do
httpurpleReq <- fromHTTPRequestExt route (Proxy :: Proxy ctx) req httpurpleReq <- fromHTTPRequestExt route (Proxy :: Proxy ctx) req
httpurpleResp <- (notFoundHandler ||| onError500 router) httpurpleReq httpurpleResp <- (notFoundHandler ||| onError500 router) httpurpleReq
send resp httpurpleResp send resp httpurpleResp
handleExtRequestNTWithMiddleware :: -- handleRequest { route, router, notFoundHandler } request httpresponse =
-- void $ runAff (\_ -> pure unit) $ fromHTTPRequest route request
-- >>= (notFoundHandler ||| onError500 router)
-- >>= send httpresponse
handleExtRequestWithMiddleware ::
forall input output outputRL thru route. forall input output outputRL thru route.
Union output thru output => Union output thru output =>
RowToList output outputRL => RowToList output outputRL =>
Extra.Keys outputRL => Extra.Keys outputRL =>
Nub (RequestR route output) (RequestR route output) => Nub (RequestR route output) (RequestR route output) =>
{ route :: RD.RouteDuplex' route { route :: RD.RouteDuplex' route
, nodeMiddleware :: NodeMiddlewareStack input output , nodeMiddleware :: Maybe (NodeMiddlewareStack input output)
, router :: ExtRequestNT route output -> ResponseM , router :: ExtRequestNT route output -> ResponseM
, notFoundHandler :: Request Unit -> ResponseM , notFoundHandler :: Request Unit -> ResponseM
} -> } ->
HTTP.Request -> HTTP.Request ->
HTTP.Response -> HTTP.Response ->
Effect Unit Effect Unit
handleExtRequestNTWithMiddleware { route, nodeMiddleware: NodeMiddlewareStack middleware, router, notFoundHandler } req resp = void $ runAff (\_ -> pure unit) $ do
handleExtRequestWithMiddleware { route, nodeMiddleware: Nothing, router, notFoundHandler } req resp = void $ runAff (\_ -> pure unit) $
handleExtRequest { route, router, notFoundHandler } req resp
handleExtRequestWithMiddleware { route, nodeMiddleware:Just (NodeMiddlewareStack middleware), router, notFoundHandler } req resp = void $ runAff (\_ -> pure unit) $ do
eff <- liftEffect $ flip runContT (coerce >>> pure) $ middleware (MiddlewareResult { request: req, response: resp, middlewareResult: NotCalled }) eff <- liftEffect $ flip runContT (coerce >>> pure) $ middleware (MiddlewareResult { request: req, response: resp, middlewareResult: NotCalled })
executeHandler eff executeHandler eff
where where
@ -170,7 +177,7 @@ handleExtRequestNTWithMiddleware { route, nodeMiddleware: NodeMiddlewareStack mi
executeHandler (MiddlewareResult { request, response, middlewareResult: ProcessingFailed error }) = executeHandler (MiddlewareResult { request, response, middlewareResult: ProcessingFailed error }) =
liftEffect $ handleRequestUnit (defaultMiddlewareErrorHandler error) request response liftEffect $ handleRequestUnit (defaultMiddlewareErrorHandler error) request response
executeHandler (MiddlewareResult { request, response, middlewareResult: ProcessingSucceeded }) = executeHandler (MiddlewareResult { request, response, middlewareResult: ProcessingSucceeded }) =
handleExtRequestNT { route, router, notFoundHandler } request response handleExtRequest { route, router, notFoundHandler } request response
executeHandler (MiddlewareResult { middlewareResult: NotCalled }) = executeHandler (MiddlewareResult { middlewareResult: NotCalled }) =
pure unit pure unit
@ -276,7 +283,7 @@ serveExtended inputOptions settings = do
routingSettings :: routingSettings ::
{ route :: RD.RouteDuplex' route { route :: RD.RouteDuplex' route
, nodeMiddleware :: NodeMiddlewareStack input output , nodeMiddleware :: Maybe (NodeMiddlewareStack input output)
, router :: ExtRequestNT route output -> ResponseM , router :: ExtRequestNT route output -> ResponseM
, notFoundHandler :: Request Unit -> ResponseM , notFoundHandler :: Request Unit -> ResponseM
} }
@ -289,8 +296,8 @@ serveExtended inputOptions settings = do
cert' <- readTextFile UTF8 certFile cert' <- readTextFile UTF8 certFile
key' <- readTextFile UTF8 keyFile key' <- readTextFile UTF8 keyFile
let sslOpts = key := keyString key' <> cert := certString cert' let sslOpts = key := keyString key' <> cert := certString cert'
HTTPS.createServer sslOpts (handleExtRequestNTWithMiddleware routingSettings) HTTPS.createServer sslOpts (handleExtRequestWithMiddleware routingSettings)
Nothing -> HTTP.createServer (handleExtRequestNTWithMiddleware routingSettings) Nothing -> HTTP.createServer (handleExtRequestWithMiddleware routingSettings)
listen server options onStarted listen server options onStarted
let closingHandler = close server let closingHandler = close server
registerClosingHandler filledOptions.closingHandler closingHandler registerClosingHandler filledOptions.closingHandler closingHandler