Merge pull request #342 from ruslantalpa/v3

Refactoring & 	Revert to the old way of displaying the list of tables

debian/postgrest.default

@@ -7,17 +7,26 @@
 # database host
 #POSTGREST_DBHOST=localhost
 
+# database host
+#POSTGREST_DBPORT=5432
+
 # database to use
-#POSTGREST_DBNAME=
+#POSTGREST_DBNAME=app
 
 # database user
-#POSTGREST_DBUSER=postgres
+#POSTGREST_DBUSER=authenticator
 
 # database password
 #POSTGREST_DBPASS=
 
 # database pool
-#POSTGREST_DBPOOL=10
+#POSTGREST_POOL=10
 
-# additional options
+# jwt secret
-#POSTGREST_OPTS=
+#POSTGREST_JWT_SECRET=secret
+
+# default schema
+#POSTGREST_SCHEMA=public
+
+# secure (use 1 to enable, empty string to disable)
+#POSTGREST_SECURE=

debian/postgrest.init.d

@@ -13,31 +13,52 @@ if test -f /etc/default/postgrest; then
     . /etc/default/postgrest
 fi
 POSTGREST=/usr/local/bin/postgrest
+CONNECTION_STRING="postgres://"
+POSTGREST_OPTS=""
 POSTGREST_USER=${POSTGREST_USER:-postgrest}
-POSTGREST_DBNAME=${POSTGREST_DBNAME:-postgres}
+POSTGREST_PORT=${POSTGREST_PORT:-3000}
-POSTGREST_DBUSER=${POSTGREST_DBUSER:-postgres}
+POSTGREST_DBUSER=${POSTGREST_DBUSER:-authenticator}
-if [ -n "$POSTGREST_DBHOST" ]; then
+#POSTGREST_DBPASS=${POSTGREST_DBPASS:-authenticator}
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-host $POSTGREST_DBHOST"
+POSTGREST_DBHOST=${POSTGREST_DBHOST:-localhost}
-fi
+POSTGREST_DBPORT=${POSTGREST_DBPORT:-5432}
-if [ -n "$POSTGREST_DBNAME" ]; then
+POSTGREST_DBNAME=${POSTGREST_DBNAME:-app}
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-name $POSTGREST_DBNAME"
+POSTGREST_DBPOOL=${POSTGREST_DBPOOL:-10}
-fi
+POSTGREST_ANON=${POSTGREST_ANON:-anonymous}
-if [ -n "$POSTGREST_DBUSER" ]; then
+POSTGREST_JWT_SECRET=${POSTGREST_JWT_SECRET:-secret}
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-user $POSTGREST_DBUSER"
+POSTGREST_SCHEMA=${POSTGREST_SCHEMA:-public}
-	POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_DBUSER"
+
-fi
+CONNECTION_STRING="$CONNECTION_STRING$POSTGREST_DBUSER"
 if [ -n "$POSTGREST_DBPASS" ]; then
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-pass $POSTGREST_DBPASS"
+	CONNECTION_STRING="$CONNECTION_STRING:$POSTGREST_DBPASS"
 fi
