Use a mime type to request singular JSON responses (#763)

src/PostgREST/Error.hs

@@ -2,16 +2,18 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError) where
+module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError, singularityError, formatGeneralError, formatParserError) where
 
 import           Protolude
 import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
+import           Data.Text                 (replace, strip, unwords)
 import qualified Hasql.Pool                as P
 import qualified Hasql.Session             as H
 import qualified Network.HTTP.Types.Status as HT
 import           Network.Wai               (Response, responseLBS)
-import           PostgREST.ApiRequest      (toHeader, ContentType(..), ApiRequestError(..))
+import           PostgREST.ApiRequest      (toHeader, toMime, ContentType(..), ApiRequestError(..))
+import           Text.Parsec.Error
 
 apiRequestErrResponse :: ApiRequestError -> Response
 apiRequestErrResponse err =
@@ -41,6 +43,28 @@ prettyUsageError (P.ConnectionError e) =
   "Database connection error:\n" <> toS (fromMaybe "" e)
 prettyUsageError e = show $ JSON.encode e
 
+singularityError :: Integer -> Response
+singularityError numRows =
+  responseLBS HT.status406
+    [toHeader CTSingularJSON]
+    $ toS . formatGeneralError
+      "JSON object requested, multiple (or no) rows returned"
+      $ unwords
+        [ "Results contain", show numRows, "rows,"
+        , toS (toMime CTSingularJSON), "requires 1 row"
+        ]
+
+formatParserError :: ParseError -> Text
+formatParserError e = formatGeneralError message details
+  where
+     message = show $ errorPos e
+     details = strip $ replace "\n" " " $ toS
+       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+formatGeneralError :: Text -> Text -> Text
+formatGeneralError message details = toS . JSON.encode $
+  JSON.object ["message" .= message, "details" .= details]
+
 instance JSON.ToJSON P.UsageError where
   toJSON (P.ConnectionError e) = JSON.object [
     "code" .= ("" :: Text),
@@ -103,6 +127,7 @@ httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
     "P0001"   -> HT.status400 -- default code for "raise"
     'P':'0':_ -> HT.status500 -- PL/pgSQL Error
     'X':'X':_ -> HT.status500 -- internal Error
+    "42883"   -> HT.status404 -- undefined function
     "42P01"   -> HT.status404 -- undefined table
     "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
     _         -> HT.status400