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

Merge pull request #295 from ruslantalpa/master

Browse Source 
Extend the capabilities of PostgREST #280
This commit is contained in:
Joe Nelson
2015-10-04 09:42:32 -07:00
parent 7d8523a786 b675276f31
commit 0f1b313d96
17 changed files with 1248 additions and 472 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
+16
View File
@@ -52,6 +52,9 @@ executable postgrest
, mtl
, cassava
, jwt
, parsec
, errors
, bifunctors
hs-source-dirs: src
library
@@ -87,7 +90,14 @@ library
, mtl
, cassava
, jwt
, parsec
, errors
, bifunctors
Exposed-Modules: PostgREST.App
, PostgREST.Types
, PostgREST.Parsers
, PostgREST.QueryBuilder
, PostgREST.Auth
, PostgREST.Config
, PostgREST.Error
@@ -108,6 +118,9 @@ Test-Suite spec
ghc-options: -Wall -W -O2
Main-Is: Main.hs
Other-Modules: PostgREST.App
, PostgREST.Types
, PostgREST.Parsers
, PostgREST.QueryBuilder
, PostgREST.Auth
, PostgREST.Config
, PostgREST.Error
@@ -147,3 +160,6 @@ Test-Suite spec
, process
, heredoc
, jwt
, parsec
, errors
, bifunctors
src/PostgREST/App.hs
+137 -88
View File
@@ -1,98 +1,137 @@
{-# LANGUAGE FlexibleContexts #-}
module PostgREST.App (app, sqlError, isSqlError, contentTypeForAccept) where
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module PostgREST.App (
app
, sqlError
, isSqlError
, contentTypeForAccept
, jsonH
, requestedSchema
, TableOptions(..)
) where
import Control.Monad (join)
import Control.Arrow ((***), second)
import Control.Applicative
import qualified Blaze.ByteString.Builder as BB
import Control.Applicative
import Control.Arrow (second, (***))
import Control.Monad (join)
import Data.Bifunctor (first)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BL
import Data.CaseInsensitive (original)
import qualified Data.Csv as CSV
import Data.Functor.Identity
import qualified Data.HashMap.Strict as M
import Data.List (find, sortBy)
import Data.Maybe (fromMaybe, isJust, isNothing,
mapMaybe)
import Data.Ord (comparing)
import Data.Ranged.Ranges (emptyRange)
import qualified Data.Set as S
import Data.String.Conversions (cs)
import Data.Text (Text, replace, strip)
import Text.Regex.TDFA ((=~))
import Data.Text (Text)
import Data.Maybe (fromMaybe, mapMaybe, isJust, isNothing)
import Text.Regex.TDFA ((=~))
import Data.Ord (comparing)
import Data.Ranged.Ranges (emptyRange)
import qualified Data.HashMap.Strict as M
import Data.String.Conversions (cs)
import Data.CaseInsensitive (original)
import Data.List (sortBy, find)
import Data.Functor.Identity
import qualified Data.Set as S
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BS
import qualified Blaze.ByteString.Builder as BB
import qualified Data.Csv as CSV
import Text.Parsec.Error
import Network.HTTP.Types.Status
import Network.HTTP.Types.Header
import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.HTTP.Base (urlEncodeVars)
import Network.Wai
import Network.Wai.Parse (parseHttpAccept)
import Network.Wai.Internal (Response(..))
import Network.HTTP.Base (urlEncodeVars)
import Network.HTTP.Types.Header
import Network.HTTP.Types.Status
import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.Wai
import Network.Wai.Internal (Response (..))
import Network.Wai.Parse (parseHttpAccept)
import Data.Aeson
import Data.Monoid
import qualified Data.Vector as V
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import Data.Aeson
import Data.Monoid
import qualified Data.Vector as V
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import PostgREST.Config (AppConfig(..))
import PostgREST.Auth
import PostgREST.PgQuery
import PostgREST.RangeQuery
import PostgREST.PgStructure
import PostgREST.Auth
import PostgREST.Config (AppConfig (..))
import PostgREST.Parsers
import PostgREST.PgQuery
import PostgREST.PgStructure
import PostgREST.QueryBuilder
import PostgREST.RangeQuery
import PostgREST.Types
import Prelude
import Prelude
app :: AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
app conf reqBody req =
app :: DbStructure -> AppConfig -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
app dbstructure conf reqBody dbrole req =
case (path, verb) of
([], _) -> do
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
let qt = qualify table
cols <- columns qt
pkey <- map cs <$> primaryKeyColumns qt
return $ responseLBS status200 [jsonH, allOrigins]
$ encode (TableOptions cols pkey)
let cols = filter (filterCol schema table) allCols
pkeys = map pkName $ filter (filterPk schema table) allPrKeys
body = encode (TableOptions cols pkeys)
return $ responseLBS status200 [jsonH, allOrigins] $ cs body
([table], "GET") ->
if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error"
else do
let qt = qualify table
from = fromMaybe 0 $ rangeOffset <$> range
count = if hasPrefer "count=none"
else
case queries of
Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e
Right (qs, cqs) -> do
let qt = qualify table
count = if hasPrefer "count=none"
then countNone
else whereT qt qq $ countRows qt
query = B.Stmt "select " V.empty True <>
parentheticT count <> commaq <> (
bodyForAccept contentType qt
. limitT range
. orderT (orderParse qq)
. whereT qt qq
$ select qt qq
)
row <- H.maybeEx query
let (tableTotal, queryTotal, body) =
fromMaybe (Just 0, 0, Just "" :: Maybe Text) row
to = from+queryTotal-1
contentRange = contentRangeH from to tableTotal
status = rangeStatus from to tableTotal
canonical = urlEncodeVars
. sortBy (comparing fst)
. map (join (***) cs)
. parseSimpleQuery
$ rawQueryString req
return $ responseLBS status
[contentTypeH, contentRange,
("Content-Location",
"/" <> cs table <>
if Prelude.null canonical then "" else "?" <> cs canonical
)
] (cs $ fromMaybe "[]" body)
else cqs
q = B.Stmt "select " V.empty True <>
parentheticT count
<> commaq <> (
bodyForAccept contentType qt -- TODO! when in csv mode, the first row (columns) is not correct when requesting sub tables
. limitT range
$ qs
)
row <- H.maybeEx q
let (tableTotal, queryTotal, body) = fromMaybe (Just (0::Int), 0::Int, Just "" :: Maybe Text) row
to = from+queryTotal-1
contentRange = contentRangeH from to tableTotal
status = rangeStatus from to tableTotal
canonical = urlEncodeVars
. sortBy (comparing fst)
. map (join (***) cs)
. parseSimpleQuery
$ rawQueryString req
return $ responseLBS status
[contentTypeH, contentRange,
("Content-Location",
"/" <> cs table <>
if Prelude.null canonical then "" else "?" <> cs canonical
)
] (cs $ fromMaybe "[]" body)
where
from = fromMaybe 0 $ rangeOffset <$> range
apiRequest = first formatParserError (parseGetRequest req)
>>= first formatRelationError . addRelations schema allRels Nothing
>>= addJoinConditions schema allCols
where
formatRelationError :: Text -> Text
formatRelationError e = cs $ encode $ object [
"mesage" .= ("could not find foreign keys between these entities"::String),
"details" .= e]
formatParserError :: ParseError -> Text
formatParserError e = cs $ encode $ object [
"message" .= message,
"details" .= details]
where
message = show (errorPos e)
details = strip $ replace "\n" " " $ cs
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
query = requestToQuery schema <$> apiRequest
countQuery = requestToCountQuery schema <$> apiRequest
queries = (,) <$> query <*> countQuery
(["postgrest", "users"], "POST") -> do
let user = decode reqBody :: Maybe AuthUser
@@ -148,12 +187,12 @@ app conf reqBody req =
Right toBeInserted -> do
rows :: [Identity Text] <- H.listEx $ uncurry (insertInto qt) toBeInserted
let inserted :: [Object] = mapMaybe (decode . cs . runIdentity) rows
primaryKeys <- primaryKeyColumns qt
let responses = flip map inserted $ \obj -> do
pKeys = map pkName $ filter (filterPk schema table) allPrKeys
responses = flip map inserted $ \obj -> do
let primaries =
if Prelude.null primaryKeys
if Prelude.null pKeys
then obj
else M.filterWithKey (const . (`elem` primaryKeys)) obj
else M.filterWithKey (const . (`elem` pKeys)) obj
let params = urlEncodeVars
$ map (\t -> (cs $ fst t, cs (paramFilter $ snd t)))
$ sortBy (comparing fst) $ M.toList primaries
@@ -182,14 +221,14 @@ app conf reqBody req =
([table], "PUT") ->
handleJsonObj reqBody $ \obj -> do
let qt = qualify table
primaryKeys <- primaryKeyColumns qt
let specifiedKeys = map (cs . fst) qq
if S.fromList primaryKeys /= S.fromList specifiedKeys
pKeys = map pkName $ filter (filterPk schema table) allPrKeys
specifiedKeys = map (cs . fst) qq
if S.fromList pKeys /= S.fromList specifiedKeys
then return $ responseLBS status405 []
"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
let tableCols = map (cs . colName) $ filter (filterCol schema table) allCols
cols = map cs $ M.keys obj
if S.fromList tableCols == S.fromList cols
then do
let vals = M.elems obj
@@ -239,6 +278,16 @@ app 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
@@ -358,7 +407,7 @@ multipart s rs =
data TableOptions = TableOptions {
tblOptcolumns :: [Column]
, tblOptpkey :: [Text]
, tblOptpkey :: [Text]
}
instance ToJSON TableOptions where
src/PostgREST/Auth.hs
+17 -19
View File
@@ -1,27 +1,25 @@
{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
module PostgREST.Auth where
import Data.Aeson
import Control.Monad (mzero)
import Control.Applicative
import Crypto.BCrypt
import Data.Text
import Data.Monoid
import Data.Map
import qualified Data.Vector as V
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import qualified Web.JWT as JWT
import Data.String.Conversions (cs)
import PostgREST.PgQuery (pgFmtLit)
import Control.Applicative
import Control.Monad (mzero)
import Crypto.BCrypt
import Data.Aeson
import Data.Map
import Data.Monoid
import Data.String.Conversions (cs)
import Data.Text
import qualified Data.Vector as V
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import PostgREST.PgQuery (pgFmtLit)
import Prelude
import qualified Web.JWT as JWT
import Prelude
import System.IO.Unsafe
import System.IO.Unsafe
data AuthUser = AuthUser {
userId :: String
userId :: String
, userPass :: String
, userRole :: String
} deriving (Show)
src/PostgREST/Config.hs
+21 -20
View File
@@ -1,27 +1,28 @@
module PostgREST.Config where
import Network.Wai
import Control.Applicative
import Data.Text (strip)
import qualified Data.CaseInsensitive as CI
import qualified Data.ByteString.Char8 as BS
import Data.String.Conversions (cs)
import Options.Applicative hiding (columns)
import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
import Prelude
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import Data.String.Conversions (cs)
import Data.Text (strip)
import Network.Wai
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
import Options.Applicative hiding (columns)
import Prelude
data AppConfig = AppConfig {
configDbName :: String
, configDbPort :: Int
, configDbUser :: String
, configDbPass :: String
, configDbHost :: String
configDbName :: String
, configDbPort :: Int
, configDbUser :: String
, configDbPass :: String
, configDbHost :: String
, configPort :: Int
, configAnonRole :: String
, configSecure :: Bool
, configPool :: Int
, configV1Schema :: String
, configPort :: Int
, configAnonRole :: String
, configSecure :: Bool
, configPool :: Int
, configV1Schema :: String
, configJwtSecret :: String
}
@@ -31,7 +32,7 @@ argParser = AppConfig
<$> strOption (long "db-name" <> short 'd' <> metavar "NAME" <> help "name of database")
<*> option auto (long "db-port" <> short 'P' <> metavar "PORT" <> value 5432 <> help "postgres server port" <> showDefault)
<*> strOption (long "db-user" <> short 'U' <> metavar "ROLE" <> help "postgres authenticator role")
<*> strOption (long "db-pass" <> metavar "PASS" <> value "" <> help "password for authenticator role")
<*> strOption (long "db-pass" <> metavar "PASS" <> help "password for authenticator role")
<*> strOption (long "db-host" <> metavar "HOST" <> value "localhost" <> help "postgres server hostname" <> showDefault)
<*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "port number on which to run HTTP server" <> showDefault)
src/PostgREST/Error.hs
+12 -10
View File
@@ -1,18 +1,20 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
module PostgREST.Error (PgError, errResponse) where
import qualified Hasql as H
import qualified Hasql.Postgres as P
import Data.Aeson ((.=))
import qualified Data.Aeson as JSON
import Data.String.Conversions (cs)
import Data.String.Utils (replace)
import qualified Data.Text as T
import qualified Hasql as H
import qualified Hasql.Postgres as P
import Network.HTTP.Types.Header
import qualified Network.HTTP.Types.Status as HT
import qualified Data.Aeson as JSON
import qualified Data.Text as T
import Data.Aeson ((.=))
import Data.String.Conversions (cs)
import Data.String.Utils(replace)
import Network.Wai(Response, responseLBS)
import Network.HTTP.Types.Header
import Network.Wai (Response, responseLBS)
type PgError = H.SessionError P.Postgres
src/PostgREST/Main.hs
+51 -26
View File
@@ -1,33 +1,39 @@
{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
module Main where
import Paths_postgrest (version)
import PostgREST.App
import PostgREST.Middleware
import PostgREST.Error(errResponse)
import Paths_postgrest (version)
import PostgREST.PgStructure
import PostgREST.Types
import Network.Wai
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.String.Conversions (cs)
import Network.Wai (strictRequestBody)
import Network.Wai.Handler.Warp hiding (Connection)
import Network.Wai.Middleware.RequestLogger (logStdout)
import Data.List (intercalate)
import Data.Version (versionBranch)
import Data.Functor.Identity
import Data.Text(Text)
import qualified Hasql as H
import qualified Hasql.Postgres as P
import Options.Applicative hiding (columns)
import PostgREST.App
import PostgREST.Error (errResponse)
import PostgREST.Middleware
import System.IO (stderr, stdin, stdout, hSetBuffering, BufferMode(..))
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Functor.Identity
import Data.List (intercalate)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Version (versionBranch)
import qualified Hasql as H
import qualified Hasql.Postgres as P
import Network.Wai.Handler.Warp hiding (Connection)
import Network.Wai.Middleware.RequestLogger (logStdout)
import Options.Applicative hiding (columns)
import PostgREST.Config (AppConfig(..), argParser)
import System.IO (BufferMode (..),
hSetBuffering, stderr,
stdin, stdout)
import PostgREST.Config (AppConfig (..),
argParser)
isServerVersionSupported :: H.Session P.Postgres IO Bool
isServerVersionSupported = do
Identity (row :: Text) <- H.tx Nothing $ H.singleEx $ [H.stmt|SHOW server_version_num|]
return $ read (cs row) >= 90200
return $ read (cs row) >= (90200::Integer)
main :: IO ()
main = do
@@ -67,17 +73,36 @@ main = do
H.poolSettings (fromIntegral $ configPool conf) 30
pool :: H.Pool P.Postgres <- H.acquirePool pgSettings poolSettings
resOrError <- H.session pool isServerVersionSupported
supportedOrError <- 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
) supportedOrError
runSettings appSettings $ middle $ \req respond -> 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)
dbstructure <- case metadata of
Left e -> fail $ show e
Right (tabs, rels, cols, keys) ->
return DbStructure {
tables=tabs
, columns=cols
, relations=rels
, primaryKeys=keys
}
runSettings appSettings $ middle $ \ req respond -> do
body <- strictRequestBody req
resOrError <- liftIO $ H.session pool $ H.tx (Just (H.ReadCommitted, Just True)) $
authenticated conf (app conf body) req
resOrError <- liftIO $ H.session pool $ H.tx txSettings $
authenticated conf (app dbstructure conf body) req
either (respond . errResponse) respond resOrError
where
src/PostgREST/Middleware.hs
+30 -26
View File
@@ -3,34 +3,38 @@
module PostgREST.Middleware where
import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid
import Data.Text
-- import Data.Pool(withResource, Pool)
import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid
import Data.Text
import Data.String.Conversions (cs)
import qualified Hasql as H
import qualified Hasql.Postgres as P
import qualified Hasql as H
import qualified Hasql.Postgres as P
import Data.String.Conversions(cs)
import Network.HTTP.Types (RequestHeaders)
import Network.HTTP.Types.Header (hAccept, hAuthorization,
hLocation)
import Network.HTTP.Types.Status (status301, status400, status401,
status415)
import Network.URI (URI (..), parseURI)
import Network.Wai (Application, Request (..),
Response, isSecure, rawPathInfo,
rawQueryString, requestHeaders,
responseLBS)
import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Middleware.Gzip (def, gzip)
import Network.Wai.Middleware.Static (only, staticPolicy)
import Network.HTTP.Types.Header (hLocation, hAuthorization, hAccept)
import Network.HTTP.Types (RequestHeaders)
import Network.HTTP.Types.Status (status400, status401, status301, status415)
import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
rawQueryString, isSecure, Request(..), Response)
import Network.Wai.Middleware.Gzip (gzip, def)
import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Middleware.Static (staticPolicy, only)
import Network.URI (URI(..), parseURI)
import Codec.Binary.Base64.String (decode)
import PostgREST.App (contentTypeForAccept)
import PostgREST.Auth (DbRole, LoginAttempt (..),
setRole, setUserId, signInRole,
signInWithJWT)
import PostgREST.Config (AppConfig (..), corsPolicy)
import PostgREST.Config (AppConfig(..), corsPolicy)
import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, setUserId)
import PostgREST.App (contentTypeForAccept)
import Codec.Binary.Base64.String (decode)
import Prelude
import Prelude
authenticated :: forall s. AppConfig ->
(Request -> H.Tx P.Postgres s Response) ->
(DbRole -> Request -> H.Tx P.Postgres s Response) ->
Request -> H.Tx P.Postgres s Response
authenticated conf app req = do
attempt <- httpRequesterRole (requestHeaders req)
@@ -39,8 +43,8 @@ authenticated conf app req = do
return $ responseLBS status400 [] "Malformed basic auth header"
LoginFailed ->
return $ responseLBS status401 [] "Invalid username or password"
LoginSuccess role uid -> if role /= currentRole then runInRole role uid else app req
NoCredentials -> if anon /= currentRole then runInRole anon "" else app req
LoginSuccess role uid -> if role /= currentRole then runInRole role uid else app currentRole req
NoCredentials -> if anon /= currentRole then runInRole anon "" else app currentRole req
where
jwtSecret = cs $ configJwtSecret conf
@@ -62,7 +66,7 @@ authenticated conf app req = do
runInRole r uid = do
setUserId uid
setRole r
app req
app r req
redirectInsecure :: Application -> Application
src/PostgREST/Parsers.hs
+159
View File
@@ -0,0 +1,159 @@
module PostgREST.Parsers
( parseGetRequest
)
where
import Control.Applicative hiding ((<$>))
--lines needed for ghc 7.8
import Data.Functor ((<$>))
import Data.Traversable (traverse)
import Control.Monad (join)
import Data.List (delete, find)
import Data.Maybe
import Data.Monoid
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Tree
import Network.Wai (Request, pathInfo, queryString)
import PostgREST.Types
import Text.ParserCombinators.Parsec hiding (many, (<|>))
parseGetRequest :: Request -> Either ParseError ApiRequest
parseGetRequest httpRequest =
foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
where
apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr
addOrder (Node r f) o = Node r{order=o} f
flts = mapM pRequestFilter whereFilters
rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
orderStr = join $ lookup "order" qString
ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr
selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
pRequestSelect :: Text -> Parser ApiRequest
pRequestSelect rootNodeName = do
fieldTree <- pFieldForest
return $ foldr treeEntry (Node (Select rootNodeName [] [] [] Nothing Nothing) []) fieldTree
where
treeEntry :: Tree SelectItem -> ApiRequest -> ApiRequest
treeEntry (Node fld@((fn, _),_) fldForest) (Node rNode rForest) =
case fldForest of
[] -> Node (rNode {fields=fld:fields rNode}) rForest
_ -> Node rNode (foldr treeEntry (Node (Select fn [] [] [] Nothing Nothing) []) fldForest:rForest)
pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
where
treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k
opVal = parse pOpValueExp ("failed to parse filter (" ++ v ++ ")") v
path = fst <$> treePath
fld = snd <$> treePath
op = fst <$> opVal
val = snd <$> opVal
addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest
addFilter ([], flt) (Node rn@(Select {filters=flts}) forest) = Node (rn {filters=flt:flts}) forest
addFilter (path, flt) (Node rn forest) =
case targetNode of
Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
Just tn -> Node rn (addFilter (remainingPath, flt) tn:restForest)
where
targetNodeName:remainingPath = path
(targetNode,restForest) = splitForest targetNodeName forest
splitForest name forst =
case maybeNode of
Nothing -> (Nothing,forest)
Just node -> (Just node, delete node forest)
where maybeNode = find ((name==).mainTable.rootLabel) forst
ws :: Parser Text
ws = cs <$> many (oneOf " \t")
lexeme :: Parser a -> Parser a
lexeme p = ws *> p <* ws
pTreePath :: Parser (Path,Field)
pTreePath = do
p <- pFieldName `sepBy1` pDelimiter
jp <- optionMaybe ( string "->" >> pJsonPath)
let pp = map cs p
jpp = map cs <$> jp
return (init pp, (last pp, jpp))
where
pFieldForest :: Parser [Tree SelectItem]
pFieldForest = pFieldTree `sepBy1` lexeme (char ',')
pFieldTree :: Parser (Tree SelectItem)
pFieldTree = try (Node <$> pSelect <*> ( char '(' *> pFieldForest <* char ')'))
<|> 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_])")
pJsonPathDelimiter :: Parser Text
pJsonPathDelimiter = cs <$> (try (string "->>") <|> string "->")
pJsonPath :: Parser [Text]
pJsonPath = pFieldName `sepBy1` pJsonPathDelimiter
pField :: Parser Field
pField = lexeme $ (,) <$> pFieldName <*> optionMaybe ( pJsonPathDelimiter *> pJsonPath)
pSelect :: Parser SelectItem
pSelect = lexeme $
try ((,) <$> pField <*>((cs <$>) <$> optionMaybe (string "::" *> many letter)) )
<|> do
s <- pStar
return ((s, Nothing), Nothing)
pOperator :: Parser Operator
pOperator = cs <$> ( try (string "lte") -- has to be before lt
<|> try (string "lt")
<|> try (string "eq")
<|> try (string "gte") -- has to be before gh
<|> try (string "gt")
<|> try (string "lt")
<|> try (string "neq")
<|> try (string "like")
<|> try (string "ilike")
<|> try (string "in")
<|> try (string "notin")
<|> try (string "is" )
<|> try (string "isnot")
<|> try (string "@@")
<?> "operator (eq, gt, ...)"
)
pValue :: Parser FValue
pValue = VText <$> (cs <$> many anyChar)
pDelimiter :: Parser Char
pDelimiter = char '.' <?> "delimiter (.)"
pOperatiorWithNegation :: Parser Operator
pOperatiorWithNegation = try ( (<>) <$> ( cs <$> string "not." ) <*> pOperator) <|> pOperator
pOpValueExp :: Parser (Operator, FValue)
pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)
pOrder :: Parser [OrderTerm]
pOrder = lexeme pOrderTerm `sepBy` char ','
pOrderTerm :: Parser OrderTerm
pOrderTerm =
try ( do
c <- pFieldName
_ <- pDelimiter
d <- string "asc" <|> string "desc"
nls <- optionMaybe (pDelimiter *> ( try(string "nullslast" *> pure ("nulls last"::String)) <|> try(string "nullsfirst" *> pure ("nulls first"::String))))
return $ OrderTerm (cs c) (cs d) (cs <$> nls)
)
<|> OrderTerm <$> (cs <$> pFieldName) <*> pure "asc" <*> pure Nothing
src/PostgREST/PgQuery.hs
+61 -104
View File
@@ -1,31 +1,35 @@
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiWayIf #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PostgREST.PgQuery where
import PostgREST.RangeQuery
import qualified Hasql as H
import qualified Hasql.Postgres as P
import qualified Hasql.Backend as B
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import PostgREST.RangeQuery
import PostgREST.Types (OrderTerm (..))
import qualified Data.Text as T
import qualified Data.HashMap.Strict as H
import Text.Regex.TDFA ( (=~) )
import qualified Network.HTTP.Types.URI as Net
import qualified Data.ByteString.Char8 as BS
import Data.Monoid
import Data.Vector (empty)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Functor
import Control.Monad (join)
import Data.String.Conversions (cs)
import qualified Data.Aeson as JSON
import qualified Data.List as L
import qualified Data.Vector as V
import Data.Scientific (isInteger, formatScientific, FPFormat(..))
import Control.Monad (join)
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import Data.Functor
import qualified Data.HashMap.Strict as H
import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Scientific (FPFormat (..), formatScientific,
isInteger)
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 ((=~))
import Prelude
import Prelude
type PStmt = H.Stmt P.Postgres
instance Monoid PStmt where
@@ -39,11 +43,6 @@ data QualifiedIdentifier = QualifiedIdentifier {
, qiName :: T.Text
} deriving (Show)
data OrderTerm = OrderTerm {
otTerm :: T.Text
, otDirection :: BS.ByteString
, otNullOrder :: Maybe BS.ByteString
}
limitT :: Maybe NonnegRange -> StatementT
limitT r q =
@@ -131,36 +130,6 @@ 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" }
selectStar :: QualifiedIdentifier -> PStmt
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
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 _ = ""
returningStarT :: StatementT
returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
@@ -225,57 +194,45 @@ wherePred table (col, predicate) =
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"])
sqlValue = pgFmtValue opCode value
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
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
op = case opCode of
"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 =
mapMaybe orderParseTerm . T.split (==',') $ cs order
where
order = fromMaybe "" $ join (lookup "order" 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
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
src/PostgREST/PgStructure.hs
+207 -165
View File
@@ -1,126 +1,24 @@
{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
MultiParamTypeClasses, ScopedTypeVariables,
FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module PostgREST.PgStructure where
import PostgREST.PgQuery (QualifiedIdentifier(..))
import Data.Text hiding (foldl, map, zipWith, concat)
import Data.Aeson
import Data.Functor.Identity
import Data.String.Conversions (cs)
import Data.Maybe (fromMaybe, isJust)
import Control.Applicative
import Control.Applicative
import Data.Functor.Identity
import Data.List (find)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Monoid
import Data.Text (Text, split)
import qualified Hasql as H
import qualified Hasql.Postgres as P
import PostgREST.PgQuery ()
import PostgREST.Types
import qualified Data.Map as Map
import GHC.Exts (groupWith)
import Prelude
import qualified Hasql as H
import qualified Hasql.Postgres as P
import Prelude
foreignKeys :: QualifiedIdentifier -> H.Tx P.Postgres s (Map.Map Text ForeignKey)
foreignKeys table = do
r <- H.listEx $ [H.stmt|
select kcu.column_name, ccu.table_name AS foreign_table_name,
ccu.column_name AS foreign_column_name
from information_schema.table_constraints AS tc
join information_schema.key_column_usage AS kcu
on tc.constraint_name = kcu.constraint_name
join information_schema.constraint_column_usage AS ccu
on ccu.constraint_name = tc.constraint_name
where constraint_type = 'FOREIGN KEY'
and tc.table_name=? and tc.table_schema = ?
order by kcu.column_name
|] (qiName table) (qiSchema table)
return $ foldl addKey Map.empty r
where
addKey :: Map.Map Text ForeignKey -> (Text, Text, Text) -> Map.Map Text ForeignKey
addKey m (col, ftab, fcol) = Map.insert col (ForeignKey ftab fcol) m
tables :: Text -> H.Tx P.Postgres s [Table]
tables schema = do
rows <- H.listEx $
[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
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)
order by position |]
(qiSchema table) (qiName table)
fks <- foreignKeys table
return $ map (addFK fks . columnFromRow) cols
where
addFK fks col = col { colFK = Map.lookup (cs . colName $ col) fks }
primaryKeyColumns :: QualifiedIdentifier -> H.Tx P.Postgres s [Text]
primaryKeyColumns table = do
r <- H.listEx $ [H.stmt|
select kc.column_name
from
information_schema.table_constraints tc,
information_schema.key_column_usage kc
where
tc.constraint_type = 'PRIMARY KEY'
and kc.table_name = tc.table_name and kc.table_schema = tc.table_schema
and kc.constraint_name = tc.constraint_name
and kc.table_schema = ?
and kc.table_name = ? |] (qiSchema table) (qiName table)
return $ map runIdentity r
doesProcExist :: Text -> Text -> H.Tx P.Postgres s Bool
doesProcExist schema proc = do
@@ -134,33 +32,12 @@ doesProcExist schema proc = do
|] schema proc
return $ isJust row
data Table = Table {
tableSchema :: Text
, tableName :: Text
, tableInsertable :: Bool
} deriving (Show)
data ForeignKey = ForeignKey {
fkTable::Text, fkCol::Text
} deriving (Eq, Show)
data Column = Column {
colSchema :: Text
, colTable :: Text
, colName :: Text
, colPosition :: Int
, colNullable :: Bool
, colType :: Text
, colUpdatable :: Bool
, colMaxLen :: Maybe Int
, colPrecision :: Maybe Int
, colDefault :: Maybe Text
, colEnum :: [Text]
, colFK :: Maybe ForeignKey
} deriving (Show)
tableFromRow :: (Text, Text, Bool) -> Table
tableFromRow (s, n, i) = Table s n i
tableFromRow :: (Text, Text, Bool, Maybe Text) -> Table
tableFromRow (s, n, i, a) = Table s n i (parseAcl a)
where
parseAcl :: Maybe Text -> [Text]
parseAcl str = fromMaybe [] $ split (==',') <$> str
columnFromRow :: (Text, Text, Text,
Int, Bool, Text,
@@ -175,25 +52,190 @@ columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
parseEnum str = fromMaybe [] $ split (==',') <$> str
instance ToJSON Column where
toJSON c = object [
"schema" .= colSchema c
, "name" .= colName c
, "position" .= colPosition c
, "nullable" .= colNullable c
, "type" .= colType c
, "updatable" .= colUpdatable c
, "maxLen" .= colMaxLen c
, "precision" .= colPrecision c
, "references".= colFK c
, "default" .= colDefault c
, "enum" .= colEnum c ]
relationFromRow :: (Text, Text, Text, Text, Text) -> Relation
relationFromRow (s, t, c, ft, fc) = Relation s t c ft fc Child Nothing Nothing Nothing
instance ToJSON ForeignKey where
toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
pkFromRow :: (Text, Text, Text) -> PrimaryKey
pkFromRow (s, t, n) = PrimaryKey s t n
instance ToJSON Table where
toJSON v = object [
"schema" .= tableSchema v
, "name" .= tableName v
, "insertable" .= tableInsertable v ]
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 = do
rows <- H.listEx $ [H.stmt|
SELECT
n.nspname AS table_schema,
c.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,
array_to_string(array_agg(r.rolname), ',') AS acl
FROM pg_class c
CROSS JOIN pg_roles r
JOIN pg_namespace n ON n.oid = c.relnamespace
WHERE c.relkind IN ('v','r','m')
AND n.nspname NOT IN ('pg_catalog', 'information_schema')
AND (
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_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
allRelations :: H.Tx P.Postgres s [Relation]
allRelations = do
rels <- H.listEx $ [H.stmt|
WITH table_fk AS (
SELECT
tc.table_schema, tc.table_name, kcu.column_name,
ccu.table_name AS foreign_table_name,
ccu.column_name AS foreign_column_name
FROM information_schema.table_constraints AS tc
JOIN information_schema.key_column_usage AS kcu on tc.constraint_name = kcu.constraint_name
JOIN information_schema.constraint_column_usage AS ccu on ccu.constraint_name = tc.constraint_name
WHERE constraint_type = 'FOREIGN KEY'
AND tc.table_schema NOT IN ('pg_catalog', 'information_schema')
ORDER BY tc.table_schema, tc.table_name, kcu.column_name
)
SELECT * FROM table_fk
UNION
(
SELECT
vcu.table_schema, vcu.view_name AS table_name, vcu.column_name,
table_fk.foreign_table_name,
table_fk.foreign_column_name
FROM information_schema.view_column_usage as vcu
JOIN table_fk ON
table_fk.table_schema = vcu.view_schema AND
table_fk.table_name = vcu.table_name AND
table_fk.column_name = vcu.column_name
WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
ORDER BY vcu.table_schema, vcu.view_name, vcu.column_name
)
UNION
(
SELECT
vcu.view_schema as table_schema,
table_fk.table_name,
table_fk.column_name,
vcu.view_name as foreign_table_name,
vcu.column_name as foreign_column_name
FROM information_schema.view_column_usage as vcu
JOIN table_fk ON
table_fk.table_schema = vcu.view_schema AND
table_fk.foreign_table_name = vcu.table_name AND
table_fk.foreign_column_name = vcu.column_name
WHERE vcu.view_schema NOT IN ('pg_catalog', 'information_schema')
ORDER BY vcu.table_schema, vcu.view_name, vcu.column_name
)
|]
let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
let links = filter ((==2).length) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
return $ simpleRelations ++ mapMaybe link2Relation links
where
groupFn :: Relation -> Text
groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
link2Relation [
Relation{relSchema=sc, relTable=lt, relColumn=lc1, relFTable=t, relFColumn=c},
Relation{ relColumn=lc2, relFTable=ft, relFColumn=fc}
] = Just $ Relation sc t c ft fc Many (Just lt) (Just lc1) (Just lc2)
link2Relation _ = Nothing
allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
allColumns rels = 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 NOT IN ('pg_catalog', 'information_schema')
) 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 schema, position
|]
return $ map (addFK . columnFromRow) cols
where
addFK col = col { colFK = relToFk <$> find (lookupFn col) rels }
lookupFn :: Column -> Relation -> Bool
lookupFn (Column{colSchema=cs, colTable=ct, colName=cn}) (Relation{relSchema=rs, relTable=rt, relColumn=rc, relType=rty}) =
cs==rs && ct==rt && cn==rc && rty==Child
lookupFn _ _ = False
relToFk (Relation{relFTable=t, relFColumn=c}) = ForeignKey t c
allPrimaryKeys :: H.Tx P.Postgres s [PrimaryKey]
allPrimaryKeys = do
pks <- H.listEx $ [H.stmt|
WITH table_pk AS (
SELECT
kc.table_schema,
kc.table_name,
kc.column_name
FROM
information_schema.table_constraints tc,
information_schema.key_column_usage kc
WHERE
tc.constraint_type = 'PRIMARY KEY' AND
kc.table_name = tc.table_name AND
kc.table_schema = tc.table_schema AND
kc.constraint_name = tc.constraint_name AND
kc.table_schema NOT IN ('pg_catalog', 'information_schema')
)
SELECT table_schema,
table_name,
column_name
FROM table_pk
UNION (
SELECT
vcu.view_schema,
vcu.view_name,
vcu.column_name
FROM information_schema.view_column_usage AS vcu
JOIN
table_pk ON table_pk.table_schema = vcu.view_schema AND
table_pk.table_name = vcu.table_name AND
table_pk.column_name = vcu.column_name
WHERE vcu.view_schema NOT IN ('pg_catalog','information_schema')
)
|]
return $ map pkFromRow pks
src/PostgREST/QueryBuilder.hs
+164
View File
@@ -0,0 +1,164 @@
module PostgREST.QueryBuilder
where
import Control.Error
import Data.List (find)
import Data.Monoid
import Data.Text hiding (filter, find, foldr, head, last, map,
null)
import Control.Applicative
import Data.Tree
import PostgREST.PgQuery (PStmt, QualifiedIdentifier (..), fromQi,
orderT, pgFmtIdent, pgFmtLit, pgFmtOperator,
pgFmtValue, whiteList)
import PostgREST.Types
import qualified Data.Vector as V (empty)
import qualified Hasql.Backend as B
findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation
findRelation allRelations s t1 t2 =
find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations
addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
addRelations schema allRelations parentNode node@(Node query@(Select {mainTable=table}) forest) =
case parentNode of
Nothing -> Node query{relation=Nothing} <$> updatedForest
(Just (Node (Select{mainTable=parentTable}) _)) -> Node <$> (addRel query <$> rel) <*> updatedForest
where
rel = note ("no relation between " <> table <> " and " <> parentTable)
$ findRelation allRelations schema table parentTable
<|> findRelation allRelations schema parentTable table
addRel :: Query -> Relation -> Query
addRel q r = q{relation = Just r}
where
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
addJoinConditions :: Text -> [Column] -> ApiRequest -> Either Text ApiRequest
addJoinConditions schema allColumns (Node query@(Select{relation=r}) forest) =
case r of
Nothing -> Node updatedQuery <$> updatedForest -- this is the root node
Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel)) <$> updatedForest
Just (Relation{relType=Parent}) -> Node updatedQuery <$> updatedForest
Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
Node <$> pure qq <*> updatedForest
where
q = addCond updatedQuery (getJoinConditions rel)
qq = q{joinTables=linkTable:joinTables q}
_ -> Left "unknow relation"
where
-- add parentTable and parentJoinConditions to the query
updatedQuery = foldr (flip addCond) (query{joinTables = parentTables ++ joinTables query}) parentJoinConditions
where
parentJoinConditions = map (getJoinConditions.snd) parents
parentTables = map fst parents
parents = mapMaybe (getParents.rootLabel) forest
getParents qq@(Select{relation=(Just rel@(Relation{relType=Parent}))}) = Just (mainTable qq, rel)
getParents _ = Nothing
updatedForest = mapM (addJoinConditions schema allColumns) forest
getJoinConditions :: Relation -> [Filter]
getJoinConditions rel@(Relation _ _ c _ _ Child _ _ _) = [Filter (c, Nothing) "=" (VForeignKey rel)]
getJoinConditions rel@(Relation _ _ c _ _ Parent _ _ _) = [Filter (c, Nothing) "=" (VForeignKey rel)]
getJoinConditions (Relation s t c ft fc Many (Just lt) (Just lc1) (Just lc2)) =
[
Filter (c, Nothing) "=" (VForeignKey (Relation s t c lt lc1 Child Nothing Nothing Nothing)),
Filter (fc, Nothing) "=" (VForeignKey (Relation s ft fc lt lc2 Child Nothing Nothing Nothing))
]
getJoinConditions _ = []
addCond q con = q{filters=con ++ filters q}
requestToCountQuery :: Text -> ApiRequest -> PStmt
requestToCountQuery schema (Node (Select mainTbl _ _ conditions _ _) _) =
B.Stmt query V.empty True
where
query = Data.Text.unwords [
"SELECT pg_catalog.count(1)",
"FROM ", fromQi $ QualifiedIdentifier schema mainTbl,
("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
]
emptyOnNull val x = if null x then "" else val
localConditions = filter fn conditions
where
fn (Filter{value=VText _}) = True
fn (Filter{value=VForeignKey _}) = False
requestToQuery :: Text -> ApiRequest -> PStmt
requestToQuery schema (Node (Select mainTbl colSelects tbls conditions ord _) forest) =
orderT (fromMaybe [] ord) query
where
query = B.Stmt qStr V.empty True
qStr = Data.Text.unwords [
("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
"SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects),
"FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) (mainTbl:tbls)),
("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions
]
emptyOnNull val x = if null x then "" else val
(withs, selects) = foldr getQueryParts ([],[]) forest
getQueryParts :: Tree Query -> ([Text], [Text]) -> ([Text], [Text])
getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Child}))}) forst) (w,s) = (w,sel:s)
where
sel = "("
<> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
<> "FROM (" <> subquery <> ") " <> table
<> ") AS " <> table
where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation{relType=Parent}))}) forst) (w,s) = (wit:w,sel:s)
where
sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular
wit = table <> " AS ( " <> subquery <> " )"
where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
getQueryParts (Node q@(Select{mainTable=table, relation=(Just (Relation {relType=Many}))}) forst) (w,s) = (w,sel:s)
where
sel = "("
<> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) "
<> "FROM (" <> subquery <> ") " <> table
<> ") AS " <> table
where (B.Stmt subquery _ _) = requestToQuery schema (Node q forst)
-- the following is just to remove the warning
--getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
--posible relations are Child Parent Many
getQueryParts (Node (Select{relation=Nothing}) _) _ = undefined
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 (Relation s t c _ _ _ _ _ _) -> pgFmtColumn (QualifiedIdentifier s t) c
sqlValue = valToStr val
getInner v = case v of
VText s -> s
_ -> ""
valToStr v = case v of
VText s -> pgFmtValue opCode s
VForeignKey (Relation{relSchema=s, relFTable=ft, relFColumn=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
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
pgFmtSelectItem table ((c, jp), Nothing) = pgFmtColumn table c <> pgFmtJsonPath jp <> asJsonPath jp
pgFmtSelectItem table ((c, jp), Just cast ) = "CAST (" <> pgFmtColumn table c <> pgFmtJsonPath jp <> " AS " <> cast <> " )" <> asJsonPath jp
asJsonPath :: Maybe JsonPath -> Text
asJsonPath Nothing = ""
asJsonPath (Just xx) = " AS " <> last xx
src/PostgREST/RangeQuery.hs
+11 -10
View File
@@ -6,21 +6,22 @@ module PostgREST.RangeQuery (
, NonnegRange
) where
import Control.Applicative
import Network.HTTP.Types.Header
import qualified Data.ByteString.Char8 as BS
import Control.Applicative
import Network.HTTP.Types.Header
import PostgREST.Types ()
import Data.Ranged.Boundaries
import Data.Ranged.Ranges
import qualified Data.ByteString.Char8 as BS
import Data.Ranged.Boundaries
import Data.Ranged.Ranges
import Data.String.Conversions (cs)
import Text.Regex.TDFA ((=~))
import Text.Read (readMaybe)
import Data.String.Conversions (cs)
import Text.Read (readMaybe)
import Text.Regex.TDFA ((=~))
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Maybe (fromMaybe, listToMaybe)
import Prelude
import Prelude
type NonnegRange = Range Int
src/PostgREST/Types.hs
+107
View File
@@ -0,0 +1,107 @@
module PostgREST.Types where
import Data.Text
import Data.Tree
import qualified Data.ByteString.Char8 as BS
import Data.Aeson
data DbStructure = DbStructure {
tables :: [Table]
, columns :: [Column]
, relations :: [Relation]
, primaryKeys :: [PrimaryKey]
}
data Table = Table {
tableSchema :: Text
, tableName :: Text
, tableInsertable :: Bool
, tableAcl :: [Text]
} deriving (Show)
data ForeignKey = ForeignKey {
fkTable::Text, fkCol::Text
} deriving (Show)
data Column = Column {
colSchema :: Text
, colTable :: Text
, colName :: Text
, colPosition :: Int
, colNullable :: Bool
, colType :: Text
, colUpdatable :: Bool
, colMaxLen :: Maybe Int
, colPrecision :: Maybe Int
, colDefault :: Maybe Text
, colEnum :: [Text]
, colFK :: Maybe ForeignKey
} | Star {colSchema :: Text, colTable :: Text } deriving (Show)
data PrimaryKey = PrimaryKey {
pkSchema::Text, pkTable::Text, pkName::Text
}
data OrderTerm = OrderTerm {
otTerm :: Text
, otDirection :: BS.ByteString
, otNullOrder :: Maybe BS.ByteString
} deriving (Show, Eq)
data RelationType = Child | Parent | Many deriving (Show, Eq)
data Relation = Relation {
relSchema :: Text
, relTable :: Text
, relColumn :: Text
, relFTable :: Text
, relFColumn :: Text
, relType :: RelationType
, relLTable :: Maybe Text
, relLCol1 :: Maybe Text
, relLCol2 :: Maybe Text
} deriving (Show, Eq)
type Operator = Text
data FValue = VText Text | VForeignKey Relation deriving (Show, Eq)
type FieldName = Text
type JsonPath = [Text]
type Field = (FieldName, Maybe JsonPath)
type Cast = Text
type SelectItem = (Field, Maybe Cast)
type Path = [Text]
data Query = Select {
mainTable::Text
, fields::[SelectItem]
, joinTables::[Text]
, filters::[Filter]
, order::Maybe [OrderTerm]
, relation::Maybe Relation
} deriving (Show, Eq)
data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
type ApiRequest = Tree Query
instance ToJSON Column where
toJSON c = object [
"schema" .= colSchema c
, "name" .= colName c
, "position" .= colPosition c
, "nullable" .= colNullable c
, "type" .= colType c
, "updatable" .= colUpdatable c
, "maxLen" .= colMaxLen c
, "precision" .= colPrecision c
, "references".= colFK c
, "default" .= colDefault c
, "enum" .= colEnum c ]
instance ToJSON ForeignKey where
toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
instance ToJSON Table where
toJSON v = object [
"schema" .= tableSchema v
, "name" .= tableName v
, "insertable" .= tableInsertable v ]
test/Feature/QuerySpec.hs
+27 -2
View File
@@ -1,6 +1,6 @@
module Feature.QuerySpec where
import Test.Hspec
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
@@ -130,6 +130,10 @@ spec =
get "/items?always_true=eq.true" `shouldRespondWith`
[json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]
it "matches filtering nested items" $
get "/clients?select=id,projects(id,tasks(id,name))&projects.tasks.name=like.Design*" `shouldRespondWith`
"[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1,\"name\":\"Design w7\"}]},{\"id\":2,\"tasks\":[{\"id\":3,\"name\":\"Design w10\"}]}]},{\"id\":2,\"projects\":[{\"id\":3,\"tasks\":[{\"id\":5,\"name\":\"Design IOS\"}]},{\"id\":4,\"tasks\":[{\"id\":7,\"name\":\"Design OSX\"}]}]}]"
describe "Shaping response with select parameter" $ do
it "selectStar works in absense of parameter" $
@@ -178,6 +182,27 @@ spec =
get "/complex_items?id=eq.1&select=settings->foo->>int::integer" `shouldRespondWith`
[json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now
it "requesting parents and children" $
get "/projects?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
"[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}]"
it "requesting children 2 levels" $
get "/clients?id=eq.1&select=id,projects(id,tasks(id))" `shouldRespondWith`
"[{\"id\":1,\"projects\":[{\"id\":1,\"tasks\":[{\"id\":1},{\"id\":2}]},{\"id\":2,\"tasks\":[{\"id\":3},{\"id\":4}]}]}]"
it "requesting many<->many relation" $
get "/tasks?select=id,users(id)" `shouldRespondWith`
"[{\"id\":1,\"users\":[{\"id\":1},{\"id\":3}]},{\"id\":2,\"users\":[{\"id\":1}]},{\"id\":3,\"users\":[{\"id\":1}]},{\"id\":4,\"users\":[{\"id\":1}]},{\"id\":5,\"users\":[{\"id\":2},{\"id\":3}]},{\"id\":6,\"users\":[{\"id\":2}]},{\"id\":7,\"users\":[{\"id\":2}]},{\"id\":8,\"users\":null}]"
it "requesting parents and children on views" $
get "/projects_view?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith`
"[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}]"
it "requesting children with composite key" $ do
pendingWith "have to resolve issue #302"
get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments(content)" `shouldRespondWith`
[json| [{"user_id":2,"task_id":6,"comments":[{"content": "Needs to be delivered ASAP"}]}] |]
describe "ordering response" $ do
it "by a column asc" $
@@ -226,7 +251,7 @@ spec =
}
it "without other constraints" $
get "/items?order=asc.id" `shouldRespondWith` 200
get "/items?order=id.asc" `shouldRespondWith` 200
describe "Accept headers" $ do
it "should respond an unknown accept type with 415" $
test/Feature/StructureSpec.hs
+104
View File
@@ -15,6 +15,8 @@ spec = around withApp $ do
request methodGet "/" [] ""
`shouldRespondWith` [json| [
{"schema":"1","name":"auto_incrementing_pk","insertable":true}
, {"schema":"1","name":"clients","insertable":true}
, {"schema":"1","name":"comments","insertable":true}
, {"schema":"1","name":"complex_items","insertable":true}
, {"schema":"1","name":"compound_pk","insertable":true}
, {"schema":"1","name":"has_count_column","insertable":false}
@@ -26,8 +28,14 @@ spec = around withApp $ do
, {"schema":"1","name":"menagerie","insertable":true}
, {"schema":"1","name":"no_pk","insertable":true}
, {"schema":"1","name":"nullable_integer","insertable":true}
, {"schema":"1","name":"projects","insertable":true}
, {"schema":"1","name":"projects_view","insertable":true}
, {"schema":"1","name":"simple_pk","insertable":true}
, {"schema":"1","name":"tasks","insertable":true}
, {"schema":"1","name":"tsearch","insertable":true}
, {"schema":"1","name":"users","insertable":true}
, {"schema":"1","name":"users_projects","insertable":true}
, {"schema":"1","name":"users_tasks","insertable":true}
] |]
{matchStatus = 200}
@@ -145,6 +153,102 @@ spec = around withApp $ do
}
|]
it "it includes primary and foreign keys for views" $
request methodOptions "/insertable_view_with_join" [] "" `shouldRespondWith`
[json|
{
"pkey":[
"id"
],
"columns":[
{
"references":null,
"default":null,
"precision":64,
"updatable":false,
"schema":"1",
"name":"id",
"type":"bigint",
"maxLen":null,
"enum":[],
"nullable":true,
"position":1
},
{
"references":{
"column":"id",
"table":"auto_incrementing_pk"
},
"default":null,
"precision":32,
"updatable":false,
"schema":"1",
"name":"auto_inc_fk",
"type":"integer",
"maxLen":null,
"enum":[],
"nullable":true,
"position":2
},
{
"references":{
"column":"k",
"table":"simple_pk"
},
"default":null,
"precision":null,
"updatable":false,
"schema":"1",
"name":"simple_fk",
"type":"character varying",
"maxLen":255,
"enum":[],
"nullable":true,
"position":3
},
{
"references":null,
"default":null,
"precision":null,
"updatable":false,
"schema":"1",
"name":"nullable_string",
"type":"character varying",
"maxLen":null,
"enum":[],
"nullable":true,
"position":4
},
{
"references":null,
"default":null,
"precision":null,
"updatable":false,
"schema":"1",
"name":"non_nullable_string",
"type":"character varying",
"maxLen":null,
"enum":[],
"nullable":true,
"position":5
},
{
"references":null,
"default":null,
"precision":null,
"updatable":false,
"schema":"1",
"name":"inserted_at",
"type":"timestamp with time zone",
"maxLen":null,
"enum":[],
"nullable":true,
"position":6
}
]
}
|]
it "includes foreign key data" $ do
pendingWith "have to resolve issue #107"
test/SpecHelper.hs
+22 -2
View File
@@ -30,6 +30,8 @@ import PostgREST.App (app)
import PostgREST.Config (AppConfig(..))
import PostgREST.Middleware
import PostgREST.Error(errResponse)
import PostgREST.PgStructure
import PostgREST.Types
isLeft :: Either a b -> Bool
isLeft (Left _ ) = True
@@ -53,10 +55,28 @@ withApp perform = do
pool :: H.Pool P.Postgres
<- H.acquirePool pgSettings testPoolOpts
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)
dbstructure <- case metadata of
Left e -> fail $ show e
Right (tabs, rels, cols, keys) ->
return $ DbStructure {
tables=tabs
, columns=cols
, relations=rels
, primaryKeys=keys
}
perform $ middle $ \req resp -> do
body <- strictRequestBody req
result <- liftIO $ H.session pool $ H.tx (Just (H.ReadCommitted, Just True))
$ authenticated cfg (app cfg body) req
result <- liftIO $ H.session pool $ H.tx txSettings
$ authenticated cfg (app dbstructure cfg body) req
either (resp . errResponse) resp result
where middle = defaultMiddle False
test/fixtures/schema.sql
Vendored
+102
View File
@@ -210,6 +210,73 @@ CREATE TABLE complex_items (
ALTER TABLE "1".complex_items OWNER TO postgrest_test;
--- Structure for testing table relations
CREATE TABLE clients(
id INT PRIMARY KEY NOT NULL,
name TEXT NOT NULL
);
ALTER TABLE "1".clients OWNER TO postgrest_test;
CREATE TABLE projects(
id INT PRIMARY KEY NOT NULL,
name TEXT NOT NULL,
client_id INT REFERENCES clients(id)
);
ALTER TABLE "1".projects OWNER TO postgrest_test;
CREATE TABLE tasks(
id INT PRIMARY KEY NOT NULL,
name TEXT NOT NULL,
project_id INT REFERENCES projects(id)
);
ALTER TABLE "1".tasks OWNER TO postgrest_test;
CREATE TABLE users(
id INT PRIMARY KEY NOT NULL,
name TEXT NOT NULL
);
ALTER TABLE "1".users OWNER TO postgrest_test;
CREATE TABLE users_tasks(
user_id INT REFERENCES users(id),
task_id INT REFERENCES tasks(id),
CONSTRAINT task_user PRIMARY KEY (task_id,user_id)
);
ALTER TABLE "1".users_tasks OWNER TO postgrest_test;
CREATE TABLE comments(
id INT PRIMARY KEY NOT NULL,
commenter_id INT NOT NULL REFERENCES users(id),
user_id INT NOT NULL,
task_id INT NOT NULL,
content TEXT NOT NULL,
FOREIGN KEY (task_id,user_id) REFERENCES users_tasks (task_id,user_id)
);
ALTER TABLE "1".comments OWNER TO postgrest_test;
CREATE TABLE users_projects(
user_id INT REFERENCES users(id),
project_id INT REFERENCES projects(id),
CONSTRAINT project_user PRIMARY KEY (project_id, user_id)
);
ALTER TABLE "1".users_projects OWNER TO postgrest_test;
CREATE VIEW "1".projects_view AS
SELECT
projects.id,
projects.name,
projects.client_id
FROM projects;
ALTER TABLE "1".projects_view OWNER TO postgrest_test;
------- SAMPLE DATA -----
INSERT INTO clients VALUES (1, 'Microsoft'),(2, 'Apple');
INSERT INTO projects VALUES (1,'Windows 7', 1),(2,'Windows 10', 1),(3,'IOS', 2),(4,'OSX', 2);
INSERT INTO tasks VALUES (1,'Design w7',1),(2,'Code w7',1),(3,'Design w10',2),(4,'Code w10',2),(5,'Design IOS',3),(6,'Code IOS',3),(7,'Design OSX',4),(8,'Code OSX',4);
INSERT INTO users VALUES (1, 'Angela Martin'),(2, 'Michael Scott'),(3, 'Dwight Schrute');
INSERT INTO users_projects VALUES(1,1),(1,2),(2,3),(2,4),(3,1),(3,3);
INSERT INTO users_tasks VALUES(1,1),(1,2),(1,3),(1,4),(2,5),(2,6),(2,7),(3,1),(3,5);
INSERT INTO comments VALUES (1, 1, 2, 6, 'Needs to be delivered ASAP');
----------------
CREATE SEQUENCE items_id_seq
START WITH 1
@@ -555,6 +622,41 @@ REVOKE ALL ON TABLE complex_items FROM postgrest_test;
GRANT ALL ON TABLE complex_items TO postgrest_test;
GRANT ALL ON TABLE complex_items TO postgrest_anonymous;
---------
REVOKE ALL ON TABLE clients FROM PUBLIC;
REVOKE ALL ON TABLE clients FROM postgrest_test;
GRANT ALL ON TABLE clients TO postgrest_test;
GRANT ALL ON TABLE clients TO postgrest_anonymous;
REVOKE ALL ON TABLE projects FROM PUBLIC;
REVOKE ALL ON TABLE projects FROM postgrest_test;
GRANT ALL ON TABLE projects TO postgrest_test;
GRANT ALL ON TABLE projects TO postgrest_anonymous;
REVOKE ALL ON TABLE tasks FROM PUBLIC;
REVOKE ALL ON TABLE tasks FROM postgrest_test;
GRANT ALL ON TABLE tasks TO postgrest_test;
GRANT ALL ON TABLE tasks TO postgrest_anonymous;
REVOKE ALL ON TABLE users FROM PUBLIC;
REVOKE ALL ON TABLE users FROM postgrest_test;
GRANT ALL ON TABLE users TO postgrest_test;
GRANT ALL ON TABLE users TO postgrest_anonymous;
REVOKE ALL ON TABLE users_tasks FROM PUBLIC;
REVOKE ALL ON TABLE users_tasks FROM postgrest_test;
GRANT ALL ON TABLE users_tasks TO postgrest_test;
GRANT ALL ON TABLE users_tasks TO postgrest_anonymous;
REVOKE ALL ON TABLE comments FROM PUBLIC;
REVOKE ALL ON TABLE comments FROM postgrest_test;
GRANT ALL ON TABLE comments TO postgrest_test;
GRANT ALL ON TABLE comments TO postgrest_anonymous;
REVOKE ALL ON TABLE users_projects FROM PUBLIC;
REVOKE ALL ON TABLE users_projects FROM postgrest_test;
GRANT ALL ON TABLE users_projects TO postgrest_test;
GRANT ALL ON TABLE users_projects TO postgrest_anonymous;
REVOKE ALL ON TABLE projects_view FROM PUBLIC;
REVOKE ALL ON TABLE projects_view FROM postgrest_test;
GRANT ALL ON TABLE projects_view TO postgrest_test;
GRANT ALL ON TABLE projects_view TO postgrest_anonymous;
---------
REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM PUBLIC;
REVOKE ALL ON FUNCTION getitemrange(bigint, bigint) FROM postgrest_test;