postgrest 0.2.5.1 → 0.2.5.2
raw patch · 3 files changed
+144/−4 lines, 3 files
Files
- postgrest.cabal +16/−4
- src/Error.hs +71/−0
- src/Types.hs +57/−0
postgrest.cabal view
@@ -2,7 +2,7 @@ description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security permits.-version: 0.2.5.1+version: 0.2.5.2 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE@@ -46,10 +46,12 @@ Other-Modules: App , Auth , Config- , PgStructure+ , Error+ , Middleware , PgQuery+ , PgStructure , RangeQuery- , Middleware+ , Types hs-source-dirs: src Test-Suite spec@@ -60,7 +62,17 @@ Hs-Source-Dirs: test, src ghc-options: -Wall -W -Werror Main-Is: Main.hs- Other-Modules: App, Auth, Config, Spec, SpecHelper+ Other-Modules: App+ , Auth+ , Config+ , Error+ , Middleware+ , PgQuery+ , PgStructure+ , RangeQuery+ , Types+ , Spec+ , SpecHelper Build-Depends: base, hspec >= 2.1.2, QuickCheck , hspec-wai >= 0.5.0, hspec-wai-json , hasql == 0.7.*, hasql-backend
+ src/Error.hs view
@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}++module Error (PgError, errResponse) where++import qualified Hasql as H+import qualified Hasql.Postgres as P+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)+import Network.HTTP.Types.Header++type PgError = H.SessionError P.Postgres++errResponse :: PgError -> Response+errResponse 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 [+ "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),+ "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+ '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 (P.NoResult _)) = HT.status503+httpStatus _ = HT.status500
+ src/Types.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Types where++import qualified Data.Aeson as JSON+import Data.Aeson.Types (Parser)++import Data.Scientific (floatingOrInteger)+import Data.HashMap.Strict (foldlWithKey')+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import Data.Time.Calendar (showGregorian)+import Control.Monad (mzero)++instance JSON.FromJSON SqlValue where+ parseJSON (JSON.Number n) = return $ either toSql iToSql (floatingOrInteger n :: Either Double Int)+ parseJSON (JSON.String s) = return $ toSql s+ parseJSON (JSON.Bool b) = return $ toSql b+ parseJSON JSON.Null = return SqlNull+ parseJSON (JSON.Object o) = return . toSql $ JSON.encode o+ parseJSON (JSON.Array a) = return . toSql $ JSON.encode a++instance JSON.ToJSON SqlValue where+ toJSON (SqlString s) = JSON.toJSON s+ toJSON (SqlByteString s) = JSON.toJSON $ decodeUtf8 s+ toJSON (SqlWord32 w) = JSON.toJSON w+ toJSON (SqlWord64 w) = JSON.toJSON w+ toJSON (SqlInt32 i) = JSON.toJSON i+ toJSON (SqlInt64 i) = JSON.toJSON i+ toJSON (SqlInteger i) = JSON.toJSON i+ toJSON (SqlChar c) = JSON.toJSON c+ toJSON (SqlBool b) = JSON.toJSON b+ toJSON (SqlDouble n) = JSON.toJSON n+ toJSON (SqlRational n) = JSON.toJSON n+ toJSON (SqlLocalDate d) = JSON.toJSON $ showGregorian d+ toJSON (SqlLocalTimeOfDay t) = JSON.toJSON $ show t+ toJSON (SqlLocalTime t) = JSON.toJSON $ show t+ toJSON SqlNull = JSON.Null+ toJSON x = JSON.toJSON $ show x+++newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] } deriving (Show)++sqlRowColumns :: SqlRow -> [Text]+sqlRowColumns = map fst . getRow++sqlRowValues :: SqlRow -> [SqlValue]+sqlRowValues = map snd . getRow++instance JSON.FromJSON SqlRow where+ parseJSON (JSON.Object m) = foldlWithKey' add (return $ SqlRow []) m+ where+ add :: Parser SqlRow -> Text -> JSON.Value -> Parser SqlRow+ add parser k v = do+ SqlRow l <- parser+ sqlV <- JSON.parseJSON v+ return . SqlRow $ (k, sqlV) : l+ parseJSON _ = mzero