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

Standardize indentation

Browse Source
This commit is contained in:
Joe Nelson
2015-09-06 16:13:11 -07:00
parent cf2f576ec0
commit 35f05f6fe1
8 changed files with 192 additions and 182 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+40 -40
View File
@@ -65,15 +65,15 @@ app conf reqBody req =
let qt = qualify table
from = fromMaybe 0 $ rangeOffset <$> range
query = B.Stmt "select " V.empty True <>
parentheticT (
whereT qt qq $ countRows qt
) <> commaq <> (
bodyForAccept contentType qt
. limitT range
. orderT (orderParse qq)
. whereT qt qq
$ select qt qq
)
parentheticT (
whereT qt qq $ countRows qt
) <> commaq <> (
bodyForAccept contentType qt
. limitT range
. orderT (orderParse qq)
. whereT qt qq
$ select qt qq
)
row <- H.maybeEx query
let (tableTotal, queryTotal, body) =
fromMaybe (0, 0, Just "" :: Maybe Text) row
@@ -81,14 +81,14 @@ app conf reqBody req =
contentRange = contentRangeH from to tableTotal
status = rangeStatus from to tableTotal
canonical = urlEncodeVars
. sortBy (comparing fst)
. map (join (***) cs)
. parseSimpleQuery
$ rawQueryString req
. sortBy (comparing fst)
. map (join (***) cs)
. parseSimpleQuery
$ rawQueryString req
return $ responseLBS status
[contentTypeH, contentRange,
("Content-Location",
"/" <> cs table <>
"/" <> cs table <>
if Prelude.null canonical then "" else "?" <> cs canonical
)
] (cs $ fromMaybe "[]" body)
@@ -119,8 +119,7 @@ app conf reqBody req =
encode . object $ [("message", String "Failed to parse user.")]
Just u -> do
setRole authenticator
login <- signInRole (cs $ userId u)
(cs $ userPass u)
login <- signInRole (cs $ userId u) (cs $ userPass u)
case login of
LoginSuccess role uid ->
return $ responseLBS status201 [ jsonH ] $
@@ -133,15 +132,15 @@ app conf reqBody req =
echoRequested = lookupHeader "Prefer" == Just "return=representation"
parsed :: Either String (V.Vector Text, V.Vector (V.Vector Value))
parsed = if lookupHeader "Content-Type" == Just csvMT
then do
rows <- CSV.decode CSV.NoHeader reqBody
if V.null rows then Left "CSV requires header"
else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows))
else eitherDecode reqBody >>= \val ->
case val of
Object obj -> Right . second V.singleton . V.unzip . V.fromList $
M.toList obj
_ -> Left "Expecting single JSON object or CSV rows"
then do
rows <- CSV.decode CSV.NoHeader reqBody
if V.null rows then Left "CSV requires header"
else Right (V.head rows, (V.map $ V.map $ parseCsvCell . cs) (V.tail rows))
else eitherDecode reqBody >>= \val ->
case val of
Object obj -> Right . second V.singleton . V.unzip . V.fromList $
M.toList obj
_ -> Left "Expecting single JSON object or CSV rows"
case parsed of
Left err -> return $ responseLBS status400 [] $
encode . object $ [("message", String $ "Failed to parse JSON payload. " <> cs err)]
@@ -186,7 +185,7 @@ app conf reqBody req =
let specifiedKeys = map (cs . fst) qq
if S.fromList primaryKeys /= S.fromList specifiedKeys
then return $ responseLBS status405 []
"You must speficy all and only primary keys as params"
"You must speficy all and only primary keys as params"
else do
tableCols <- map (cs . colName) <$> columns qt
let cols = map cs $ M.keys obj
@@ -194,21 +193,21 @@ app conf reqBody req =
then do
let vals = M.elems obj
H.unitEx $ iffNotT
(whereT qt qq $ update qt cols vals)
(insertSelect qt cols vals)
(whereT qt qq $ update qt cols vals)
(insertSelect qt cols vals)
return $ responseLBS status204 [ jsonH ] ""
else return $ if Prelude.null tableCols
then responseLBS status404 [] ""
else responseLBS status400 []
"You must specify all columns in PUT request"
"You must specify all columns in PUT request"
([table], "PATCH") ->
handleJsonObj reqBody $ \obj -> do
let qt = qualify table
up = returningStarT
. whereT qt qq
$ update qt (map cs $ M.keys obj) (M.elems obj)
. whereT qt qq
$ update qt (map cs $ M.keys obj) (M.elems obj)
patch = withT up "t" $ B.Stmt
"select count(t), array_to_json(array_agg(row_to_json(t)))::character varying"
V.empty True
@@ -232,8 +231,8 @@ app conf reqBody req =
row <- H.maybeEx del
let (Identity deletedCount) = fromMaybe (Identity 0 :: Identity Int) row
return $ if deletedCount == 0
then responseLBS status404 [] ""
else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
then responseLBS status404 [] ""
else responseLBS status204 [("Content-Range", "*/"<> cs (show deletedCount))] ""
(_, _) ->
return $ responseLBS status404 [] ""
@@ -271,19 +270,20 @@ contentRangeH from to total =
("Content-Range",
if total == 0 || from > total
then "*/" <> cs (show total)
else cs (show from) <> "-"
<> cs (show to) <> "/"
<> cs (show total)
else cs (show from)
<> "-" <> cs (show to)
<> "/" <> cs (show total)
)
requestedSchema :: Text -> Maybe BS.ByteString -> Text
requestedSchema v1schema accept =
case verStr of
Just [[_, ver]] -> if ver == "1" then v1schema else cs ver
_ -> v1schema
Just [[_, ver]] -> if ver == "1" then v1schema else cs ver
_ -> v1schema
where verRegex = "version[ ]*=[ ]*([0-9]+)" :: BS.ByteString
verStr = (=~ verRegex) <$> accept :: Maybe [[BS.ByteString]]
where
verRegex = "version[ ]*=[ ]*([0-9]+)" :: BS.ByteString
verStr = (=~ verRegex) <$> accept :: Maybe [[BS.ByteString]]
jsonMT :: BS.ByteString
src/PostgREST/Auth.hs
+4 -4
View File
@@ -56,10 +56,10 @@ setRole :: Text -> H.Tx P.Postgres s ()
setRole role = H.unitEx $ B.Stmt ("set local role " <> cs (pgFmtLit role)) V.empty True
setUserId :: Text -> H.Tx P.Postgres s ()
setUserId uid = if uid /= "" then
H.unitEx $ B.Stmt ("set local user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True
else
resetUserId
setUserId uid =
if uid /= ""
then H.unitEx $ B.Stmt ("set local user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True
else resetUserId
resetUserId :: H.Tx P.Postgres s ()
resetUserId = H.unitEx [H.stmt|reset user_vars.user_id|]
src/PostgREST/Config.hs
+4 -4
View File
@@ -22,7 +22,7 @@ data AppConfig = AppConfig {
, configSecure :: Bool
, configPool :: Int
, configV1Schema :: String
, configJwtSecret :: String
}
@@ -52,9 +52,9 @@ corsPolicy req = case lookup "origin" headers of
corsOrigins = Just ([origin], True)
, corsRequestHeaders = "Authentication":accHeaders
, corsExposedHeaders = Just [
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
]
"Content-Encoding", "Content-Location", "Content-Range", "Content-Type"
, "Date", "Location", "Server", "Transfer-Encoding", "Range-Unit"
]
}
Nothing -> Nothing
where
src/PostgREST/Main.hs
+13 -10
View File
@@ -36,12 +36,12 @@ main = do
hSetBuffering stderr NoBuffering
let opts = info (helper <*> argParser) $
fullDesc
<> progDesc (
"PostgREST "
<> prettyVersion
<> " / create a REST API to an existing Postgres database"
)
fullDesc
<> progDesc (
"PostgREST "
<> prettyVersion
<> " / create a REST API to an existing Postgres database"
)
parserPrefs = prefs showHelpOnError
conf <- customExecParser parserPrefs opts
let port = configPort conf
@@ -64,12 +64,15 @@ main = do
middle = logStdout . defaultMiddle (configSecure conf)
poolSettings <- maybe (fail "Improper session settings") return $
H.poolSettings (fromIntegral $ configPool conf) 30
pool :: H.Pool P.Postgres
<- H.acquirePool pgSettings poolSettings
H.poolSettings (fromIntegral $ configPool conf) 30
pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
resOrError <- H.session pool isServerVersionSupported
either (fail . show) (\supported -> unless supported $ fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0") resOrError
either (fail . show)
(\supported ->
unless supported $
fail "Cannot run in this PostgreSQL version, PostgREST needs at least 9.2.0"
) resOrError
runSettings appSettings $ middle $ \req respond -> do
body <- strictRequestBody req
src/PostgREST/Middleware.hs
+9 -9
View File
@@ -78,12 +78,12 @@ redirectInsecure app req respond = do
if not (isSecure req || isHerokuSecure)
then case uriM of
Just uri ->
respond $ responseLBS status301 [
(hLocation, cs . show $ uri { uriScheme = "https:" })
] ""
Nothing ->
respond $ responseLBS status400 [] "SSL is required"
Just uri ->
respond $ responseLBS status301 [
(hLocation, cs . show $ uri { uriScheme = "https:" })
] ""
Nothing ->
respond $ responseLBS status400 [] "SSL is required"
else app req respond
unsupportedAccept :: Application -> Application
@@ -96,6 +96,6 @@ unsupportedAccept app req respond = do
defaultMiddle :: Bool -> Application -> Application
defaultMiddle secure = (if secure then redirectInsecure else id)
. gzip def . cors corsPolicy
. staticPolicy (only [("favicon.ico", "static/favicon.ico")])
. unsupportedAccept
. gzip def . cors corsPolicy
. staticPolicy (only [("favicon.ico", "static/favicon.ico")])
. unsupportedAccept
src/PostgREST/PgQuery.hs
+78 -72
View File
@@ -54,13 +54,13 @@ limitT r q =
whereT :: QualifiedIdentifier -> Net.Query -> StatementT
whereT table params q =
if L.null cols
then q
else q <> B.Stmt " where " empty True <> conjunction
where
cols = [ col | col <- params, fst col `notElem` ["order","select"] ]
wherePredTable = wherePred table
conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
if L.null cols
then q
else q <> B.Stmt " where " empty True <> conjunction
where
cols = [ col | col <- params, fst col `notElem` ["order","select"] ]
wherePredTable = wherePred table
conjunction = mconcat $ L.intersperse andq (map wherePredTable cols)
withT :: PStmt -> T.Text -> StatementT
withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
@@ -74,13 +74,13 @@ orderT ts q =
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
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 =
@@ -105,7 +105,8 @@ asCsvWithCount :: QualifiedIdentifier -> StatementT
asCsvWithCount table = withCount . asCsv table
asCsv :: QualifiedIdentifier -> StatementT
asCsv table s = s { B.stmtTemplate =
asCsv table s = s {
B.stmtTemplate =
"(select string_agg(quote_ident(column_name::text), ',') from "
<> "(select column_name from information_schema.columns where quote_ident(table_schema) || '.' || table_name = '"
<> fromQi table <> "' order by ordinal_position) h) || '\r' || "
@@ -116,7 +117,8 @@ asJsonWithCount :: StatementT
asJsonWithCount = withCount . asJson
asJson :: StatementT
asJson s = s { B.stmtTemplate =
asJson s = s {
B.stmtTemplate =
"array_to_json(array_agg(row_to_json(t)))::character varying from ("
<> B.stmtTemplate s <> ") t" }
@@ -131,26 +133,30 @@ selectStar t = B.Stmt ("select * from " <> fromQi t) empty True
select :: QualifiedIdentifier -> Net.Query -> PStmt
select table params =
if L.null cols
then selectStar table
else B.Stmt "select " empty True <> conjunction <> B.Stmt (" from " <> fromQi table ) empty True
where
selectTermTable = selectTerm table
conjunction = mconcat $ L.intersperse commaq (map selectTermTable cols)
columnsParam = fromMaybe "" $ join (lookup "select" params)
cols = filter ((>0) . T.length) $ map T.strip $ T.split (==',') $ cs columnsParam
if L.null cols
then selectStar table
else B.Stmt "select " empty True <> conjunction <> B.Stmt (" from " <> fromQi table ) empty True
where
selectTermTable = selectTerm table
conjunction = mconcat $ L.intersperse commaq (map selectTermTable cols)
columnsParam = fromMaybe "" $ join (lookup "select" params)
cols = filter ((>0) . T.length) $ map T.strip $ T.split (==',') $ cs columnsParam
selectTerm :: QualifiedIdentifier -> T.Text -> PStmt
selectTerm table col =
case T.splitOn "::" col of
[colName,castTo] -> B.Stmt ("CAST (" <> pgFmtJsonbPath table (cs colName) <> " AS " <> castToSafe <> " )" <> asT (jsonbPath colName)) empty True
where castToSafe = T.filter ( `elem` ['a'..'z'] ) castTo
_-> B.Stmt (pgFmtJsonbPath table (cs col) <> asT (jsonbPath col)) empty True
where
jsonbPath :: T.Text -> Maybe JsonbPath
jsonbPath c = parseJsonbPath $ cs c
asT (Just (DoubleArrow _ (KeyIdentifier key))) = " AS " <> pgFmtIdent key
asT _ = ""
case T.splitOn "::" col of
[colName,castTo] ->
B.Stmt (
"CAST (" <> pgFmtJsonbPath table (cs colName) <> " AS "
<> castToSafe <> " )" <> asT (jsonbPath colName)
) empty True
where castToSafe = T.filter ( `elem` ['a'..'z'] ) castTo
_ -> B.Stmt (pgFmtJsonbPath table (cs col) <> asT (jsonbPath col)) empty True
where
jsonbPath :: T.Text -> Maybe JsonbPath
jsonbPath c = parseJsonbPath $ cs c
asT (Just (DoubleArrow _ (KeyIdentifier key))) = " AS " <> pgFmtIdent key
asT _ = ""
returningStarT :: StatementT
returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
@@ -212,39 +218,39 @@ wherePred table (col, predicate) =
where
headPredicate:rest = T.split (=='.') $ cs $ fromMaybe "." 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)
whiteList val = fromMaybe (cs (pgFmtLit val) <> "::unknown ")
(L.find ((==) . T.toLower $ val)
["null","true","false"])
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)
whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ")
(L.find ((==) . T.toLower $ val) ["null","true","false"])
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
sqlValue = 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
"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
op = case opCode of
"eq" -> "="
"gt" -> ">"
"lt" -> "<"
"gte" -> ">="
"lte" -> "<="
"neq" -> "<>"
"like"-> "like"
"ilike"-> "ilike"
"in" -> "in"
"notin" -> "not in"
"is" -> "is"
"isnot" -> "is not"
"@@" -> "@@"
_ -> "="
"eq" -> "="
"gt" -> ">"
"lt" -> "<"
"gte" -> ">="
"lte" -> "<="
"neq" -> "<>"
"like"-> "like"
"ilike"-> "ilike"
"in" -> "in"
"notin" -> "not in"
"is" -> "is"
"isnot" -> "is not"
"@@" -> "@@"
_ -> "="
orderParse :: Net.Query -> [OrderTerm]
orderParse q =
@@ -255,18 +261,18 @@ orderParse q =
orderParseTerm :: T.Text -> Maybe OrderTerm
orderParseTerm s =
case T.split (=='.') s of
(c:d:nls) ->
if d `elem` ["asc", "desc"]
then Just $ OrderTerm c
( if d == "asc" then "asc" else "desc" )
( case nls of
[n] -> if | n == "nullsfirst" -> Just "nulls first"
| n == "nullslast" -> Just "nulls last"
| otherwise -> Nothing
_ -> Nothing
)
else Nothing
_ -> Nothing
(c:d:nls) ->
if d `elem` ["asc", "desc"]
then Just $ OrderTerm c
( if d == "asc" then "asc" else "desc" )
( case nls of
[n] -> if | n == "nullsfirst" -> Just "nulls first"
| n == "nullslast" -> Just "nulls last"
| otherwise -> Nothing
_ -> Nothing
)
else Nothing
_ -> Nothing
commaq :: PStmt
commaq = B.Stmt ", " empty True
src/PostgREST/PgStructure.hs
+38 -37
View File
@@ -43,8 +43,8 @@ tables :: Text -> H.Tx P.Postgres s [Table]
tables schema = do
rows <- H.listEx $
[H.stmt|
select
n.nspname as table_schema,
select
n.nspname as table_schema,
relname as table_name,
c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
or (exists (
@@ -52,16 +52,17 @@ tables schema = do
from pg_trigger
where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
) as insertable
from
pg_class c
join pg_namespace n on n.oid = c.relnamespace
where
c.relkind in ('v', 'r', 'm')
and n.nspname = ?
and (
pg_has_role(c.relowner, 'USAGE'::text)
or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
)
from
pg_class c
join pg_namespace n on n.oid = c.relnamespace
where
c.relkind in ('v', 'r', 'm')
and n.nspname = ?
and (
pg_has_role(c.relowner, 'USAGE'::text)
or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
)
order by relname
|] schema
return $ map tableFromRow rows
@@ -71,31 +72,31 @@ columns :: QualifiedIdentifier -> H.Tx P.Postgres s [Column]
columns table = do
cols <- H.listEx $ [H.stmt|
select info.table_schema as schema, info.table_name as table_name,
info.column_name as name, info.ordinal_position as position,
info.is_nullable::boolean as nullable, info.data_type as col_type,
info.is_updatable::boolean as updatable,
info.character_maximum_length as max_len,
info.numeric_precision as precision,
info.column_default as default_value,
array_to_string(enum_info.vals, ',') as enum
from (
select table_schema, table_name, column_name, ordinal_position,
is_nullable, data_type, is_updatable,
character_maximum_length, numeric_precision,
column_default, udt_name
from information_schema.columns
where table_schema = ? and table_name = ?
) as info
left outer join (
select n.nspname as s,
t.typname as n,
array_agg(e.enumlabel ORDER BY e.enumsortorder) as vals
from pg_type t
join pg_enum e on t.oid = e.enumtypid
join pg_catalog.pg_namespace n ON n.oid = t.typnamespace
group by s, n
) as enum_info
on (info.udt_name = enum_info.n)
info.column_name as name, info.ordinal_position as position,
info.is_nullable::boolean as nullable, info.data_type as col_type,
info.is_updatable::boolean as updatable,
info.character_maximum_length as max_len,
info.numeric_precision as precision,
info.column_default as default_value,
array_to_string(enum_info.vals, ',') as enum
from (
select table_schema, table_name, column_name, ordinal_position,
is_nullable, data_type, is_updatable,
character_maximum_length, numeric_precision,
column_default, udt_name
from information_schema.columns
where table_schema = ? and table_name = ?
) as info
left outer join (
select n.nspname as s,
t.typname as n,
array_agg(e.enumlabel ORDER BY e.enumsortorder) as vals
from pg_type t
join pg_enum e on t.oid = e.enumtypid
join pg_catalog.pg_namespace n ON n.oid = t.typnamespace
group by s, n
) as enum_info
on (info.udt_name = enum_info.n)
order by position |]
(qiSchema table) (qiName table)
src/PostgREST/RangeQuery.hs
+6 -6
View File
@@ -41,15 +41,15 @@ rangeRequested = (rangeParse =<<) . lookup hRange
rangeLimit :: NonnegRange -> Maybe Int
rangeLimit range =
case [rangeLower range, rangeUpper range]
of [BoundaryBelow from, BoundaryAbove to] -> Just (1 + to - from)
_ -> Nothing
case [rangeLower range, rangeUpper range] of
[BoundaryBelow from, BoundaryAbove to] -> Just (1 + to - from)
_ -> Nothing
rangeOffset :: NonnegRange -> Int
rangeOffset range =
case rangeLower range
of BoundaryBelow from -> from
_ -> error "range without lower bound" -- should never happen
case rangeLower range of
BoundaryBelow from -> from
_ -> error "range without lower bound" -- should never happen
rangeGeq :: Int -> NonnegRange
rangeGeq n =