Provide proper JSON details for errors

Refines HTTP codes for server vs client problems

Fixes #92
Fixes #40

test/Feature/AuthSpec.hs

@@ -14,7 +14,7 @@ spec :: Spec
 spec = before resetDb $ around withApp $
   describe "authorization" $ do
     it "hides tables that anonymous does not own" $
-      get "/authors_only" `shouldRespondWith` 400 -- TODO: should be 404
+      get "/authors_only" `shouldRespondWith` 404
     it "indicates login failure" $ do
       let auth = authHeader "postgrest_test_author" "fakefake"
       request methodGet "/authors_only" [auth] ""

test/Feature/InsertSpec.hs

@@ -73,7 +73,7 @@ spec = before resetDb $ around withApp $ do
       it "fails with 400 and error" $
         post "/simple_pk" "}{ x = 2"
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just [json| {"error":"Failed to parse JSON payload. Failed reading: satisfy"} |]
+            matchBody    = Just [json| {"message":"Failed to parse JSON payload. Failed reading: satisfy"} |]
           , matchStatus  = 400
           , matchHeaders = []
           }

test/SpecHelper.hs

@@ -24,7 +24,7 @@ import qualified Data.ByteString.Char8 as BS
 import Network.Wai.Middleware.Cors (cors)
 import System.Process (readProcess)
 
-import App (app, sqlErrHandler, isSqlError)
+import App (app, sqlError, isSqlError)
 import Config (AppConfig(..), corsPolicy)
 import Middleware
 -- import Auth (addUser)
@@ -52,7 +52,7 @@ withApp perform =
         resp =<< catchJust isSqlError
           (unlift $ H.tx Nothing
                   $ authenticated anonRole (app body) req)
-          sqlErrHandler
+          (return . sqlError)
 
   where middle = cors corsPolicy
 

test/Unit/ErrorsSpec.hs

@@ -0,0 +1,41 @@
+module Unit.ErrorsSpec where
+
+import Test.Hspec
+
+import Text.Parsec
+import PgError
+import Data.Either (rights)
+
+spec :: Spec
+spec =
+  describe "Parsing Hasql errors" $ do
+    it "can handle status and code" $
+      let p = parse message "" "Status: \"foo\"; Code: \"abc\"." in
+      rights [p] `shouldBe` [
+          Message (Just "foo") "abc" Nothing Nothing
+        ]
+    it "can handle weird redundant quotes in status" $
+      let p = parse message "" "Status: \"\"foo\"\"; Code: \"abc\"." in
+      rights [p] `shouldBe` [
+          Message (Just "foo") "abc" Nothing Nothing
+        ]
+    it "can handle text and code" $
+      let p = parse message "" "Message: \"foo\"; Code: \"abc\"." in
+      rights [p] `shouldBe` [
+          Message Nothing "abc" (Just "foo") Nothing
+        ]
+    it "can handle status, text and code" $
+      let p = parse message "" "Status: \"hi\"; Message: \"foo\"; Code: \"abc\"." in
+      rights [p] `shouldBe` [
+          Message (Just "hi") "abc" (Just "foo") Nothing
+        ]
+    it "can handle unescaped quotes in message" $
+      let p = parse message "" "Status: \"hi\"; Message: \"unknown \"foo\"!\"; Code: \"abc\"." in
+      rights [p] `shouldBe` [
+          Message (Just "hi") "abc" (Just "unknown \"foo\"!") Nothing
+        ]
+    it "can handle periods in message" $
+      let p = parse message "" "Message: \"unknown \"foo\".bar\"; Code: \"42P01\"." in
+      rights [p] `shouldBe` [
+          Message Nothing "42P01" (Just "unknown \"foo\".bar") Nothing
+        ]

test/Unit/ErrorsSpec.hx

@@ -1,34 +0,0 @@
-module Unit.ErrorsSpec where
-
-import Test.Hspec
-
-import Database.HDBC (runRaw, quickQuery, fromSql, SqlError)
-import SpecHelper (dbWithSchema)
-import Middleware (withSavepoint, Environment(..))
-import PgQuery (insert)
-import Types(SqlRow(..))
-import Control.Exception(catch)
-import Control.Monad(void)
-import Network.Wai (defaultRequest, responseLBS)
-import Network.HTTP.Types.Status (ok200)
-
-spec :: Spec
-spec = let
-  dbErrApp conn _ res = do
-    _ <- insert "1" "items" (SqlRow []) conn
-    runRaw conn "select 1/0"
-    _ <- insert "1" "items" (SqlRow []) conn
-    res $ responseLBS ok200 [("Content-Type", "application/json")] "{}"
-  in around dbWithSchema $
-
-    describe "withSavepoint" $
-      it "allows partial rollback of request" $ \c -> do
-        let app = withSavepoint Test dbErrApp c
-        [[beforeCount]] <- quickQuery c "select count(*) from \"1\".items" []
-        runRaw c "set role postgrest_anonymous"
-        _ <- insert "1" "items" (SqlRow []) c
-        catch (void $ app defaultRequest (const undefined) ) $
-          \e -> let _ = (e::SqlError) in do
-          _ <- insert "1" "items" (SqlRow []) c
-          [[afterCount]] <- quickQuery c "select count(*) from \"1\".items" []
-          fromSql afterCount `shouldBe` (fromSql beforeCount::Int) + 2