-if [ -n "$POSTGREST_DBPOOL" ]; then
+CONNECTION_STRING="$CONNECTION_STRING@$POSTGREST_DBHOST:$POSTGREST_DBPORT/$POSTGREST_DBNAME"
-	POSTGREST_OPTS="$POSTGREST_OPTS --db-pool $POSTGREST_DBPOOL"
+
+if [ -n "$POSTGREST_PORT" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --port $POSTGREST_PORT"
 fi
-POSTGREST_OPTS="$POSTGREST_OPTS --schema public"
+
+if [ -n "$POSTGREST_POOL" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --pool $POSTGREST_POOL"
+fi
+if [ -n "$POSTGREST_JWT_SECRET" ]; then
+	#export POSTGREST_JWT_SECRET="$POSTGREST_JWT_SECRET"
+	POSTGREST_OPTS="$POSTGREST_OPTS --jwt-secret $POSTGREST_JWT_SECRET"
+fi
+if [ -n "$POSTGREST_SCHEMA" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --schema $POSTGREST_SCHEMA"
+fi
+if [ -n "$POSTGREST_ANON" ]; then
+	POSTGREST_OPTS="$POSTGREST_OPTS --anonymous $POSTGREST_ANON"
+fi
+
+#export CONNECTION_STRING="$CONNECTION_STRING"
+
+START_PARAMS="$CONNECTION_STRING $POSTGREST_OPTS"
 
 start()
 {
 	log_daemon_msg "Starting PostgreSQL REST API daemon" "postgrest" || true
-	if start-stop-daemon --start --quiet --oknodo --chuid ${POSTGREST_USER} --startas /usr/local/bin/postgrest-wrapper --exec $POSTGREST -- $POSTGREST_OPTS; then
+	if start-stop-daemon --start --quiet --oknodo --chuid ${POSTGREST_USER} --startas /usr/local/bin/postgrest-wrapper --exec $POSTGREST -- $START_PARAMS; then
 		log_end_msg 0 || true
 	else
 		log_end_msg 1 || true

src/PostgREST/App.hs

@@ -83,13 +83,10 @@ app dbstructure conf reqBody req =
                     if Prelude.null canonical then "" else "?" <> cs canonical
                 )
               ] (fromMaybe "[]" body)
-
         where
             frm = fromMaybe 0 $ rangeOffset <$> range
-            request = parseRequest schema allRels table req reqBody
 
-    ([table], "POST") -> do
+    ([table], "POST") ->
-      let echoRequested = hasPrefer "return=representation"
       case request of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (selectQuery, mutateQuery, isSingle) -> do
@@ -103,12 +100,8 @@ app dbstructure conf reqBody req =
               (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location))
             ]
             $ if echoRequested then fromMaybe "[]" body else ""
-      where
-        request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
-        fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
 
-    ([table], "PATCH") -> do
+    ([_], "PATCH") ->
-      let echoRequested = hasPrefer "return=representation"
       case request of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (selectQuery, mutateQuery, _) -> do
@@ -122,11 +115,7 @@ app dbstructure conf reqBody req =
           return $ responseLBS s [contentTypeH, r]
             $ if echoRequested then fromMaybe "[]" body else ""
 
-      where
+    ([_], "DELETE") ->
-        request = parseRequest schema (fakeSourceRelations ++ allRels) table req reqBody
-        fakeSourceRelations = mapMaybe (toSourceRelation table) allRels
-
-    ([table], "DELETE") ->
       case request of
         Left e -> return $ responseLBS status400 [jsonH] $ cs e
         Right (selectQuery, mutateQuery, _) -> do
@@ -137,10 +126,6 @@ app dbstructure conf reqBody req =
             then responseLBS status404 [] ""
             else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] ""
 
-
-      where
-        request = parseRequest schema allRels table req reqBody
-
     (["rpc", proc], "POST") -> do
       let qi = QualifiedIdentifier schema (cs proc)
       exists <- doesProcExist schema proc
@@ -162,8 +147,7 @@ app dbstructure conf reqBody req =
       -- select * from public.proc(a := "foo"::undefined) where whereT limit limitT
 
     ([], _) -> do
-      Identity (dbrole :: Text) <- H.singleEx $ [H.stmt|SELECT current_user|]
+      body <- encode <$> tables (cs schema)
-      let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
       return $ responseLBS status200 [jsonH] $ cs body
 
     ([table], "OPTIONS") -> do
@@ -176,20 +160,14 @@ app dbstructure conf reqBody req =
       return $ responseLBS status404 [] ""
 
   where
-    allTabs = tables dbstructure
     allRels = relations dbstructure
     allCols = columns dbstructure
     allPrKeys = primaryKeys dbstructure
     filterCol sc table (Column{colSchema=s, colTable=t}) =  s==sc && table==t
     filterCol _ _ _ =  False
     filterPk sc table pk = sc == pkSchema pk && table == pkTable pk
-
-    filterTableAcl :: Text -> Table -> Bool
-    filterTableAcl r (Table{tableAcl=a}) = r `elem` a
     path          = pathInfo req
     verb          = requestMethod req
-    --qq            = queryString req
-    --qualify       = QualifiedIdentifier schema
     hdrs          = requestHeaders req
     lookupHeader  = flip lookup hdrs
     hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
@@ -201,6 +179,8 @@ app dbstructure conf reqBody req =
     contentType   = fromMaybe "application/json" $ contentTypeForAccept accept
     isCsv         = contentType == csvMT
     contentTypeH  = (hContentType, contentType)
