jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use the correct Error types for hasql 0.19

Browse Source
This commit is contained in:
Joe Nelson
2016-01-24 18:09:18 -08:00
parent 5faa80b172
commit d6102cc908
2 changed files with 29 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
+1 -7
View File
@@ -37,9 +37,7 @@ executable postgrest
, cassava
, containers
, errors
, hasql >= 0.7.3 && < 0.8
, hasql-backend >= 0.4.1 && < 0.5
, hasql-postgres >= 0.10.4 && < 0.11
, hasql >= 0.15.1 && < 0.16
, jwt
, optparse-applicative >= 0.11 && < 0.13
, parsec
@@ -94,8 +92,6 @@ library
, containers
, errors
, hasql
, hasql-backend
, hasql-postgres
, http-types
, jwt
, optparse-applicative
@@ -170,8 +166,6 @@ Test-Suite spec
, containers
, errors
, hasql
, hasql-backend
, hasql-postgres
, heredoc
, hlint
, hspec == 2.2.*
src/PostgREST/Error.hs
+28 -22
View File
@@ -7,17 +7,16 @@ module PostgREST.Error (PgError, pgErrResponse, errResponse) where
import Data.Aeson ((.=))
import qualified Data.Aeson as JSON
import Data.Monoid ((<>))
import Data.String.Conversions (cs)
import Data.String.Utils (replace)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Hasql as H
import qualified Hasql.Postgres as P
import qualified Hasql.Session as H
import Network.HTTP.Types.Header
import qualified Network.HTTP.Types.Status as HT
import Network.Wai (Response, responseLBS)
type PgError = H.SessionError P.Postgres
type PgError = H.Error
errResponse :: HT.Status -> Text -> Response
errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
@@ -27,29 +26,36 @@ pgErrResponse e = responseLBS (httpStatus e)
[(hContentType, "application/json")] (JSON.encode e)
instance JSON.ToJSON PgError where
toJSON (H.TxError (P.ErroneousResult c m d h)) = JSON.object [
toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
"code" .= (cs c::T.Text),
"message" .= (cs m::T.Text),
"details" .= (fmap cs d::Maybe T.Text),
"hint" .= (fmap cs h::Maybe T.Text)]
toJSON (H.TxError (P.NoResult d)) = JSON.object [
"message" .= ("No response from server"::T.Text),
toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
"message" .= (cs m::T.Text)]
toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
"message" .= ("Row error: end of input"::String),
"details" .=
("Attempt to parse more columns than there are in the result"::String),
"details" .= ("Row number " <> show i)]
toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
"message" .= ("Row error: unexpected null"::String),
"details" .= ("Attempt to parse a NULL as some value."::String),
"details" .= ("Row number " <> show i)]
toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
"message" .= ("Row error: Wrong value parser used"::String),
"details" .= d,
"details" .= ("Row number " <> show i)]
toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
"message" .= ("Unexpected amount of rows"::String),
"details" .= i]
toJSON (H.ClientError d) = JSON.object [
"message" .= ("Database client error"::String),
"details" .= (fmap cs d::Maybe T.Text)]
toJSON (H.TxError (P.UnexpectedResult m)) = JSON.object ["message" .= m]
toJSON (H.TxError P.NotInTransaction) = JSON.object [
"message" .= ("Not in transaction"::T.Text)]
toJSON (H.CxError (P.CantConnect d)) = JSON.object [
"message" .= ("Can't connect to the database"::T.Text),
"details" .= (fmap cs d::Maybe T.Text)]
toJSON (H.CxError (P.UnsupportedVersion v)) = JSON.object [
"message" .= ("Postgres version "++version++" is not supported") ]
where version = replace "0" "." (show v)
toJSON (H.ResultError m) = JSON.object ["message" .= m]
httpStatus :: PgError -> HT.Status
httpStatus (H.TxError (P.ErroneousResult codeBS _ _ _)) =
let code = cs codeBS in
case code of
httpStatus (H.ResultError (H.ServerError c _ _ _)) =
case cs c of
'0':'8':_ -> HT.status503 -- pg connection err
'0':'9':_ -> HT.status500 -- triggered action exception
'0':'L':_ -> HT.status403 -- invalid grantor
@@ -75,5 +81,5 @@ httpStatus (H.TxError (P.ErroneousResult codeBS _ _ _)) =
"42P01" -> HT.status404 -- undefined table
"42501" -> HT.status404 -- insufficient privilege
_ -> HT.status400
httpStatus (H.TxError (P.NoResult _)) = HT.status503
httpStatus _ = HT.status500
httpStatus (H.ResultError _) = HT.status500
httpStatus (H.ClientError _) = HT.status503