Make nodeMiddleware optional
This commit is contained in:
parent
7fb9ed53b9
commit
f08f606149
@ -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 }
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user