diff --git a/postgrest.cabal b/postgrest.cabal index 20fb5f932..97bd66fec 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -36,7 +36,7 @@ executable postgrest , regex-base, regex-tdfa , regex-tdfa-text , Ranged-sets - , transformers + , transformers, MissingH , bcrypt, base64-string , network-uri >= 2.6 , resource-pool @@ -80,10 +80,8 @@ Test-Suite spec , http-media, regex-tdfa , regex-tdfa-text , Ranged-sets - , transformers - , bcrypt - , base64-string - , split + , transformers, MissingH, split + , bcrypt, base64-string , network-uri >= 2.6 , resource-pool , blaze-builder diff --git a/src/Error.hs b/src/Error.hs new file mode 100644 index 000000000..f837b27c5 --- /dev/null +++ b/src/Error.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +module Error (PgError, errResponse) where + +import qualified Hasql as H +import qualified Hasql.Postgres as H +import qualified Network.HTTP.Types.Status as HT +import qualified Data.Aeson as JSON +import qualified Data.Text as T +import Data.Aeson ((.=)) +import Data.String.Conversions (cs) +import Data.String.Utils(replace) +import Network.Wai(Response, responseLBS) + +type PgError = H.SessionError H.Postgres + +errResponse :: PgError -> Response +errResponse e = responseLBS (httpStatus e) [] (JSON.encode e) + +instance JSON.ToJSON PgError where + toJSON (H.TxError (H.ErroneousResult 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 (H.NoResult d)) = JSON.object [ + "message" .= ("No response from server"::T.Text), + "details" .= (fmap cs d::Maybe T.Text)] + toJSON (H.TxError (H.UnexpectedResult m)) = JSON.object ["message" .= m] + toJSON (H.TxError H.NotInTransaction) = JSON.object [ + "message" .= ("Not in transaction"::T.Text)] + toJSON (H.CxError (H.CantConnect d)) = JSON.object [ + "message" .= ("Can't connect to the database"::T.Text), + "details" .= (fmap cs d::Maybe T.Text)] + toJSON (H.CxError (H.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 (H.ErroneousResult codeBS _ _ _)) = + let code = cs codeBS in + case code of + '0':'8':_ -> HT.status503 -- pg connection err + '0':'9':_ -> HT.status500 -- triggered action exception + '0':'L':_ -> HT.status403 -- invalid grantor + '0':'P':_ -> HT.status403 -- invalid role specification + '2':'5':_ -> HT.status500 -- invalid tx state + '2':'8':_ -> HT.status403 -- invalid auth specification + '2':'D':_ -> HT.status500 -- invalid tx termination + '3':'8':_ -> HT.status500 -- external routine exception + '3':'9':_ -> HT.status500 -- external routine invocation + '3':'B':_ -> HT.status500 -- savepoint exception + '4':'0':_ -> HT.status500 -- tx rollback + '5':'3':_ -> HT.status503 -- insufficient resources + '5':'4':_ -> HT.status413 -- too complex + '5':'5':_ -> HT.status500 -- obj not on prereq state + '5':'7':_ -> HT.status500 -- operator intervention + '5':'8':_ -> HT.status500 -- system error + 'F':'0':_ -> HT.status500 -- conf file error + 'H':'V':_ -> HT.status500 -- foreign data wrapper error + 'P':'0':_ -> HT.status500 -- PL/pgSQL Error + 'X':'X':_ -> HT.status500 -- internal Error + "42P01" -> HT.status404 -- undefined table + "42501" -> HT.status404 -- insufficient privilege + _ -> HT.status400 +httpStatus (H.TxError (H.NoResult _)) = HT.status503 +httpStatus _ = HT.status500 diff --git a/src/Main.hs b/src/Main.hs index 79c1ea3a0..7dc81bc62 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -54,10 +54,9 @@ main = do runSettings appSettings $ middle $ \req respond -> do body <- strictRequestBody req - thing <- liftIO $ H.session pool $ H.tx Nothing $ authenticated currRole anonRole (app body) req - case thing of - Right r -> respond r - Left _ -> undefined + resOrError <- liftIO $ H.session pool $ H.tx Nothing $ + authenticated currRole anonRole (app body) req + either (undefined) respond resOrError where describe = progDesc "create a REST API to an existing Postgres database" diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 5ab2b3a21..e29baa44e 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -31,6 +31,7 @@ import System.Process (readProcess) import App (app, sqlError, isSqlError) import Config (AppConfig(..), corsPolicy) import Middleware +import Error(errResponse) -- import Auth (addUser) isLeft :: Either a b -> Bool @@ -54,13 +55,9 @@ withApp perform = do perform $ middle $ \req resp -> do body <- strictRequestBody req - result <- liftIO - $ H.session pool - $ H.tx Nothing + result <- liftIO $ H.session pool $ H.tx Nothing $ authenticated currRole anonRole (app body) req - resp $ case result of - Right r -> r - Left _ -> error "hahahaha" + either (resp . errResponse) resp result where middle = cors corsPolicy