Respond with 500 Internal Server Error upon unhandled exceptions

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

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

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 ->