Stop attempting

This package has no opinion about handling errors.

Author: oreshinya

src/Bucketchain/SimpleAPI/Class.purs

@@ -9,15 +9,15 @@ import Bucketchain.SimpleAPI.Body (Body(..), decodeBody)
 import Bucketchain.SimpleAPI.FreeT.Class (class Transformable, transform)
 import Bucketchain.SimpleAPI.Proc (Proc, context, runProc)
 import Bucketchain.SimpleAPI.RawData (RawData)
-import Bucketchain.SimpleAPI.Response (Response, fromResponses, invalidRequestResponse, unauthorizedResponse, errorResponse)
+import Bucketchain.SimpleAPI.Response (Response, fromResponses, invalidRequestResponse, unauthorizedResponse)
 import Bucketchain.SimpleAPI.Response.Class (class Respondable, toResponse)
 import Control.Monad.Free.Trans (FreeT, runFreeT)
 import Control.Parallel (parTraverse)
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.String (drop)
 import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
-import Effect.Aff (Aff, attempt)
+import Effect.Aff (Aff)
 import Foreign (MultipleErrors)
 import Prim.Row (class Cons)
 import Record.Unsafe (unsafeGet)
@@ -36,11 +36,8 @@ class ServableList ex (l :: RowList) (r :: # Type) | l -> r where
   serveList :: RLProxy l -> Record r -> ex -> RawData -> Aff (Maybe Response)
 
 instance servableProc :: (Respondable a) => Servable ex (Proc ex a) where
-  serve server extraData rawData = do
-    result <- attempt $ runProc server $ context extraData rawData
-    case result of
-      Left _ -> pure $ Just errorResponse
-      Right x -> pure $ Just $ toResponse x
+  serve server extraData rawData =
+    (runProc server $ context extraData rawData) <#> toResponse >>> Just
 
 instance servableFreeT :: (Transformable ex f, Respondable a) => Servable ex (FreeT f (Proc ex) a) where
   serve server extraData rawData = serve (runFreeT transform server) extraData rawData

src/Bucketchain/SimpleAPI/Response.purs

@@ -9,7 +9,6 @@ module Bucketchain.SimpleAPI.Response
   , fromResponses
   , invalidRequestResponse
   , unauthorizedResponse
-  , errorResponse
   ) where
 
 import Prelude
@@ -64,9 +63,5 @@ invalidRequestResponse = response defaultHeaders 400 $ write { message: "Request
 unauthorizedResponse :: Response
 unauthorizedResponse = response defaultHeaders 401 $ write { message: "Unauthorized" }
 
--- | This is for internal. Do not use it.
-errorResponse :: Response
-errorResponse = response defaultHeaders 500 $ write { message: "Internal server error" }
-
 defaultHeaders :: Headers
 defaultHeaders = singleton "Content-Type" "application/json; charset=utf-8"

test/Main.purs

@@ -34,6 +34,7 @@ main = do
     errorTest
     freeTTest
     batchTest
+    batchErrorTest
   where
     opts =
       { hostname: "localhost"
@@ -175,7 +176,7 @@ batchTest = do
   res <- requestWithBody opts batchBody
   body <- convertToString $ C.responseAsStream res
   liftEffect do
-    assert $ body == "[{\"status\":503,\"headers\":{\"X-Custom\":\"CustomValue2\",\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":{\"core\":[\"This is error test\"]}},{\"status\":201,\"headers\":{\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":{\"name\":\"Other Item 1\"}},{\"status\":200,\"headers\":{\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":{\"name\":\"authuser\"}},{\"status\":404,\"headers\":{\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":null},{\"status\":500,\"headers\":{\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":{\"message\":\"Internal server error\"}}]"
+    assert $ body == "[{\"status\":503,\"headers\":{\"X-Custom\":\"CustomValue2\",\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":{\"core\":[\"This is error test\"]}},{\"status\":201,\"headers\":{\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":{\"name\":\"Other Item 1\"}},{\"status\":200,\"headers\":{\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":{\"name\":\"authuser\"}},{\"status\":404,\"headers\":{\"Content-Type\":\"application/json; charset=utf-8\"},\"body\":null}]"
     assert $ C.statusCode res == 200
   where
     opts = C.port := 3000
@@ -188,5 +189,22 @@ batchTest = do
         , Tuple "X-Test-Auth" "authuser"
         ]
 
+batchErrorTest :: Aff Unit
+batchErrorTest = do
+  res <- requestWithBody opts batchErrorBody
+  liftEffect $ assert $ C.statusCode res == 500
+  where
+    opts = C.port := 3000
+        <> C.method := "POST"
+        <> C.path := "/batch"
+        <> C.headers := headers
+    headers =
+      C.RequestHeaders $ fromFoldable
+        [ Tuple "Content-Type" "application/json"
+        ]
+
 batchBody :: String
-batchBody = "[{\"path\":\"/failureTest\"},{\"path\":\"/bodyTest\",\"body\":{\"name\":\"Other Item 1\"}},{\"path\":\"/authTest\"},{\"path\":\"/notFound\"},{\"path\":\"/errorTest\"}]"
+batchBody = "[{\"path\":\"/failureTest\"},{\"path\":\"/bodyTest\",\"body\":{\"name\":\"Other Item 1\"}},{\"path\":\"/authTest\"},{\"path\":\"/notFound\"}]"
+
+batchErrorBody :: String
+batchErrorBody = "[{\"path\":\"/bodyTest\",\"body\":{\"name\":\"Other Item 1\"}},{\"path\":\"/errorTest\"}]"