+    echoRequested = hasPrefer "return=representation"
+    request = parseRequest schema allRels (head path) req reqBody --TODO! is head safe?
 
 rangeStatus :: Int -> Int -> Maybe Int -> Status
 rangeStatus _ _ Nothing = status200
@@ -390,7 +370,12 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
     allFilters = whereFilters qParams
     mutateFilters = filter (not . ( '.' `elem` ) . fst) allFilters -- update/delete filters can be only on the root table
     cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
-    selectApiRequest = augumentRequestWithJoin schema allRels
+    fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
+    rels = case method of
+      "POST"  -> fakeSourceRelations ++ allRels
+      "PATCH" -> fakeSourceRelations ++ allRels
+      _       -> allRels
+    selectApiRequest = augumentRequestWithJoin schema rels
       =<< buildSelectApiRequest rootName sel filters (orderStr qParams)
       where
         sel = if method == "DELETE"

src/PostgREST/Config.hs

@@ -54,7 +54,7 @@ argParser = AppConfig
 
 defaultCorsPolicy :: CorsResourcePolicy
 defaultCorsPolicy =  CorsResourcePolicy Nothing
-  ["GET", "POST", "PUT", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
+  ["GET", "POST", "PATCH", "DELETE", "OPTIONS"] ["Authorization"] Nothing
   (Just $ 60*60*24) False False True
 
 -- | CORS policy to be used in by Wai Cors middleware

src/PostgREST/Main.hs

@@ -79,19 +79,17 @@ main = do
 
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
-    tabs <- allTables
     rels <- allRelations
     cols <- allColumns rels
     keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
+    return (rels, cols, keys)
 
 
   dbstructure <- either hasqlError
-    (\(tabs, rels, cols, keys) ->
+    (\(rels, cols, keys) ->
 
       return DbStructure {
-          tables=tabs
+          columns=cols
-        , columns=cols
         , relations=rels
         , primaryKeys=keys
         }

src/PostgREST/Parsers.hs

@@ -34,7 +34,6 @@ pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
     op = fst <$> opVal
     val = snd <$> opVal
 
-
 ws :: Parser Text
 ws = cs <$> many (oneOf " \t")
 
@@ -45,23 +44,21 @@ pTreePath :: Parser (Path,Field)
 pTreePath = do
   p <- pFieldName `sepBy1` pDelimiter
   jp <- optionMaybe ( string "->" >>  pJsonPath)
-  let pp = map cs p
+  return (init p, (last p, jp))
-      jpp = map cs <$> jp
-  return (init pp, (last pp, jpp))
 
 pFieldForest :: Parser [Tree SelectItem]
 pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
 
 pFieldTree :: Parser (Tree SelectItem)
-pFieldTree = try (Node <$> pSelect <*> ( char '(' *> pFieldForest <* char ')'))
+pFieldTree = try (Node <$> pSelect <*> between (char '(') (char ')') pFieldForest)
-      <|>    Node <$> pSelect <*> pure []
+          <|>     Node <$> pSelect <*> pure []
 
 pStar :: Parser Text
 pStar = cs <$> (string "*" *> pure ("*"::String))
 
 pFieldName :: Parser Text
 pFieldName =  cs <$> (many1 (letter <|> digit <|> oneOf "_")
-      <?> "field name (* or [a..z0..9_])")
+          <?> "field name (* or [a..z0..9_])")
 
 pJsonPathDelimiter :: Parser Text
 pJsonPathDelimiter = cs <$> (try (string "->>") <|> string "->")

src/PostgREST/PgStructure.hs

@@ -48,11 +48,8 @@ doesProcReturnJWT = doesProc [H.stmt|
       AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
     |]
 
-tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
+tableFromRow :: (Text, Text, Bool) -> Table
-tableFromRow (s, n, i, a) = Table s n i (parseAcl a)
+tableFromRow (s, n, i) = Table s n i
-  where
-    parseAcl :: Maybe Text -> [Text]
-    parseAcl str = fromMaybe [] $ split (==',') <$> str
 
 columnFromRow :: (Text,       Text,      Text,
                   Int,        Bool,      Text,
@@ -77,34 +74,62 @@ pkFromRow (s, t, n) = PrimaryKey s t n
 addParentRelation :: Relation -> [Relation] -> [Relation]
 addParentRelation rel@(Relation s t c ft fc _ _ _ _) rels = Relation s ft fc t c Parent Nothing Nothing Nothing:rel:rels
 
-allTables :: H.Tx P.Postgres s [Table]
+-- allTables :: H.Tx P.Postgres s [Table]
-allTables = do
+-- allTables = do
-    rows <- H.listEx $ [H.stmt|
+--     rows <- H.listEx $ [H.stmt|
-      SELECT
+--       SELECT
-        n.nspname AS table_schema,
+--         n.nspname AS table_schema,
-        c.relname AS table_name,
+--         c.relname AS table_name,
-        c.relkind = 'r' OR (c.relkind IN ('v','f'))
+--         c.relkind = 'r' OR (c.relkind IN ('v','f'))
-        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+--         AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
-        OR (EXISTS
+--         OR (EXISTS
-          ( SELECT 1
+--           ( SELECT 1
-            FROM pg_trigger
+--             FROM pg_trigger
-            WHERE pg_trigger.tgrelid = c.oid
+--             WHERE pg_trigger.tgrelid = c.oid
-            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
+--             AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
-        array_to_string(array_agg(r.rolname), ',') AS acl
+--         array_to_string(array_agg(r.rolname), ',') AS acl
-      FROM pg_class c
+--       FROM pg_class c
-      CROSS JOIN pg_roles r
+--       CROSS JOIN pg_roles r
-      JOIN pg_namespace n ON n.oid = c.relnamespace
+--       JOIN pg_namespace n ON n.oid = c.relnamespace
-      WHERE c.relkind IN ('v','r','m')
+--       WHERE c.relkind IN ('v','r','m')
-        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+--         AND n.nspname NOT IN ('pg_catalog', 'information_schema')
-        AND (
+--         AND (
-          pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
+--           pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
-          has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
+--           has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
-          has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
+--           has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
+--
+--       GROUP BY table_schema, table_name, insertable
+--       ORDER BY table_schema, table_name
+--     |]
+--     return $ map tableFromRow rows
 
-      GROUP BY table_schema, table_name, insertable
+tables :: Text -> H.Tx P.Postgres s [Table]
-      ORDER BY table_schema, table_name
+tables schema = do
-    |]
+  rows <- H.listEx $
-    return $ map tableFromRow rows
+    [H.stmt|
+      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 (
+           select 1
+           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)
+        )
+      order by relname
+    |] schema
+  return $ map tableFromRow rows
 
 allRelations :: H.Tx P.Postgres s [Relation]
 allRelations = do

src/PostgREST/Types.hs

@@ -6,8 +6,7 @@ import Data.Aeson
 import Data.Map
 
 data DbStructure = DbStructure {
-  tables :: [Table]
+  columns :: [Column]
-, columns :: [Column]
 , relations :: [Relation]
 , primaryKeys :: [PrimaryKey]
 }
@@ -17,7 +16,6 @@ data Table = Table {
   tableSchema :: Text
 , tableName :: Text
 , tableInsertable :: Bool
-, tableAcl :: [Text]
 } deriving (Show)
 
 data ForeignKey = ForeignKey {

test/Feature/CorsSpec.hs

@@ -41,7 +41,7 @@ spec = around withApp $ describe "CORS" $ do
             "true"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Methods"
-            "GET, POST, PUT, PATCH, DELETE, OPTIONS, HEAD"
+            "GET, POST, PATCH, DELETE, OPTIONS, HEAD"
           respHeaders `shouldSatisfy` matchHeader
             "Access-Control-Allow-Headers"
             "Authentication, Foo, Bar, Accept, Accept-Language, Content-Language"

test/SpecHelper.hs

@@ -56,18 +56,16 @@ withApp perform = do
 
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
-    tabs <- allTables
     rels <- allRelations
     cols <- allColumns rels
     keys <- allPrimaryKeys
-    return (tabs, rels, cols, keys)
+    return (rels, cols, keys)
 
   dbstructure <- case metadata of
     Left e -> fail $ show e
-    Right (tabs, rels, cols, keys) ->
+    Right (rels, cols, keys) ->
       return DbStructure {
-          tables=tabs
+          columns=cols
-        , columns=cols
         , relations=rels
         , primaryKeys=keys
         }