diff --git a/src/HTTPure/Server.purs b/src/HTTPure/Server.purs index 9593399..af54ae5 100644 --- a/src/HTTPure/Server.purs +++ b/src/HTTPure/Server.purs @@ -10,6 +10,7 @@ import Prelude import Effect as Effect import Effect.Aff as Aff +import Control.Alt ((<|>)) import Data.Maybe as Maybe import Data.Options ((:=), Options) import Node.Encoding as Encoding @@ -25,6 +26,14 @@ import HTTPure.Response as Response -- | methods. type ServerM = Effect.Effect (Effect.Effect Unit -> Effect.Effect Unit) +-- | Given a router, handle unhandled exceptions it raises by +-- | responding with 500 Internal Server Error. +onError500 :: (Request.Request -> Response.ResponseM) -> + Request.Request -> + Response.ResponseM +onError500 router request = + router request <|> Response.internalServerError "" + -- | This function takes a method which takes a `Request` and returns a -- | `ResponseM`, an HTTP `Request`, and an HTTP `Response`. It runs the -- | request, extracts the `Response` from the `ResponseM`, and sends the @@ -35,7 +44,9 @@ handleRequest :: (Request.Request -> Response.ResponseM) -> Effect.Effect Unit handleRequest router request httpresponse = void $ Aff.runAff (\_ -> pure unit) $ - Request.fromHTTPRequest request >>= router >>= Response.send httpresponse + Request.fromHTTPRequest request + >>= onError500 router + >>= Response.send httpresponse -- | Given a `ListenOptions` object, a function mapping `Request` to -- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and diff --git a/test/Test/HTTPure/ServerSpec.purs b/test/Test/HTTPure/ServerSpec.purs index 6429a63..7079398 100644 --- a/test/Test/HTTPure/ServerSpec.purs +++ b/test/Test/HTTPure/ServerSpec.purs @@ -3,6 +3,8 @@ module Test.HTTPure.ServerSpec where import Prelude import Effect.Class as EffectClass +import Effect.Exception as Exception +import Control.Monad.Except as Except import Data.Maybe as Maybe import Data.Options ((:=)) import Data.String as String @@ -23,6 +25,9 @@ import Test.HTTPure.TestHelpers ((?=)) mockRouter :: Request.Request -> Response.ResponseM mockRouter { path } = Response.ok $ "/" <> String.joinWith "/" path +errorRouter :: Request.Request -> Response.ResponseM +errorRouter _ = Except.throwError $ Exception.error "fail!" + serveSpec :: TestHelpers.Test serveSpec = Spec.describe "serve" do Spec.it "boots a server on the given port" do @@ -31,6 +36,12 @@ serveSpec = Spec.describe "serve" do EffectClass.liftEffect $ close $ pure unit out ?= "/test" + Spec.it "responds with a 500 upon unhandled exceptions" do + close <- EffectClass.liftEffect $ Server.serve 8080 errorRouter $ pure unit + status <- TestHelpers.getStatus 8080 Object.empty "/" + EffectClass.liftEffect $ close $ pure unit + status ?= 500 + serve'Spec :: TestHelpers.Test serve'Spec = Spec.describe "serve'" do Spec.it "boots a server with the given options" do diff --git a/test/Test/HTTPure/TestHelpers.purs b/test/Test/HTTPure/TestHelpers.purs index 74c7ad9..7d37453 100644 --- a/test/Test/HTTPure/TestHelpers.purs +++ b/test/Test/HTTPure/TestHelpers.purs @@ -125,6 +125,13 @@ getHeader :: Int -> getHeader port headers path header = extractHeader header <$> request false port "GET" headers path "" +getStatus :: Int -> + Object.Object String -> + String -> + Aff.Aff Int +getStatus port headers path = + HTTPClient.statusCode <$> request false port "GET" headers path "" + -- | Mock an HTTP Request object foreign import mockRequestImpl :: String ->