Joe Nelson
+28
-18
@@ -14,7 +14,7 @@ import Data.List (find, delete)
|
||||
import Data.Maybe (fromMaybe, fromJust, mapMaybe)
|
||||
import Data.Ranged.Ranges (emptyRange)
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text, replace, strip)
|
||||
import Data.Text (Text, replace, strip, isInfixOf, dropWhile, drop)
|
||||
import Data.Tree
|
||||
|
||||
import qualified Hasql.Pool as P
|
||||
@@ -62,7 +62,7 @@ import PostgREST.QueryBuilder ( callProc
|
||||
import PostgREST.Types
|
||||
import PostgREST.OpenAPI
|
||||
|
||||
import Prelude
|
||||
import Prelude hiding (dropWhile, drop)
|
||||
|
||||
|
||||
postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> Application
|
||||
@@ -186,22 +186,22 @@ app dbStructure conf apiRequest =
|
||||
|
||||
(ActionInvoke, TargetProc qi,
|
||||
Just (PayloadJSON (UniformObjects payload))) -> do
|
||||
exists <- H.query qi doesProcExist
|
||||
if exists
|
||||
then do
|
||||
let p = V.head payload
|
||||
jwtSecret = configJwtSecret conf
|
||||
respondToRange $ do
|
||||
row <- H.query () (callProc qi p topLevelRange shouldCount)
|
||||
returnJWT <- H.query qi doesProcReturnJWT
|
||||
let p = V.head payload
|
||||
singular = iPreferSingular apiRequest
|
||||
jwtSecret = configJwtSecret conf
|
||||
returnType = lookup (qiName qi) $ dbProcs dbStructure
|
||||
returnsJWT = fromMaybe False $ isInfixOf "jwt_claims" <$> returnType
|
||||
case readSqlParts of
|
||||
Left e -> return $ responseLBS status400 [jsonH] $ cs e
|
||||
Right (q,cq) -> respondToRange $ do
|
||||
row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular)
|
||||
let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, emptyArray) row
|
||||
(status, contentRange) = rangeHeader queryTotal tableTotal
|
||||
in
|
||||
return $ responseLBS status [jsonH, contentRange]
|
||||
(if returnJWT
|
||||
(if returnsJWT
|
||||
then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
|
||||
else cs $ encode body)
|
||||
else return notFound
|
||||
|
||||
(ActionRead, TargetRoot, Nothing) -> do
|
||||
let encodeApi ti = encodeOpenAPI ti host port
|
||||
@@ -241,7 +241,7 @@ app dbStructure conf apiRequest =
|
||||
schema = cs $ configSchema conf
|
||||
shouldCount = iPreferCount apiRequest
|
||||
topLevelRange = fromMaybe allRange $ M.lookup "limit" $ iRange apiRequest
|
||||
readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) apiRequest
|
||||
readDbRequest = DbRead <$> buildReadRequest (configMaxRows conf) (dbRelations dbStructure) (dbProcs dbStructure) apiRequest
|
||||
mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest
|
||||
selectQuery = requestToQuery schema False <$> readDbRequest
|
||||
countQuery = requestToCountQuery schema <$> readDbRequest
|
||||
@@ -326,9 +326,10 @@ addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
|
||||
filters = mapM pRequestFilter flts
|
||||
where
|
||||
action = iAction apiRequest
|
||||
flts = if action == ActionRead
|
||||
then iFilters apiRequest
|
||||
else filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
|
||||
flts
|
||||
| action == ActionRead = iFilters apiRequest
|
||||
| action == ActionInvoke = iFilters apiRequest
|
||||
| otherwise = filter (( '.' `elem` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update
|
||||
orders :: Either ParseError [(Path, [OrderTerm])]
|
||||
orders = mapM pRequestOrder $ iOrder apiRequest
|
||||
ranges :: Either ParseError [(Path, NonnegRange)]
|
||||
@@ -340,8 +341,8 @@ treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` re
|
||||
nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
|
||||
nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
|
||||
|
||||
buildReadRequest :: Maybe Integer -> [Relation] -> ApiRequest -> Either Text ReadRequest
|
||||
buildReadRequest maxRows allRels apiRequest =
|
||||
buildReadRequest :: Maybe Integer -> [Relation] -> [(Text, Text)] -> ApiRequest -> Either Text ReadRequest
|
||||
buildReadRequest maxRows allRels allProcs apiRequest =
|
||||
treeRestrictRange maxRows =<<
|
||||
augumentRequestWithJoin schema relations =<<
|
||||
first formatParserError readRequest
|
||||
@@ -350,6 +351,14 @@ buildReadRequest maxRows allRels apiRequest =
|
||||
let target = iTarget apiRequest in
|
||||
case target of
|
||||
(TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
|
||||
(TargetProc (QualifiedIdentifier s p) ) -> Just (s, t)
|
||||
where
|
||||
returnType = fromMaybe "" $ lookup p allProcs
|
||||
-- we are looking for results looking like "SETOF schema.tablename" and want to extract tablename
|
||||
t = if "SETOF " `isInfixOf` returnType
|
||||
then drop 1 $ dropWhile (/= '.') returnType
|
||||
else p
|
||||
|
||||
_ -> Nothing
|
||||
|
||||
action :: Action
|
||||
@@ -369,6 +378,7 @@ buildReadRequest maxRows allRels apiRequest =
|
||||
ActionCreate -> fakeSourceRelations ++ allRels
|
||||
ActionUpdate -> fakeSourceRelations ++ allRels
|
||||
ActionDelete -> fakeSourceRelations ++ allRels
|
||||
ActionInvoke -> fakeSourceRelations ++ allRels
|
||||
_ -> allRels
|
||||
where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
|
||||
|
||||
|
||||
@@ -6,8 +6,6 @@
|
||||
module PostgREST.DbStructure (
|
||||
getDbStructure
|
||||
, accessibleTables
|
||||
, doesProcExist
|
||||
, doesProcReturnJWT
|
||||
) where
|
||||
|
||||
import qualified Hasql.Decoders as HD
|
||||
@@ -16,7 +14,6 @@ import qualified Hasql.Query as H
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad (join, replicateM)
|
||||
import Data.Functor.Contravariant (contramap)
|
||||
import Data.List (elemIndex, find, sort,
|
||||
subsequences, transpose)
|
||||
import Data.Maybe (fromJust, fromMaybe, isJust,
|
||||
@@ -38,6 +35,7 @@ getDbStructure schema = do
|
||||
syns <- H.query () $ allSynonyms cols
|
||||
rels <- H.query () $ allRelations tabs cols
|
||||
keys <- H.query () $ allPrimaryKeys tabs
|
||||
procs <- H.query schema accessibleProcs
|
||||
|
||||
let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
|
||||
cols' = addForeignKeys rels' cols
|
||||
@@ -48,13 +46,9 @@ getDbStructure schema = do
|
||||
, dbColumns = cols'
|
||||
, dbRelations = rels'
|
||||
, dbPrimaryKeys = keys'
|
||||
, dbProcs = procs
|
||||
}
|
||||
|
||||
encodeQi :: HE.Params QualifiedIdentifier
|
||||
encodeQi =
|
||||
contramap qiSchema (HE.value HE.text) <>
|
||||
contramap qiName (HE.value HE.text)
|
||||
|
||||
decodeTables :: HD.Result [Table]
|
||||
decodeTables =
|
||||
HD.rowsList tblRow
|
||||
@@ -104,32 +98,16 @@ decodeSynonyms cols =
|
||||
<*> HD.value HD.text <*> HD.value HD.text
|
||||
<*> HD.value HD.text <*> HD.value HD.text
|
||||
|
||||
doesProcExist :: H.Query QualifiedIdentifier Bool
|
||||
doesProcExist =
|
||||
H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
|
||||
accessibleProcs :: H.Query Schema [(Text, Text)]
|
||||
accessibleProcs =
|
||||
H.statement sql (HE.value HE.text) (HD.rowsList ((,) <$> HD.value HD.text <*> HD.value HD.text)) True
|
||||
where
|
||||
sql = [q| SELECT EXISTS (
|
||||
SELECT 1
|
||||
FROM pg_catalog.pg_namespace n
|
||||
JOIN pg_catalog.pg_proc p
|
||||
ON pronamespace = n.oid
|
||||
WHERE nspname = $1
|
||||
AND proname = $2
|
||||
) |]
|
||||
|
||||
doesProcReturnJWT :: H.Query QualifiedIdentifier Bool
|
||||
doesProcReturnJWT =
|
||||
H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
|
||||
where
|
||||
sql = [q| SELECT EXISTS (
|
||||
SELECT 1
|
||||
FROM pg_catalog.pg_namespace n
|
||||
JOIN pg_catalog.pg_proc p
|
||||
ON pronamespace = n.oid
|
||||
WHERE nspname = $1
|
||||
AND proname = $2
|
||||
AND pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
|
||||
) |]
|
||||
sql = [q|
|
||||
SELECT p.proname as "proc_name", pg_get_function_result(p.oid) as "return_type"
|
||||
FROM pg_namespace n
|
||||
JOIN pg_proc p
|
||||
ON pronamespace = n.oid
|
||||
WHERE n.nspname = $1|]
|
||||
|
||||
accessibleTables :: H.Query Schema [Table]
|
||||
accessibleTables =
|
||||
|
||||
@@ -203,29 +203,39 @@ addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
|
||||
addCond query' con = query'{flt_=con ++ flt_ query'}
|
||||
|
||||
type ProcResults = (Maybe Int64, Int64, JSON.Value)
|
||||
callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults)
|
||||
callProc qi params range countTotal =
|
||||
callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> H.Query () (Maybe ProcResults)
|
||||
callProc qi params selectQuery countQuery _ countTotal isSingle =
|
||||
unicodeStatement sql HE.unit decodeProc True
|
||||
where
|
||||
sql = [qc|
|
||||
WITH t AS (select * {_callSql})
|
||||
WITH {sourceCTEName} AS ({_callSql})
|
||||
SELECT
|
||||
{_countExpr} as countTotal,
|
||||
pg_catalog.count(1) as countResult,
|
||||
array_to_json(
|
||||
coalesce(array_agg(row_to_json(r)), '\{}')
|
||||
)::character varying
|
||||
FROM (select * from t {limitF range}) r;
|
||||
{countResultF} AS total_result_set,
|
||||
pg_catalog.count(t) AS page_total,
|
||||
case
|
||||
when pg_catalog.count(1) > 1 then
|
||||
{bodyF}
|
||||
else
|
||||
coalesce(((array_agg(row_to_json(t)))[1]->{_procName})::character varying, {bodyF})
|
||||
|
||||
end as body
|
||||
FROM ({selectQuery}) t;
|
||||
|]
|
||||
-- FROM (select * from {sourceCTEName} {limitF range}) t;
|
||||
countResultF = if countTotal then "("<>countQuery<>")" else "null::bigint" :: Text
|
||||
_args = intercalate "," $ map _assignment (HM.toList params)
|
||||
_procName = pgFmtLit $ qiName qi
|
||||
_assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
|
||||
_callSql = [qc| from {fromQi qi}({_args}) |] :: Text
|
||||
_callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text
|
||||
_countExpr = if countTotal
|
||||
then "(select pg_catalog.count(1) from t)"
|
||||
then [qc|(select pg_catalog.count(1) from {sourceCTEName})|]
|
||||
else "null::bigint" :: Text
|
||||
decodeProc = HD.maybeRow procRow
|
||||
procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
|
||||
<*> HD.value HD.json
|
||||
bodyF
|
||||
| isSingle = asJsonSingleF
|
||||
| otherwise = asJsonF
|
||||
|
||||
operators :: [(Text, SqlFragment)]
|
||||
operators = [
|
||||
@@ -263,10 +273,13 @@ requestToCountQuery _ (DbMutate _) = undefined
|
||||
requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _, _)) _)) =
|
||||
unwords [
|
||||
"SELECT pg_catalog.count(1)",
|
||||
"FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
|
||||
"FROM ", fromQi qi,
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi) localConditions )) `emptyOnNull` localConditions
|
||||
]
|
||||
where
|
||||
qi = if mainTbl == sourceCTEName
|
||||
then QualifiedIdentifier "" mainTbl
|
||||
else QualifiedIdentifier schema mainTbl
|
||||
fn Filter{value=VText _} = True
|
||||
fn Filter{value=VForeignKey _ _} = False
|
||||
localConditions = filter fn conditions
|
||||
|
||||
@@ -13,6 +13,7 @@ data DbStructure = DbStructure {
|
||||
, dbColumns :: [Column]
|
||||
, dbRelations :: [Relation]
|
||||
, dbPrimaryKeys :: [PrimaryKey]
|
||||
, dbProcs :: [(Text,Text)]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
type Schema = Text
|
||||
|
||||
Reference in New Issue
Block a user