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

version changed to 3, circle ci to use ghc 7.10.1, stricter import/export in PgQuery and remove of dead code

Browse Source
This commit is contained in:
Ruslan Talpa
2015-10-23 12:23:46 +03:00
parent c606149c43
commit f5fb78ec99
8 changed files with 184 additions and 217 deletions
Download Patch File Download Diff File Expand all files Collapse all files
circle.yml
+1 -1
View File
@@ -3,7 +3,7 @@ machine:
- createuser --superuser --no-password postgrest_test
- createdb -O postgrest_test -U ubuntu postgrest_test
ghc:
version: 7.8.3
version: 7.10.1
dependencies:
override:
- cabal update
postgrest.cabal
+6 -1
View File
@@ -2,7 +2,7 @@ name: postgrest
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.11.1
version: 0.3.0.0
synopsis: REST API for any Postgres database
license: MIT
license-file: LICENSE
@@ -22,6 +22,11 @@ Flag CI
Default: False
executable postgrest
if flag(ci)
ghc-options: -Wall -W -Werror
else
ghc-options: -Wall -W -O2
main-is: PostgREST/Main.hs
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
default-language: Haskell2010
src/PostgREST/Auth.hs
+2 -2
View File
@@ -19,8 +19,8 @@ module PostgREST.Auth (
) where
--line needed for ghc 7.8
import Data.Functor ((<$>))
--import Data.Functor ((<$>))
import Data.Aeson (Value (..), Object)
import Data.Aeson.Types (emptyObject, emptyArray)
import Data.Vector as V (null, head)
src/PostgREST/Main.hs
+8 -7
View File
@@ -13,7 +13,7 @@ import PostgREST.Types
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson (encode)
import Data.Functor.Identity
import Data.Monoid ((<>))
import Data.String.Conversions (cs)
@@ -34,7 +34,7 @@ isServerVersionSupported = do
return $ read (cs row) >= minimumPgVersion
hasqlError :: PgError -> IO a
hasqlError = error . cs . encodePretty
hasqlError = error . cs . encode
main :: IO ()
main = do
@@ -71,11 +71,12 @@ main = do
<> show minimumPgVersion)
) supportedOrError
roleOrError <- H.session pool $ do
Identity (role :: Text) <- H.tx Nothing $ H.singleEx
[H.stmt|SELECT SESSION_USER|]
return role
authenticator <- either hasqlError return roleOrError
-- what was this code for?
-- roleOrError <- H.session pool $ do
-- Identity (role :: Text) <- H.tx Nothing $ H.singleEx
-- [H.stmt|SELECT SESSION_USER|]
-- return role
-- authenticator <- either hasqlError return roleOrError
let txSettings = Just (H.ReadCommitted, Just True)
metadata <- H.session pool $ H.tx txSettings $ do
src/PostgREST/Middleware.hs
+1 -1
View File
@@ -4,7 +4,7 @@
module PostgREST.Middleware where
-- needed for ghc 7.8
import Data.Functor ((<$>))
-- import Data.Functor ((<$>))
import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid
src/PostgREST/Parsers.hs
+2 -2
View File
@@ -5,8 +5,8 @@ where
import Control.Applicative hiding ((<$>))
--lines needed for ghc 7.8
import Data.Functor ((<$>))
import Data.Traversable (traverse)
-- import Data.Functor ((<$>))
-- import Data.Traversable (traverse)
--import Control.Monad (join)
--import Data.List (delete, find)
src/PostgREST/PgQuery.hs
+161 -156
View File
@@ -3,14 +3,57 @@
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PostgREST.PgQuery where
module PostgREST.PgQuery (
fromQi
, insertableValue
, wrapQuery
, asJson
, callProc
, iffNotT
, update
, insertSelect
, deleteFrom
, asCsvWithCount
, asJsonWithCount
, unquoted
-- format functions
, pgFmtLit
, pgFmtIdent
, pgFmtValue
, pgFmtCondition
, pgFmtColumn
, pgFmtJsonPath
, pgFmtTable
, pgFmtField
, pgFmtSelectItem
, pgFmtAsJsonPath
-- query transformers (to be removed)
, withT
, countT
, returningStarT
, whereT
-- query fragments
, orderF
, countNoneF
, countAllF
, countF
, locationF
, asCsvF
, asJsonSingleF
, asJsonF
, StatementT
) where
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import PostgREST.RangeQuery
import PostgREST.Types (OrderTerm (..), QualifiedIdentifier(..))
import PostgREST.Types
import Control.Monad (join)
import qualified Data.Aeson as JSON
@@ -25,7 +68,6 @@ import Data.Scientific (FPFormat (..), formatScientific,
import Data.String.Conversions (cs)
import qualified Data.Text as T
import Data.Vector (empty)
import qualified Data.Vector as V
import qualified Network.HTTP.Types.URI as Net
import Text.Regex.TDFA ((=~))
@@ -37,14 +79,12 @@ instance Monoid PStmt where
B.Stmt (query <> query') (params <> params') (prep && prep')
mempty = B.Stmt "" empty True
type StatementT = PStmt -> PStmt
limitT :: Maybe NonnegRange -> StatementT
limitT r q =
q <> B.Stmt (" LIMIT " <> limit <> " OFFSET " <> offset <> " ") empty True
where
limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
data JsonbPath =
ColIdentifier T.Text
| KeyIdentifier T.Text
| SingleArrow JsonbPath JsonbPath
| DoubleArrow JsonbPath JsonbPath
deriving (Show)
whereT :: QualifiedIdentifier -> Net.Query -> StatementT
whereT table params q =
@@ -62,24 +102,6 @@ withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
(ep <> wp)
(epre && wpre)
orderT :: [OrderTerm] -> StatementT
orderT ts q =
if L.null ts
then q
else q <> B.Stmt " order by " empty True <> clause
where
clause = mconcat $ L.intersperse commaq (map queryTerm ts)
queryTerm :: OrderTerm -> PStmt
queryTerm t = B.Stmt
(" " <> cs (pgFmtIdent $ otTerm t) <> " "
<> cs (otDirection t) <> " "
<> maybe "" cs (otNullOrder t) <> " ")
empty True
parentheticT :: StatementT
parentheticT s =
s { B.stmtTemplate = " (" <> B.stmtTemplate s <> ") " }
iffNotT :: PStmt -> StatementT
iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
B.Stmt
@@ -92,36 +114,9 @@ countT :: StatementT
countT s =
s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
countRows :: QualifiedIdentifier -> PStmt
countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQi t) empty True
countNone :: PStmt
countNone = B.Stmt "select null" empty True
asCsvWithCount :: QualifiedIdentifier -> StatementT
asCsvWithCount table = withCount . asCsv table
{--
WITH source AS (
SELECT * FROM projects
)
SELECT
(
SELECT string_agg(k.kk, ',')
FROM (
SELECT json_object_keys(j)::TEXT as kk
FROM (
SELECT row_to_json(source) as j from source limit 1
) l
) k
)
|| '\r' ||
coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '')
FROM (
SELECT * FROM source
) t;
--}
asCsv :: QualifiedIdentifier -> StatementT
asCsv table s = s {
B.stmtTemplate =
@@ -143,34 +138,12 @@ asJson s = s {
withCount :: StatementT
withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
asJsonRow :: StatementT
asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" }
returningStarT :: StatementT
returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
deleteFrom :: QualifiedIdentifier -> PStmt
deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
insertInto :: QualifiedIdentifier
-> V.Vector T.Text
-> V.Vector (V.Vector JSON.Value)
-> PStmt
insertInto t cols vals
| V.null cols = B.Stmt ("insert into " <> fromQi t <> " default values returning *") empty True
| otherwise = B.Stmt
("insert into " <> fromQi t <> " (" <>
T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
") values "
<> T.intercalate ", "
(V.toList $ V.map (\v -> "("
<> T.intercalate ", " (V.toList $ V.map insertableValue v)
<> ")"
) vals
)
<> " returning row_to_json(" <> fromQi t <> ".*)")
empty True
insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
insertSelect t [] _ = B.Stmt
("insert into " <> fromQi t <> " default values returning *") empty True
@@ -200,7 +173,7 @@ callProc qi params = do
wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
wherePred table (col, predicate) =
B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
if opCode `elem` ["is","isnot"] then whiteList value
if opCode `elem` ["is","isnot"] then whiteList val
else cs sqlValue)
empty True
@@ -209,60 +182,18 @@ wherePred table (col, predicate) =
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate ""
value = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
sqlValue = pgFmtValue opCode value
val = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
sqlValue = pgFmtValue opCode val
op = pgFmtOperator opCode
whiteList :: T.Text -> T.Text
whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ")
(L.find ((==) . T.toLower $ val) ["null","true","false"])
pgFmtValue :: T.Text -> T.Text -> T.Text
pgFmtValue opCode value =
case opCode of
"like" -> unknownLiteral $ T.map star value
"ilike" -> unknownLiteral $ T.map star value
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
"notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
"@@" -> "to_tsquery(" <> unknownLiteral value <> ") "
_ -> unknownLiteral value
where
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
pgFmtOperator :: T.Text -> T.Text
pgFmtOperator opCode =
case opCode of
"eq" -> "="
"gt" -> ">"
"lt" -> "<"
"gte" -> ">="
"lte" -> "<="
"neq" -> "<>"
"like"-> "like"
"ilike"-> "ilike"
"in" -> "in"
"notin" -> "not in"
"is" -> "is"
"isnot" -> "is not"
"@@" -> "@@"
_ -> "="
commaq :: PStmt
commaq = B.Stmt ", " empty True
andq :: PStmt
andq = B.Stmt " and " empty True
data JsonbPath =
ColIdentifier T.Text
| KeyIdentifier T.Text
| SingleArrow JsonbPath JsonbPath
| DoubleArrow JsonbPath JsonbPath
deriving (Show)
parseJsonbPath :: T.Text -> Maybe JsonbPath
parseJsonbPath p =
case T.splitOn "->>" p of
@@ -273,35 +204,6 @@ parseJsonbPath p =
(KeyIdentifier b)
_ -> Nothing
pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtJsonbPath table p =
pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
where
pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
pgFmtJsonbPath' (SingleArrow a b) =
pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
pgFmtJsonbPath' (DoubleArrow a b) =
pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
pgFmtIdent :: T.Text -> T.Text
pgFmtIdent x =
let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
if (cs escaped :: BS.ByteString) =~ danger
then "\"" <> escaped <> "\""
else escaped
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
pgFmtLit :: T.Text -> T.Text
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = T.replace "\\" "\\\\" escaped in
if T.isInfixOf "\\\\" escaped
then "E" <> slashed
else slashed
trimNullChars :: T.Text -> T.Text
trimNullChars = T.takeWhile (/= '\x0')
@@ -325,10 +227,6 @@ insertableValue :: JSON.Value -> T.Text
insertableValue JSON.Null = "null"
insertableValue v = insertableText $ unquoted v
paramFilter :: JSON.Value -> T.Text
paramFilter JSON.Null = "is.null"
paramFilter v = "eq." <> unquoted v
wrapQuery :: T.Text -> [T.Text] -> Maybe NonnegRange -> T.Text
wrapQuery source selectColumns range =
withSourceF source <>
@@ -337,6 +235,8 @@ wrapQuery source selectColumns range =
" " <>
fromF ( limitF range )
-- query fragments
withSourceF :: T.Text -> T.Text
withSourceF s = "WITH source AS (" <> s <>")"
@@ -406,3 +306,108 @@ orderF ts =
<> cs (pgFmtIdent $ otTerm t) <> " "
<> cs (otDirection t) <> " "
<> maybe "" cs (otNullOrder t) <> " "
-- formating functions
pgFmtValue :: T.Text -> T.Text -> T.Text
pgFmtValue opCode val =
case opCode of
"like" -> unknownLiteral $ T.map star val
"ilike" -> unknownLiteral $ T.map star val
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
"notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
"@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
_ -> unknownLiteral val
where
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
pgFmtOperator :: T.Text -> T.Text
pgFmtOperator opCode =
case opCode of
"eq" -> "="
"gt" -> ">"
"lt" -> "<"
"gte" -> ">="
"lte" -> "<="
"neq" -> "<>"
"like"-> "like"
"ilike"-> "ilike"
"in" -> "in"
"notin" -> "not in"
"is" -> "is"
"isnot" -> "is not"
"@@" -> "@@"
_ -> "="
pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtJsonbPath table p =
pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
where
pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
pgFmtJsonbPath' (SingleArrow a b) =
pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
pgFmtJsonbPath' (DoubleArrow a b) =
pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
pgFmtIdent :: T.Text -> T.Text
pgFmtIdent x =
let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
if (cs escaped :: BS.ByteString) =~ danger
then "\"" <> escaped <> "\""
else escaped
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
pgFmtLit :: T.Text -> T.Text
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = T.replace "\\" "\\\\" escaped in
if T.isInfixOf "\\\\" escaped
then "E" <> slashed
else slashed
pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text
pgFmtCondition table (Filter (col,jp) ops val) =
notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
where
headPredicate:rest = T.split (=='.') ops
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate ""
sqlCol = case val of
VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
VForeignKey qi _ -> pgFmtColumn qi col
sqlValue = valToStr val
getInner v = case v of
VText s -> s
_ -> ""
valToStr v = case v of
VText s -> pgFmtValue opCode s
VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtJsonPath :: Maybe JsonPath -> T.Text
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
pgFmtJsonPath _ = ""
pgFmtTable :: Table -> T.Text
pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
pgFmtField :: QualifiedIdentifier -> Field -> T.Text
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> T.Text
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
pgFmtAsJsonPath :: Maybe JsonPath -> T.Text
pgFmtAsJsonPath Nothing = ""
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
src/PostgREST/QueryBuilder.hs
+3 -47
View File
@@ -10,9 +10,9 @@ import Data.Text hiding (filter, find, foldr, head, last, map,
null, zipWith)
import Control.Applicative
import Data.Tree
import PostgREST.PgQuery (fromQi,
pgFmtIdent, pgFmtLit, pgFmtOperator,
pgFmtValue, whiteList, insertableValue, orderF)
import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
pgFmtIdent, pgFmtCondition,
insertableValue, orderF)
import PostgREST.Types
--import qualified Data.Vector as V (empty)
--import qualified Hasql.Backend as B
@@ -161,47 +161,3 @@ requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
-- ) vals
-- )
-- <> " returning row_to_json(" <> fromQi t <> ".*)")
pgFmtCondition :: QualifiedIdentifier -> Filter -> Text
pgFmtCondition table (Filter (col,jp) ops val) =
notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
where
headPredicate:rest = split (=='.') ops
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate ""
sqlCol = case val of
VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
VForeignKey qi _ -> pgFmtColumn qi col
sqlValue = valToStr val
getInner v = case v of
VText s -> s
_ -> ""
valToStr v = case v of
VText s -> pgFmtValue opCode s
VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
pgFmtColumn :: QualifiedIdentifier -> Text -> Text
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtJsonPath :: Maybe JsonPath -> Text
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
pgFmtJsonPath _ = ""
pgFmtTable :: Table -> Text
pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
pgFmtField :: QualifiedIdentifier -> Field -> Text
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> asJsonPath jp
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp
asJsonPath :: Maybe JsonPath -> Text
asJsonPath Nothing = ""
asJsonPath (Just xx) = " AS " <> last xx