postgrest 0.2.5.3 → 0.2.6.0
raw patch · 5 files changed
+42/−38 lines, 5 files
Files
- postgrest.cabal +3/−5
- src/Config.hs +4/−0
- src/PgQuery.hs +35/−30
- test/Main.hs +0/−1
- test/SpecHelper.hs +0/−2
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.3+version: 0.2.6.0 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE@@ -17,8 +17,7 @@ main-is: Main.hs ghc-options: -Wall -W -O2 default-language: Haskell2010- default-extensions: OverloadedStrings, ScopedTypeVariables- other-extensions: QuasiQuotes+ default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes build-depends: base >=4.6 && <5 , hasql == 0.7.*, hasql-backend , hasql-postgres == 0.10.*@@ -57,8 +56,7 @@ Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010- default-extensions: OverloadedStrings, ScopedTypeVariables- other-extensions: QuasiQuotes+ default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes Hs-Source-Dirs: test, src ghc-options: -Wall -W -Werror Main-Is: Main.hs
src/Config.hs view
@@ -45,6 +45,10 @@ Just origin -> Just defaultCorsPolicy { corsOrigins = Just ([origin], True) , corsRequestHeaders = "Authentication":accHeaders+ , corsExposedHeaders = Just [+ "Content-Encoding", "Content-Location", "Content-Range", "Content-Type"+ , "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"+ ] } Nothing -> Nothing where
src/PgQuery.hs view
@@ -9,7 +9,7 @@ import qualified Hasql.Postgres as P import qualified Hasql.Backend as B -import Data.Text hiding (map, empty)+import qualified Data.Text as T import Text.Regex.TDFA ( (=~) ) import Text.Regex.TDFA.Text () import qualified Network.HTTP.Types.URI as Net@@ -32,12 +32,12 @@ type StatementT = PStmt -> PStmt data QualifiedTable = QualifiedTable {- qtSchema :: Text-, qtName :: Text+ qtSchema :: T.Text+, qtName :: T.Text } deriving (Show) data OrderTerm = OrderTerm {- otTerm :: Text+ otTerm :: T.Text , otDirection :: BS.ByteString } @@ -106,33 +106,33 @@ deleteFrom :: QualifiedTable -> PStmt deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True -insertInto :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt+insertInto :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt insertInto t [] _ = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True insertInto t cols vals = B.Stmt ("insert into " <> fromQt t <> " (" <>- intercalate ", " (map pgFmtIdent cols) <>+ T.intercalate ", " (map pgFmtIdent cols) <> ") values ("- <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)+ <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) <> ") returning row_to_json(" <> fromQt t <> ".*)") empty True -insertSelect :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt+insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt insertSelect t [] _ = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True insertSelect t cols vals = B.Stmt ("insert into " <> fromQt t <> " ("- <> intercalate ", " (map pgFmtIdent cols)+ <> T.intercalate ", " (map pgFmtIdent cols) <> ") select "- <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals))+ <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)) empty True -update :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt+update :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt update t cols vals = B.Stmt ("update " <> fromQt t <> " set ("- <> intercalate ", " (map pgFmtIdent cols)+ <> T.intercalate ", " (map pgFmtIdent cols) <> ") = ("- <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)+ <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) <> ")") empty True @@ -142,8 +142,11 @@ empty True where- opCode:rest = split (=='.') $ cs $ fromMaybe "." predicate- value = intercalate "." rest+ opCode:rest = T.split (=='.') $ cs $ fromMaybe "." predicate+ unStarredVal = T.intercalate "." rest+ star c = if c == '*' then '%' else c+ value = if opCode == "like" || opCode == "ilike"+ then T.map star unStarredVal else unStarredVal op = case opCode of "eq" -> "=" "gt" -> ">"@@ -151,18 +154,20 @@ "gte" -> ">=" "lte" -> "<=" "neq" -> "<>"+ "like"-> "like"+ "ilike"-> "ilike" _ -> "=" orderParse :: Net.Query -> [OrderTerm] orderParse q =- mapMaybe orderParseTerm . split (==',') $ cs order+ mapMaybe orderParseTerm . T.split (==',') $ cs order where order = fromMaybe "" $ join (lookup "order" q) -orderParseTerm :: Text -> Maybe OrderTerm+orderParseTerm :: T.Text -> Maybe OrderTerm orderParseTerm s =- case split (=='.') s of- [d,c] ->+ case T.split (=='.') s of+ [c,d] -> if d `elem` ["asc", "desc"] then Just $ OrderTerm c $ if d == "asc" then "asc" else "desc"@@ -175,31 +180,31 @@ andq :: PStmt andq = B.Stmt " and " empty True -pgFmtIdent :: Text -> Text+pgFmtIdent :: T.Text -> T.Text pgFmtIdent x =- let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in+ let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in if escaped =~ danger then "\"" <> escaped <> "\"" else escaped - where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: Text+ where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: T.Text -pgFmtLit :: Text -> Text+pgFmtLit :: T.Text -> T.Text pgFmtLit x = let trimmed = trimNullChars x- escaped = "'" <> replace "'" "''" trimmed <> "'"- slashed = replace "\\" "\\\\" escaped in- cs $ if escaped =~ ("\\\\" :: Text)+ escaped = "'" <> T.replace "'" "''" trimmed <> "'"+ slashed = T.replace "\\" "\\\\" escaped in+ cs $ if escaped =~ ("\\\\" :: T.Text) then "E" <> slashed else slashed -trimNullChars :: Text -> Text-trimNullChars = Data.Text.takeWhile (/= '\x0')+trimNullChars :: T.Text -> T.Text+trimNullChars = T.takeWhile (/= '\x0') -fromQt :: QualifiedTable -> Text+fromQt :: QualifiedTable -> T.Text fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t) -unquoted :: JSON.Value -> Text+unquoted :: JSON.Value -> T.Text unquoted (JSON.String t) = t unquoted (JSON.Number n) = cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
test/Main.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE QuasiQuotes #-} module Main where import Test.Hspec
test/SpecHelper.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}- module SpecHelper where import Network.Wai