diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index a702752e3..4785f17b5 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -50,8 +50,8 @@ import PostgREST.PgStructure import Prelude -app :: [Table] -> [Relation] -> [Column] -> [PrimaryKey] -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response -app allTables allRelations allColumns allPrimaryKeys conf reqBody req = +app :: DbStructure -> AppConfig -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response +app dbstructure conf reqBody role req = case (path, verb) of -- ([], _) -> do -- body <- encode <$> tables (cs schema) @@ -65,7 +65,7 @@ app allTables allRelations allColumns allPrimaryKeys conf reqBody req = -- $ encode (TableOptions cols pkey) ([], _) -> do - let body = encode $ filter (((cs schema)==).tableSchema) allTables + let body = encode $ filter (filterTableAcl allTablesAcl role) $ filter (((cs schema)==).tableSchema) allTables return $ responseLBS status200 [jsonH, ("Custom", "header")] $ cs body ([table], "OPTIONS") -> do @@ -257,8 +257,16 @@ app allTables allRelations allColumns allPrimaryKeys conf reqBody req = return $ responseLBS status404 [] "" where + allTables = tables dbstructure + allRelations = relations dbstructure + allColumns = columns dbstructure + allPrimaryKeys = primaryKeys dbstructure + allTablesAcl = tablesAcl dbstructure filterCol schema table (Column{colSchema=s, colTable=t}) = s==schema && table==t filterPk schema table (PrimaryKey{pkSchema=s, pkTable=t}) = s==schema && table==t + + filterTableAcl :: [(Text, Text, Text)] -> Text -> Table -> Bool + filterTableAcl acl r (Table{tableSchema=s, tableName=n}) = isJust $ find (\(as,an,ar)->as==s && an==n && ar==r) acl path = pathInfo req verb = requestMethod req qq = queryString req diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index 83842ae4b..86b6a5252 100644 --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -99,10 +99,21 @@ main = do pkRes <- H.session pool $ H.tx txParam $ allprimaryKeys let allPrimaryKeys = either (fail . show) id pkRes - runSettings appSettings $ middle $ \req respond -> do + tableAclRes <- H.session pool $ H.tx txParam $ alltablesAcl + let allTablesAcl = either (fail . show) id tableAclRes + + + let dbstructure = DbStructure { + tables=allTables, + columns=allColumns, + relations=allRelations, + primaryKeys=allPrimaryKeys, + tablesAcl=allTablesAcl} + + runSettings appSettings $ middle $ \ req respond -> do body <- strictRequestBody req resOrError <- liftIO $ H.session pool $ H.tx (Just (H.ReadCommitted, Just True)) $ - authenticated conf (app allTables allRelations allColumns allPrimaryKeys conf body) req + authenticated conf (app dbstructure conf body) req either (respond . errResponse) respond resOrError where diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index 8fa775f25..e29fabda2 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -26,11 +26,12 @@ import PostgREST.Config (AppConfig(..), corsPolicy) import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, setUserId) import PostgREST.App (contentTypeForAccept) import Codec.Binary.Base64.String (decode) +import PostgREST.Auth (DbRole) 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 +40,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 +63,7 @@ authenticated conf app req = do runInRole r uid = do setUserId uid setRole r - app req + app r req redirectInsecure :: Application -> Application diff --git a/src/PostgREST/PgStructure.hs b/src/PostgREST/PgStructure.hs index dc0e52de9..d98c7d429 100644 --- a/src/PostgREST/PgStructure.hs +++ b/src/PostgREST/PgStructure.hs @@ -311,3 +311,17 @@ allprimaryKeys = do AND kc.table_schema NOT IN ('pg_catalog', 'information_schema') |] return $ map pkFromRow pks + +alltablesAcl :: H.Tx P.Postgres s [(Text, Text, Text)] +alltablesAcl = do + acl <- H.listEx $ [H.stmt| + SELECT + table_schema, + table_name, + grantee as role + FROM information_schema.role_table_grants + WHERE + table_schema NOT IN ('pg_catalog', 'information_schema') AND + privilege_type = 'SELECT' + |] + return acl diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index e1ad82f6f..0c218b394 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -1,6 +1,14 @@ module PostgREST.Types where import Data.Text +data DbStructure = DbStructure { + tables :: [Table] +, columns :: [Column] +, relations :: [Relation] +, primaryKeys :: [PrimaryKey] +, tablesAcl :: [(Text, Text, Text)] +} + data Table = Table { tableSchema :: Text , tableName :: Text diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 6fbfee02f..f1281c602 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -31,6 +31,7 @@ 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 @@ -68,11 +69,22 @@ withApp perform = do pkRes <- H.session pool $ H.tx txParam $ allprimaryKeys let allPrimaryKeys = either (fail . show) id pkRes + tableAclRes <- H.session pool $ H.tx txParam $ alltablesAcl + let allTablesAcl = either (fail . show) id tableAclRes + + + let dbstructure = DbStructure { + tables=allTables, + columns=allColumns, + relations=allRelations, + primaryKeys=allPrimaryKeys, + tablesAcl=allTablesAcl} + perform $ middle $ \req resp -> do body <- strictRequestBody req result <- liftIO $ H.session pool $ H.tx (Just (H.ReadCommitted, Just True)) - $ authenticated cfg (app allTables allRelations allColumns allPrimaryKeys cfg body) req + $ authenticated cfg (app dbstructure cfg body) req either (resp . errResponse) resp result where middle = defaultMiddle False