Provide proper JSON details for errors

Refines HTTP codes for server vs client problems

Fixes #92
Fixes #40

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