diff --git a/postgrest.cabal b/postgrest.cabal --- a/postgrest.cabal +++ b/postgrest.cabal @@ -2,7 +2,7 @@ description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security permits. -version: 0.3.0.1 +version: 0.3.0.2 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE @@ -30,37 +30,40 @@ main-is: PostgREST/Main.hs default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes default-language: Haskell2010 - build-depends: base >= 4.8 && < 5 - , postgrest + build-depends: aeson >= 0.8 + , base >= 4.8 && < 5 + , bytestring + , case-insensitive + , cassava + , containers + , errors , hasql >= 0.7.3 && < 0.8 , hasql-backend >= 0.4.1 && < 0.5 , hasql-postgres >= 0.10.4 && < 0.11 - , warp >= 3.0.2, wai >= 3.0.1 - , wai-extra, wai-cors - , wai-middleware-static >= 0.6.0 - , HTTP, convertible, http-types - , case-insensitive - , scientific, time - , aeson >= 0.8, network >= 2.6 - , aeson-pretty >= 0.7 && < 0.8 - , bytestring, text, split, string-conversions - , stringsearch - , containers, unordered-containers - , optparse-applicative >= 0.11 && < 0.13 - , regex-base, regex-tdfa - , Ranged-sets - , transformers, MissingH - , bcrypt >= 0.0.6, base64-string - , network-uri >= 2.6 - , resource-pool - , blaze-builder - , vector - , mtl - , cassava , jwt + , optparse-applicative >= 0.11 && < 0.13 , parsec - , errors - , bifunctors + , postgrest + , regex-tdfa + , safe >= 0.3 && < 0.4 + , scientific + , string-conversions + , text + , time + , transformers + , unordered-containers + , vector + , wai >= 3.0.1 + , wai-cors + , wai-extra + , wai-middleware-static >= 0.6.0 + , warp >= 3.0.2 + , HTTP, http-types + , MissingH + , Ranged-sets + if !os(windows) + build-depends: unix >= 2.7 && < 3 + hs-source-dirs: src other-modules: Paths_postgrest , PostgREST.App @@ -83,48 +86,35 @@ default-language: Haskell2010 default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes - build-depends: HTTP - , MissingH - , Ranged-sets - , aeson + build-depends: aeson , base >=4.6 && <5 - , base64-string - , bcrypt - , bifunctors - , blaze-builder , bytestring , case-insensitive , cassava , containers - , convertible , errors , hasql , hasql-backend , hasql-postgres , http-types , jwt - , mtl - , network - , network-uri , optparse-applicative , parsec - , regex-base , regex-tdfa - , resource-pool + , safe , scientific - , split , string-conversions - , stringsearch , text , time - , transformers , unordered-containers , vector , wai , wai-cors , wai-extra , wai-middleware-static - , warp + , HTTP + , MissingH + , Ranged-sets Other-Modules: Paths_postgrest Exposed-Modules: PostgREST.App @@ -169,39 +159,42 @@ , PostgREST.RangeQuery , PostgREST.ApiRequest , PostgREST.Types - , Spec , SpecHelper , TestTypes - Build-Depends: base, hspec == 2.2.*, QuickCheck - , hspec-wai, hspec-wai-json - , hasql, hasql-backend - , hasql-postgres - , warp, wai - , packdeps, hlint - , HTTP, convertible + Build-Depends: aeson + , base + , base64-string + , bytestring , case-insensitive - , wai-extra, wai-cors, containers - , wai-middleware-static - , http-types, scientific, time - , bytestring, aeson, network - , text, optparse-applicative - , stringsearch - , unordered-containers - , regex-base - , string-conversions - , http-media, regex-tdfa - , Ranged-sets - , transformers, MissingH, split - , bcrypt, base64-string - , network-uri - , resource-pool - , blaze-builder - , vector - , mtl , cassava - , process + , containers + , errors + , hasql + , hasql-backend + , hasql-postgres , heredoc + , hlint + , hspec == 2.2.* + , hspec-wai + , hspec-wai-json + , http-types , jwt + , optparse-applicative + , packdeps , parsec - , errors - , bifunctors + , process + , regex-tdfa + , safe + , scientific + , string-conversions + , text + , time + , unordered-containers + , vector + , wai + , wai-cors + , wai-extra + , wai-middleware-static + , HTTP + , MissingH + , Ranged-sets diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -20,7 +20,7 @@ import PostgREST.Types (QualifiedIdentifier (..), Schema, Payload(..), UniformObjects(..)) -import Data.Ranged.Ranges (singletonRange) +import Data.Ranged.Ranges (singletonRange) type RequestBody = BL.ByteString @@ -33,6 +33,8 @@ data Target = TargetIdent QualifiedIdentifier | TargetRoot | TargetUnknown [T.Text] +-- | How to return the inserted data +data PreferRepresentation = Full | HeadersOnly | None deriving Eq -- | Enumeration of currently supported content types for -- route responses and upload payloads data ContentType = ApplicationJSON | TextCSV deriving Eq @@ -51,7 +53,7 @@ -- | Set to Nothing for unknown HTTP verbs iAction :: Action -- | Set to Nothing for malformed range - , iRange :: Maybe NonnegRange + , iRange :: NonnegRange -- | Set to Nothing for strangely nested urls , iTarget :: Target -- | The content type the client most desires (or JSON if undecided) @@ -59,7 +61,7 @@ -- | Data sent by client and used for mutation actions , iPayload :: Maybe Payload -- | If client wants created items echoed back - , iPreferRepresentation :: Bool + , iPreferRepresentation :: PreferRepresentation -- | If client wants first row as raw object , iPreferSingular :: Bool -- | Whether the client wants a result count (slower) @@ -115,11 +117,11 @@ ApiRequest { iAction = action - , iRange = if singular then Just (singletonRange 0) else rangeRequested hdrs + , iRange = if singular then singletonRange 0 else rangeRequested hdrs , iTarget = target , iAccepts = pickContentType $ lookupHeader "accept" , iPayload = relevantPayload - , iPreferRepresentation = hasPrefer "return=representation" + , iPreferRepresentation = representation , iPreferSingular = singular , iPreferCount = not $ hasPrefer "count=none" , iFilters = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ] @@ -138,8 +140,10 @@ lookupHeader = flip lookup hdrs hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs singular = hasPrefer "plurality=singular" - - + representation + | hasPrefer "return=representation" = Full + | hasPrefer "return=minimal" = None + | otherwise = HeadersOnly -- PRIVATE --------------------------------------------------------------- diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -43,6 +43,7 @@ import PostgREST.RangeQuery import PostgREST.ApiRequest (ApiRequest(..), ContentType(..) , Action(..), Target(..) + , PreferRepresentation (..) , userApiRequest) import PostgREST.Types import PostgREST.Auth (tokenJWT) @@ -51,8 +52,9 @@ import PostgREST.QueryBuilder ( asJson , callProc , addJoinConditions - , sourceSubqueryName + , sourceCTEName , requestToQuery + , requestToCountQuery , addRelations , createReadStatement , createWriteStatement @@ -70,14 +72,14 @@ case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of (ActionRead, TargetIdent qi, Nothing) -> - case selectQuery of + case readSqlParts of Left e -> return $ responseLBS status400 [jsonH] $ cs e - Right q -> do - let range = iRange apiRequest + Right (q, cq) -> do + let range = restrictRange (configMaxRows conf) $ iRange apiRequest singular = iPreferSingular apiRequest - stm = createReadStatement q range singular + stm = createReadStatement q cq range singular (iPreferCount apiRequest) (contentType == TextCSV) - if range == Just emptyRange + if range == emptyRange then return $ errResponse status416 "HTTP Range error" else do row <- H.maybeEx stm @@ -87,7 +89,7 @@ then responseLBS status404 [] "" else responseLBS status200 [contentTypeH] (fromMaybe "{}" body) else do - let frm = fromMaybe 0 $ rangeOffset <$> range + let frm = rangeOffset range to = frm+queryTotal-1 contentRange = contentRangeH frm to tableTotal status = rangeStatus frm to tableTotal @@ -104,14 +106,14 @@ ) ] (fromMaybe "[]" body) - (ActionCreate, TargetIdent (QualifiedIdentifier _ table), + (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table), Just payload@(PayloadJSON (UniformObjects rows))) -> - case queries of + case mutateSqlParts of Left e -> return $ responseLBS status400 [jsonH] $ cs e Right (sq,mq) -> do let isSingle = (==1) $ V.length rows let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself? - let stm = createWriteStatement sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload + let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == TextCSV) payload row <- H.maybeEx stm let (_, _, location, body) = extractQueryResult row return $ responseLBS status201 @@ -119,28 +121,28 @@ contentTypeH, (hLocation, "/" <> cs table <> "?" <> cs (fromMaybe "" location)) ] - $ if iPreferRepresentation apiRequest then fromMaybe "[]" body else "" + $ if iPreferRepresentation apiRequest == Full then fromMaybe "[]" body else "" - (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON _)) -> - case queries of + (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON _)) -> + case mutateSqlParts of Left e -> return $ responseLBS status400 [jsonH] $ cs e Right (sq,mq) -> do - let stm = createWriteStatement sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) payload + let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) payload row <- H.maybeEx stm let (_, queryTotal, _, body) = extractQueryResult row r = contentRangeH 0 (queryTotal-1) (Just queryTotal) s = case () of _ | queryTotal == 0 -> status404 - | iPreferRepresentation apiRequest -> status200 + | iPreferRepresentation apiRequest == Full -> status200 | otherwise -> status204 return $ responseLBS s [contentTypeH, r] - $ if iPreferRepresentation apiRequest then fromMaybe "[]" body else "" + $ if iPreferRepresentation apiRequest == Full then fromMaybe "[]" body else "" - (ActionDelete, TargetIdent _, Nothing) -> - case queries of + (ActionDelete, TargetIdent qi, Nothing) -> + case mutateSqlParts of Left e -> return $ responseLBS status400 [jsonH] $ cs e Right (sq,mq) -> do let fakeload = PayloadJSON $ UniformObjects V.empty - let stm = createWriteStatement sq mq False False [] (contentType == TextCSV) fakeload + let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload row <- H.maybeEx stm let (_, queryTotal, _, _) = extractQueryResult row return $ if queryTotal == 0 @@ -196,9 +198,13 @@ allOrigins = ("Access-Control-Allow-Origin", "*") :: Header schema = cs $ configSchema conf apiRequest = userApiRequest schema req reqBody - selectQuery = requestToQuery schema <$> (DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest) - mutateQuery = requestToQuery schema <$> (DbMutate <$> buildMutateRequest apiRequest) - queries = (,) <$> selectQuery <*> mutateQuery + readDbRequest = DbRead <$> buildReadRequest (dbRelations dbStructure) apiRequest + mutateDbRequest = DbMutate <$> buildMutateRequest apiRequest + selectQuery = requestToQuery schema <$> readDbRequest + countQuery = requestToCountQuery schema <$> readDbRequest + mutateQuery = requestToQuery schema <$> mutateDbRequest + readSqlParts = (,) <$> selectQuery <*> countQuery + mutateSqlParts = (,) <$> selectQuery <*> mutateQuery rangeStatus :: Int -> Int -> Maybe Int -> Status rangeStatus _ _ Nothing = status200 @@ -258,7 +264,7 @@ rootName = if action == ActionRead then rootTableName - else sourceSubqueryName + else sourceCTEName filters = 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 @@ -313,9 +319,9 @@ -- as just another table that has relations with other tables toSourceRelation :: TableName -> Relation -> Maybe Relation toSourceRelation mt r@(Relation t _ ft _ _ rt _ _) - | mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}} - | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}} - | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceSubqueryName}) <$> rt} + | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}} + | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}} + | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt} | otherwise = Nothing data TableOptions = TableOptions { diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -30,6 +30,7 @@ import Network.Wai.Middleware.Cors (CorsResourcePolicy (..)) import Options.Applicative import Paths_postgrest (version) +import Safe (readMay) import Web.JWT (Secret, secret) import Prelude @@ -41,6 +42,7 @@ , configSchema :: String , configJwtSecret :: Secret , configPool :: Int + , configMaxRows :: Maybe Int } argParser :: Parser AppConfig @@ -49,10 +51,11 @@ <*> option auto (long "port" <> short 'p' <> help "port number on which to run HTTP server" <> metavar "PORT" <> value 3000 <> showDefault) <*> strOption (long "anonymous" <> short 'a' <> help "postgres role to use for non-authenticated requests" <> metavar "ROLE") - <*> strOption (long "schema" <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "1" <> showDefault) + <*> strOption (long "schema" <> short 's' <> help "schema to use for API routes" <> metavar "NAME" <> value "public" <> showDefault) <*> (secret . cs <$> strOption (long "jwt-secret" <> short 'j' <> help "secret used to encrypt and decrypt JWT tokens" <> metavar "SECRET" <> value "secret" <> showDefault)) <*> option auto (long "pool" <> short 'o' <> help "max connections in database pool" <> metavar "COUNT" <> value 10 <> showDefault) + <*> (readMay <$> strOption (long "max-rows" <> short 'm' <> help "max rows in response" <> metavar "COUNT" <> value "infinity" <> showDefault)) defaultCorsPolicy :: CorsResourcePolicy defaultCorsPolicy = CorsResourcePolicy Nothing diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -202,6 +202,98 @@ info.column_default AS default_value, array_to_string(enum_info.vals, ',') AS enum FROM ( + /* + -- CTE based on information_schema.columns to remove the owner filter + */ + WITH columns AS ( + SELECT current_database()::information_schema.sql_identifier AS table_catalog, + nc.nspname::information_schema.sql_identifier AS table_schema, + c.relname::information_schema.sql_identifier AS table_name, + a.attname::information_schema.sql_identifier AS column_name, + a.attnum::information_schema.cardinal_number AS ordinal_position, + pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default, + CASE + WHEN a.attnotnull OR t.typtype = 'd'::"char" AND t.typnotnull THEN 'NO'::text + ELSE 'YES'::text + END::information_schema.yes_or_no AS is_nullable, + CASE + WHEN t.typtype = 'd'::"char" THEN + CASE + WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text + WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer) + ELSE 'USER-DEFINED'::text + END + ELSE + CASE + WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text + WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer) + ELSE 'USER-DEFINED'::text + END + END::information_schema.character_data AS data_type, + information_schema._pg_char_max_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_maximum_length, + information_schema._pg_char_octet_length(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS character_octet_length, + information_schema._pg_numeric_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision, + information_schema._pg_numeric_precision_radix(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_precision_radix, + information_schema._pg_numeric_scale(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS numeric_scale, + information_schema._pg_datetime_precision(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.cardinal_number AS datetime_precision, + information_schema._pg_interval_type(information_schema._pg_truetypid(a.*, t.*), information_schema._pg_truetypmod(a.*, t.*))::information_schema.character_data AS interval_type, + NULL::integer::information_schema.cardinal_number AS interval_precision, + NULL::character varying::information_schema.sql_identifier AS character_set_catalog, + NULL::character varying::information_schema.sql_identifier AS character_set_schema, + NULL::character varying::information_schema.sql_identifier AS character_set_name, + CASE + WHEN nco.nspname IS NOT NULL THEN current_database() + ELSE NULL::name + END::information_schema.sql_identifier AS collation_catalog, + nco.nspname::information_schema.sql_identifier AS collation_schema, + co.collname::information_schema.sql_identifier AS collation_name, + CASE + WHEN t.typtype = 'd'::"char" THEN current_database() + ELSE NULL::name + END::information_schema.sql_identifier AS domain_catalog, + CASE + WHEN t.typtype = 'd'::"char" THEN nt.nspname + ELSE NULL::name + END::information_schema.sql_identifier AS domain_schema, + CASE + WHEN t.typtype = 'd'::"char" THEN t.typname + ELSE NULL::name + END::information_schema.sql_identifier AS domain_name, + current_database()::information_schema.sql_identifier AS udt_catalog, + COALESCE(nbt.nspname, nt.nspname)::information_schema.sql_identifier AS udt_schema, + COALESCE(bt.typname, t.typname)::information_schema.sql_identifier AS udt_name, + NULL::character varying::information_schema.sql_identifier AS scope_catalog, + NULL::character varying::information_schema.sql_identifier AS scope_schema, + NULL::character varying::information_schema.sql_identifier AS scope_name, + NULL::integer::information_schema.cardinal_number AS maximum_cardinality, + a.attnum::information_schema.sql_identifier AS dtd_identifier, + 'NO'::character varying::information_schema.yes_or_no AS is_self_referencing, + 'NO'::character varying::information_schema.yes_or_no AS is_identity, + NULL::character varying::information_schema.character_data AS identity_generation, + NULL::character varying::information_schema.character_data AS identity_start, + NULL::character varying::information_schema.character_data AS identity_increment, + NULL::character varying::information_schema.character_data AS identity_maximum, + NULL::character varying::information_schema.character_data AS identity_minimum, + NULL::character varying::information_schema.yes_or_no AS identity_cycle, + 'NEVER'::character varying::information_schema.character_data AS is_generated, + NULL::character varying::information_schema.character_data AS generation_expression, + CASE + WHEN c.relkind = 'r'::"char" OR (c.relkind = ANY (ARRAY['v'::"char", 'f'::"char"])) AND pg_column_is_updatable(c.oid::regclass, a.attnum, false) THEN 'YES'::text + ELSE 'NO'::text + END::information_schema.yes_or_no AS is_updatable + FROM pg_attribute a + LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum + JOIN (pg_class c + JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid + JOIN (pg_type t + JOIN pg_namespace nt ON t.typnamespace = nt.oid) ON a.atttypid = t.oid + LEFT JOIN (pg_type bt + JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid) ON t.typtype = 'd'::"char" AND t.typbasetype = bt.oid + LEFT JOIN (pg_collation co + JOIN pg_namespace nco ON co.collnamespace = nco.oid) ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name) + WHERE NOT pg_is_other_temp_schema(nc.oid) AND a.attnum > 0 AND NOT a.attisdropped AND (c.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"])) + /*--AND (pg_has_role(c.relowner, 'USAGE'::text) OR has_column_privilege(c.oid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/ + ) SELECT table_schema, table_name, @@ -214,7 +306,8 @@ numeric_precision, column_default, udt_name - FROM information_schema.columns + /*-- FROM information_schema.columns*/ + FROM columns WHERE table_schema NOT IN ('pg_catalog', 'information_schema') ) AS info LEFT OUTER JOIN ( @@ -276,33 +369,118 @@ relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = - if isJust table && isJust tableF && length cols == length rcs && length colsF == length frcs - then Just $ Relation (fromJust table) cols (fromJust tableF) colsF Child Nothing Nothing Nothing - else Nothing + Relation <$> table <*> cols <*> tableF <*> colsF <*> pure Child <*> pure Nothing <*> pure Nothing <*> pure Nothing where findTable s t = find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs - findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols + findCol s t c = find (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col == c) allCols table = findTable rs rt tableF = findTable frs frt - cols = findCols rs rt rcs - colsF = findCols frs frt frcs + cols = mapM (findCol rs rt) rcs + colsF = mapM (findCol frs frt) frcs allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey] allPrimaryKeys tabs = do pks <- H.listEx $ [H.stmt| - 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') + /* + -- CTE to replace information_schema.table_constraints to remove owner limit + */ + WITH tc AS ( + SELECT current_database()::information_schema.sql_identifier AS constraint_catalog, + nc.nspname::information_schema.sql_identifier AS constraint_schema, + c.conname::information_schema.sql_identifier AS constraint_name, + current_database()::information_schema.sql_identifier AS table_catalog, + nr.nspname::information_schema.sql_identifier AS table_schema, + r.relname::information_schema.sql_identifier AS table_name, + CASE c.contype + WHEN 'c'::"char" THEN 'CHECK'::text + WHEN 'f'::"char" THEN 'FOREIGN KEY'::text + WHEN 'p'::"char" THEN 'PRIMARY KEY'::text + WHEN 'u'::"char" THEN 'UNIQUE'::text + ELSE NULL::text + END::information_schema.character_data AS constraint_type, + CASE + WHEN c.condeferrable THEN 'YES'::text + ELSE 'NO'::text + END::information_schema.yes_or_no AS is_deferrable, + CASE + WHEN c.condeferred THEN 'YES'::text + ELSE 'NO'::text + END::information_schema.yes_or_no AS initially_deferred + FROM pg_namespace nc, + pg_namespace nr, + pg_constraint c, + pg_class r + WHERE nc.oid = c.connamespace AND nr.oid = r.relnamespace AND c.conrelid = r.oid AND (c.contype <> ALL (ARRAY['t'::"char", 'x'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid) + /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/ + UNION ALL + SELECT current_database()::information_schema.sql_identifier AS constraint_catalog, + nr.nspname::information_schema.sql_identifier AS constraint_schema, + (((((nr.oid::text || '_'::text) || r.oid::text) || '_'::text) || a.attnum::text) || '_not_null'::text)::information_schema.sql_identifier AS constraint_name, + current_database()::information_schema.sql_identifier AS table_catalog, + nr.nspname::information_schema.sql_identifier AS table_schema, + r.relname::information_schema.sql_identifier AS table_name, + 'CHECK'::character varying::information_schema.character_data AS constraint_type, + 'NO'::character varying::information_schema.yes_or_no AS is_deferrable, + 'NO'::character varying::information_schema.yes_or_no AS initially_deferred + FROM pg_namespace nr, + pg_class r, + pg_attribute a + WHERE nr.oid = r.relnamespace AND r.oid = a.attrelid AND a.attnotnull AND a.attnum > 0 AND NOT a.attisdropped AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid) + /*--AND (pg_has_role(r.relowner, 'USAGE'::text) OR has_table_privilege(r.oid, 'INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR has_any_column_privilege(r.oid, 'INSERT, UPDATE, REFERENCES'::text))*/ + ), + /* + -- CTE to replace information_schema.key_column_usage to remove owner limit + */ + kc AS ( + SELECT current_database()::information_schema.sql_identifier AS constraint_catalog, + ss.nc_nspname::information_schema.sql_identifier AS constraint_schema, + ss.conname::information_schema.sql_identifier AS constraint_name, + current_database()::information_schema.sql_identifier AS table_catalog, + ss.nr_nspname::information_schema.sql_identifier AS table_schema, + ss.relname::information_schema.sql_identifier AS table_name, + a.attname::information_schema.sql_identifier AS column_name, + (ss.x).n::information_schema.cardinal_number AS ordinal_position, + CASE + WHEN ss.contype = 'f'::"char" THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n]) + ELSE NULL::integer + END::information_schema.cardinal_number AS position_in_unique_constraint + FROM pg_attribute a, + ( SELECT r.oid AS roid, + r.relname, + r.relowner, + nc.nspname AS nc_nspname, + nr.nspname AS nr_nspname, + c.oid AS coid, + c.conname, + c.contype, + c.conindid, + c.confkey, + c.confrelid, + information_schema._pg_expandarray(c.conkey) AS x + FROM pg_namespace nr, + pg_class r, + pg_namespace nc, + pg_constraint c + WHERE nr.oid = r.relnamespace AND r.oid = c.conrelid AND nc.oid = c.connamespace AND (c.contype = ANY (ARRAY['p'::"char", 'u'::"char", 'f'::"char"])) AND r.relkind = 'r'::"char" AND NOT pg_is_other_temp_schema(nr.oid)) ss + WHERE ss.roid = a.attrelid AND a.attnum = (ss.x).x AND NOT a.attisdropped + /*--AND (pg_has_role(ss.relowner, 'USAGE'::text) OR has_column_privilege(ss.roid, a.attnum, 'SELECT, INSERT, UPDATE, REFERENCES'::text))*/ + ) + SELECT + kc.table_schema, + kc.table_name, + kc.column_name + FROM + /* + --information_schema.table_constraints tc, + --information_schema.key_column_usage kc + */ + tc, 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') |] return $ mapMaybe (pkFromRow tabs) pks @@ -314,32 +492,65 @@ allSynonyms allCols = do syns <- H.listEx $ [H.stmt| WITH synonyms AS ( + /* + -- CTE to replace the view from information_schema because the information in it depended on the logged in role + -- notice the commented line + */ + WITH view_column_usage AS ( + SELECT DISTINCT + CAST(current_database() AS character varying) AS view_catalog, + CAST(nv.nspname AS character varying) AS view_schema, + CAST(v.relname AS character varying) AS view_name, + CAST(current_database() AS character varying) AS table_catalog, + CAST(nt.nspname AS character varying) AS table_schema, + CAST(t.relname AS character varying) AS table_name, + CAST(a.attname AS character varying) AS column_name + FROM pg_namespace nv, pg_class v, pg_depend dv, + pg_depend dt, pg_class t, pg_namespace nt, + pg_attribute a + WHERE nv.oid = v.relnamespace + AND v.relkind = 'v' + AND v.oid = dv.refobjid + AND dv.refclassid = 'pg_catalog.pg_class'::regclass + AND dv.classid = 'pg_catalog.pg_rewrite'::regclass + AND dv.deptype = 'i' + AND dv.objid = dt.objid + AND dv.refobjid <> dt.refobjid + AND dt.classid = 'pg_catalog.pg_rewrite'::regclass + AND dt.refclassid = 'pg_catalog.pg_class'::regclass + AND dt.refobjid = t.oid + AND t.relnamespace = nt.oid + AND t.relkind IN ('r', 'v', 'f') + AND t.oid = a.attrelid + AND dt.refobjsubid = a.attnum + /*--AND pg_has_role(t.relowner, 'USAGE')*/ + ) SELECT vcu.table_schema AS src_table_schema, vcu.table_name AS src_table_name, vcu.column_name AS src_column_name, - view.table_schema AS syn_table_schema, - view.table_name AS syn_table_name, - view.view_definition AS view_definition + view.schemaname AS syn_table_schema, + view.viewname AS syn_table_name, + view.definition AS view_definition FROM - information_schema.views AS view, - information_schema.view_column_usage AS vcu + pg_catalog.pg_views AS view, + view_column_usage AS vcu WHERE - view.table_schema = vcu.view_schema AND - view.table_name = vcu.view_name AND - view.table_schema NOT IN ('pg_catalog', 'information_schema') AND - (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.table_schema AND view_name = view.table_name) = 1 + view.schemaname = vcu.view_schema AND + view.viewname = vcu.view_name AND + view.schemaname NOT IN ('pg_catalog', 'information_schema') + /*--AND (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.schemaname AND view_name = view.viewname) = 1*/ ) SELECT src_table_schema, src_table_name, src_column_name, syn_table_schema, syn_table_name, - (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1] + (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1] AS syn_column_name FROM synonyms UNION ( SELECT src_table_schema, src_table_name, src_column_name, syn_table_schema, syn_table_name, - (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] /* " <- for syntax highlighting */ + (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] AS syn_column_name /* " <- for syntax highlighting */ FROM synonyms ) |] diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Main where @@ -6,17 +8,18 @@ minimumPgVersion, prettyVersion, readOptions) -import PostgREST.Error (pgErrResponse, PgError) -import PostgREST.Middleware import PostgREST.DbStructure +import PostgREST.Error (PgError, pgErrResponse) +import PostgREST.Middleware -import Control.Monad (unless) +import Control.Monad (unless, void) import Control.Monad.IO.Class (liftIO) import Data.Aeson (encode) import Data.Functor.Identity import Data.Monoid ((<>)) import Data.String.Conversions (cs) import Data.Text (Text) +import Data.Time.Clock.POSIX (getPOSIXTime) import qualified Hasql as H import qualified Hasql.Postgres as P import Network.Wai @@ -27,6 +30,12 @@ stdin, stdout) import Web.JWT (secret) +#ifndef mingw32_HOST_OS +import System.Posix.Signals +import Control.Concurrent (myThreadId) +import Control.Exception.Base (throwTo, AsyncException(..)) +#endif + isServerVersionSupported :: H.Session P.Postgres IO Bool isServerVersionSupported = do Identity (row :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SHOW server_version_num|] @@ -68,12 +77,21 @@ <> show minimumPgVersion) ) supportedOrError +#ifndef mingw32_HOST_OS + tid <- myThreadId + void $ installHandler keyboardSignal (Catch $ do + H.releasePool pool + throwTo tid UserInterrupt + ) Nothing +#endif + let txSettings = Just (H.ReadCommitted, Just True) dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema conf) dbStructure <- either hasqlError return dbOrError runSettings appSettings $ middle $ \ req respond -> do + time <- getPOSIXTime body <- strictRequestBody req resOrError <- liftIO $ H.session pool $ H.tx txSettings $ - runWithClaims conf (app dbStructure conf body) req + runWithClaims conf time (app dbStructure conf body) req either (respond . pgErrResponse) respond resOrError diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -6,7 +6,7 @@ import Data.Maybe (fromMaybe) import Data.Text import Data.String.Conversions (cs) -import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.Time.Clock (NominalDiffTime) import qualified Hasql as H import qualified Hasql.Postgres as P @@ -23,20 +23,17 @@ import PostgREST.Config (AppConfig (..), corsPolicy) import PostgREST.Error (errResponse) -import System.IO.Unsafe (unsafePerformIO) - import Prelude hiding(concat) import qualified Data.Vector as V import qualified Hasql.Backend as B import qualified Data.Map.Lazy as M -runWithClaims :: forall s. AppConfig -> +runWithClaims :: forall s. AppConfig -> NominalDiffTime -> (Request -> H.Tx P.Postgres s Response) -> Request -> H.Tx P.Postgres s Response -runWithClaims conf app req = do +runWithClaims conf time app req = do _ <- H.unitEx $ stmt setAnon - let time = unsafePerformIO getPOSIXTime case split (== ' ') (cs auth) of ("Bearer" : tokenStr : _) -> case jwtClaims jwtSecret tokenStr time of diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : PostgREST.QueryBuilder @@ -22,7 +23,8 @@ , pgFmtIdent , pgFmtLit , requestToQuery - , sourceSubqueryName + , requestToCountQuery + , sourceCTEName , unquoted ) where @@ -34,14 +36,14 @@ import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset) import Control.Error (note, fromMaybe, mapMaybe) -import Control.Monad (join) import qualified Data.HashMap.Strict as HM -import Data.List (find) +import Data.List (find, (\\)) import Data.Monoid ((<>)) import Data.Text (Text, intercalate, unwords, replace, isInfixOf, toLower, split) import qualified Data.Text as T (map, takeWhile) import Data.String.Conversions (cs) import Control.Applicative (empty, (<|>)) +import Control.Monad (join) import Data.Tree (Tree(..)) import qualified Data.Vector as V import PostgREST.Types @@ -53,6 +55,7 @@ , isInteger ) import Prelude hiding (unwords) +import PostgREST.ApiRequest (PreferRepresentation (..)) type PStmt = H.Stmt P.Postgres instance Monoid PStmt where @@ -61,54 +64,88 @@ mempty = B.Stmt "" empty True type StatementT = PStmt -> PStmt -createReadStatement :: SqlQuery -> Maybe NonnegRange -> Bool -> Bool -> Bool -> B.Stmt P.Postgres -createReadStatement selectQuery range isSingle countTable asCsv = +createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> B.Stmt P.Postgres +createReadStatement selectQuery countQuery range isSingle countTotal asCsv = B.Stmt ( - wrapQuery selectQuery [ - if countTable then countAllF else countNoneF, - countF, - "null", -- location header can not be calucalted - if asCsv - then asCsvF - else if isSingle then asJsonSingleF else asJsonF - ] selectStarF range + "WITH " <> sourceCTEName <> " AS (" <> selectQuery <> ") " <> + "SELECT " <> intercalate ", " [ + countResultF <> " AS total_result_set", + "pg_catalog.count(t) AS page_total", + "null AS header", + bodyF <> " AS body" + ] <> + " FROM ( SELECT * FROM " <> sourceCTEName <> " " <> limitF range <> ") t" ) V.empty True + where + countResultF = if countTotal then "("<>countQuery<>")" else "null" + bodyF + | asCsv = asCsvF + | isSingle = asJsonSingleF + | otherwise = asJsonF -createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> +createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool -> PreferRepresentation -> [Text] -> Bool -> Payload -> B.Stmt P.Postgres -createWriteStatement _ _ _ _ _ _ (PayloadParseError _) = undefined -createWriteStatement selectQuery mutateQuery isSingle echoRequested - pKeys asCsv (PayloadJSON (UniformObjects rows)) = +createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined +createWriteStatement _ _ mutateQuery _ None + _ _ (PayloadJSON (UniformObjects rows)) = B.Stmt ( - wrapQuery mutateQuery [ - countNoneF, -- when updateing it does not make sense - countF, + "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> ") " <> + "SELECT null, 0, null, null" + ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True +createWriteStatement qi _ mutateQuery isSingle HeadersOnly + pKeys _ (PayloadJSON (UniformObjects rows)) = + B.Stmt ( + "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> " RETURNING " <> fromQi qi <> ".*" <> ") " <> + "SELECT " <> intercalate ", " [ + "null AS total_result_set", + "pg_catalog.count(t) AS page_total", if isSingle then locationF pKeys else "null", - if echoRequested - then - if asCsv - then asCsvF - else if isSingle then asJsonSingleF else asJsonF - else "null" - - ] selectQuery Nothing + "null" + ] <> + " FROM (SELECT 1 FROM " <> sourceCTEName <> ") t" ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True +createWriteStatement qi selectQuery mutateQuery isSingle Full + pKeys asCsv (PayloadJSON (UniformObjects rows)) = + B.Stmt ( + "WITH " <> sourceCTEName <> " AS (" <> mutateQuery <> " RETURNING " <> fromQi qi <> ".*" <> ") " <> + "SELECT " <> intercalate ", " [ + "null AS total_result_set", -- when updateing it does not make sense + "pg_catalog.count(t) AS page_total", + if isSingle then locationF pKeys else "null" <> " AS header", + bodyF <> " AS body" + ] <> + " FROM ( "<>selectQuery<>") t" + ) (V.singleton . B.encodeValue . JSON.Array . V.map JSON.Object $ rows) True + where + bodyF + | asCsv = asCsvF + | isSingle = asJsonSingleF + | otherwise = asJsonF addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest -addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) = +addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _)) forest) = case parentNode of - Nothing -> Node (query, (table, Nothing)) <$> updatedForest - (Just (Node (_, (parentTable, _)) _)) -> Node <$> (addRel n <$> rel) <*> updatedForest + (Just (Node (Select{from=[parentTable]}, (_, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest where - rel = note ("no relation between " <> table <> " and " <> parentTable) - $ findRelation schema table parentTable - <|> findRelation schema parentTable table + rel = note ("no relation between " <> parentTable <> " and " <> name) + $ findRelationByTable schema name parentTable + <|> findRelationByTable schema parentTable name + <|> findRelationByColumn schema parentTable name addRel :: (ReadQuery, (NodeName, Maybe Relation)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation)) - addRel (q, (t, _)) r = (q, (t, Just r)) + addRel (q, (n, _)) r = (q {from=fromRelation}, (n, Just r)) + where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from q) + + _ -> Node (query, (name, Nothing)) <$> updatedForest where updatedForest = mapM (addRelations schema allRelations (Just node)) forest - findRelation s t1 t2 = - find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations + -- Searches through all the relations and returns a match given the parameter conditions. + -- Will only find a relation where both schemas are in the PostgREST schema. + -- `findRelationByColumn` also does a ducktype check to see if the column name has any variation of `id` or `fk`. If so then the relation is returned as a match. + findRelationByTable s t1 t2 = + find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t1 == tableName (relTable r) && t2 == tableName (relFTable r)) allRelations + findRelationByColumn s t c = + find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t == tableName (relFTable r) && length (relFColumns r) == 1 && c `colMatches` (colName . head . relFColumns) r) allRelations + where n `colMatches` rc = (cs ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (cs n :: BS.ByteString) addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest addJoinConditions schema (Node (query, (n, r)) forest) = @@ -166,12 +203,7 @@ ] pgFmtIdent :: SqlFragment -> SqlFragment -pgFmtIdent x = - let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in - if (cs escaped :: BS.ByteString) =~ danger - then "\"" <> escaped <> "\"" - else escaped - where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString +pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ cs x) <> "\"" pgFmtLit :: SqlFragment -> SqlFragment pgFmtLit x = @@ -182,44 +214,79 @@ then "E" <> slashed else slashed +requestToCountQuery :: Schema -> DbRequest -> SqlQuery +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 + ] + where + fn (Filter{value=VText _}) = True + fn (Filter{value=VForeignKey _ _}) = False + localConditions = filter fn conditions + requestToQuery :: Schema -> DbRequest -> SqlQuery requestToQuery _ (DbMutate (Insert _ (PayloadParseError _))) = undefined requestToQuery _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined -requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest)) = +requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nodeName, maybeRelation)) forest)) = query where -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name -- of our WITH query part - tblSchema tbl = if tbl == sourceSubqueryName then "" else schema + mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation) + tblSchema tbl = if tbl == sourceCTEName then "" else schema qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl toQi t = QualifiedIdentifier (tblSchema t) t query = unwords [ - ("WITH " <> intercalate ", " (map fst withs)) `emptyOnNull` withs, "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), - "FROM ", intercalate ", " (map (fromQi . toQi) tbls ++ map snd withs), - ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, + "FROM ", intercalate ", " (map (fromQi . toQi) tbls), + unwords (map joinStr joins), + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) localConditions )) `emptyOnNull` localConditions, orderF (fromMaybe [] ord) ] - (withs, selects) = foldr getQueryParts ([],[]) forest - getQueryParts :: Tree ReadNode -> ([(SqlFragment, Text)], [SqlFragment]) -> ([(SqlFragment,Text)], [SqlFragment]) - getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s) + orderF ts = + if null ts + then "" + else "ORDER BY " <> clause + where + clause = intercalate "," (map queryTerm ts) + queryTerm :: OrderTerm -> Text + queryTerm t = " " + <> cs (pgFmtColumn qi $ otTerm t) <> " " + <> (cs.show) (otDirection t) <> " " + <> maybe "" (cs.show) (otNullOrder t) <> " " + (joins, selects) = foldr getQueryParts ([],[]) forest + parentTables = map snd joins + parentConditions = join $ map (( `filter` conditions ) . filterParentConditions) parentTables + localConditions = conditions \\ parentConditions + joinStr :: (SqlFragment, TableName) -> SqlFragment + joinStr (sql, t) = "LEFT OUTER JOIN " <> sql <> " ON " <> + intercalate " AND " ( map (pgFmtCondition qi ) joinConditions ) where - sel = "(" + joinConditions = filter (filterParentConditions t) conditions + filterParentConditions parentTable (Filter _ _ (VForeignKey (QualifiedIdentifier "" t) _)) = parentTable == t + filterParentConditions _ _ = False + getQueryParts :: Tree ReadNode -> ([(SqlFragment, TableName)], [SqlFragment]) -> ([(SqlFragment,TableName)], [SqlFragment]) + getQueryParts (Node n@(_, (name, Just (Relation {relType=Child,relTable=Table{tableName=table}}))) forst) (j,s) = (j,sel:s) + where + sel = "COALESCE((" <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) " <> "FROM (" <> subquery <> ") " <> table - <> ") AS " <> table + <> "), '[]') AS " <> pgFmtIdent name where subquery = requestToQuery schema (DbRead (Node n forst)) - getQueryParts (Node n@(_, (table, Just (Relation {relType=Parent}))) forst) (w,s) = (wit:w,sel:s) + getQueryParts (Node n@(_, (name, Just (Relation {relType=Parent,relTable=Table{tableName=table}}))) forst) (j,s) = (joi:j,sel:s) where - sel = "row_to_json(" <> table <> ".*) AS "<>table --TODO must be singular - wit = (table <> " AS ( " <> subquery <> " )", table) + sel = "row_to_json(" <> table <> ".*) AS "<>pgFmtIdent name --TODO must be singular + joi = ("( " <> subquery <> " ) AS " <> table, table) where subquery = requestToQuery schema (DbRead (Node n forst)) - getQueryParts (Node n@(_, (table, Just (Relation {relType=Many}))) forst) (w,s) = (w,sel:s) + getQueryParts (Node n@(_, (name, Just (Relation {relType=Many,relTable=Table{tableName=table}}))) forst) (j,s) = (j,sel:s) where - sel = "(" + sel = "COALESCE ((" <> "SELECT array_to_json(array_agg(row_to_json("<>table<>"))) " <> "FROM (" <> subquery <> ") " <> table - <> ") AS " <> table + <> "), '[]') AS " <> pgFmtIdent name where subquery = requestToQuery schema (DbRead (Node n forst)) --the following is just to remove the warning --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only @@ -233,8 +300,7 @@ "INSERT INTO ", fromQi qi, " (" <> colsString <> ")" <> " SELECT " <> colsString <> - " FROM json_populate_recordset(null::" , fromQi qi, ", ?)", - " RETURNING " <> fromQi qi <> ".*" + " FROM json_populate_recordset(null::" , fromQi qi, ", ?)" ] requestToQuery schema (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) = case rows V.!? 0 of @@ -244,8 +310,7 @@ unwords [ "UPDATE ", fromQi qi, " SET " <> intercalate "," assignments <> " ", - ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, - "RETURNING " <> fromQi qi <> ".*" + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions ] Nothing -> undefined where @@ -257,12 +322,11 @@ qi = QualifiedIdentifier schema mainTbl query = unwords [ "DELETE FROM ", fromQi qi, - ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, - "RETURNING " <> fromQi qi <> ".*" + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions ] -sourceSubqueryName :: SqlFragment -sourceSubqueryName = "pg_source" +sourceCTEName :: SqlFragment +sourceCTEName = "pg_source" unquoted :: JSON.Value -> Text unquoted (JSON.String t) = t @@ -280,7 +344,7 @@ " FROM (" <> " SELECT json_object_keys(r)::TEXT as k" <> " FROM ( " <> - " SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <> + " SELECT row_to_json(hh) as r from " <> sourceCTEName <> " as hh limit 1" <> " ) s" <> " ) a" <> ")" @@ -292,19 +356,10 @@ asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying " -countAllF :: SqlFragment -countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )" - -countF :: SqlFragment -countF = "pg_catalog.count(t)" - -countNoneF :: SqlFragment -countNoneF = "null" - locationF :: [Text] -> SqlFragment locationF pKeys = "(" <> - " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <> + " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss limit 1)" <> " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <> " FROM s, json_each_text(s.r) AS json_data" <> ( @@ -314,6 +369,12 @@ ) <> ")" +limitF :: NonnegRange -> SqlFragment +limitF r = "LIMIT " <> limit <> " OFFSET " <> offset + where + limit = maybe "ALL" (cs . show) $ rangeLimit r + offset = cs . show $ rangeOffset r + fromQi :: QualifiedIdentifier -> SqlFragment fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n where @@ -337,19 +398,6 @@ emptyOnNull :: Text -> [a] -> Text emptyOnNull val x = if null x then "" else val -orderF :: [OrderTerm] -> SqlFragment -orderF ts = - if null ts - then "" - else "ORDER BY " <> clause - where - clause = intercalate "," (map queryTerm ts) - queryTerm :: OrderTerm -> Text - queryTerm t = " " - <> cs (pgFmtIdent $ otTerm t) <> " " - <> (cs.show) (otDirection t) <> " " - <> maybe "" (cs.show) (otNullOrder t) <> " " - insertableValue :: JSON.Value -> SqlFragment insertableValue JSON.Null = "null" insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v @@ -389,7 +437,7 @@ valToStr v = case v of VText s -> pgFmtValue opCode s VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc - where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft + where qi = QualifiedIdentifier (if ft == sourceCTEName then "" else s) ft _ -> "" pgFmtValue :: Text -> Text -> SqlFragment @@ -421,26 +469,3 @@ trimNullChars :: Text -> Text trimNullChars = T.takeWhile (/= '\x0') - -withSourceF :: SqlFragment -> SqlFragment -withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")" - -fromF :: SqlFragment -> SqlFragment -> SqlFragment -fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t" - -limitF :: Maybe NonnegRange -> SqlFragment -limitF r = "LIMIT " <> limit <> " OFFSET " <> offset - where - limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r - offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r - -selectStarF :: SqlFragment -selectStarF = "SELECT * FROM " <> sourceSubqueryName - -wrapQuery :: SqlQuery -> [Text] -> Text -> Maybe NonnegRange -> SqlQuery -wrapQuery source selectColumns returnSelect range = - withSourceF source <> - " SELECT " <> - intercalate ", " selectColumns <> - " " <> - fromF returnSelect ( limitF range ) diff --git a/src/PostgREST/RangeQuery.hs b/src/PostgREST/RangeQuery.hs --- a/src/PostgREST/RangeQuery.hs +++ b/src/PostgREST/RangeQuery.hs @@ -3,6 +3,7 @@ , rangeRequested , rangeLimit , rangeOffset +, restrictRange , NonnegRange ) where @@ -25,20 +26,26 @@ type NonnegRange = Range Int -rangeParse :: BS.ByteString -> Maybe NonnegRange +rangeParse :: BS.ByteString -> NonnegRange rangeParse range = do let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString - parsedRange <- listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) - - let [_, from, to] = readMaybe . cs <$> parsedRange - let lower = fromMaybe emptyRange (rangeGeq <$> from) - let upper = fromMaybe (rangeGeq 0) (rangeLeq <$> to) + case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of + Just parsedRange -> + let [_, from, to] = readMaybe . cs <$> parsedRange + lower = fromMaybe emptyRange (rangeGeq <$> from) + upper = fromMaybe (rangeGeq 0) (rangeLeq <$> to) in + rangeIntersection lower upper + Nothing -> rangeGeq 0 - return $ rangeIntersection lower upper +rangeRequested :: RequestHeaders -> NonnegRange +rangeRequested = rangeParse . fromMaybe "" . lookup hRange -rangeRequested :: RequestHeaders -> Maybe NonnegRange -rangeRequested = (rangeParse =<<) . lookup hRange +restrictRange :: Maybe Int -> NonnegRange -> NonnegRange +restrictRange Nothing r = r +restrictRange (Just limit) r = + rangeIntersection r $ + Range BoundaryBelowAll (BoundaryAbove $ rangeOffset r + limit - 1) rangeLimit :: NonnegRange -> Maybe Int rangeLimit range = diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -106,10 +106,10 @@ type NodeName = Text type SelectItem = (Field, Maybe Cast) type Path = [Text] -data ReadQuery = Select { select::[SelectItem], from::[Text], flt_::[Filter], order::Maybe [OrderTerm] } deriving (Show, Eq) -data MutateQuery = Insert { in_::Text, qPayload::Payload } - | Delete { in_::Text, where_::[Filter] } - | Update { in_::Text, qPayload::Payload, where_::[Filter] } deriving (Show, Eq) +data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm] } deriving (Show, Eq) +data MutateQuery = Insert { in_::TableName, qPayload::Payload } + | Delete { in_::TableName, where_::[Filter] } + | Update { in_::TableName, qPayload::Payload, where_::[Filter] } deriving (Show, Eq) data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq) type ReadNode = (ReadQuery, (NodeName, Maybe Relation)) type ReadRequest = Tree ReadNode diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -6,13 +6,15 @@ import Test.Hspec.Wai.JSON import Network.HTTP.Types +import Hasql as H +import Hasql.Postgres as P + import SpecHelper +import PostgREST.Types (DbStructure(..)) -- }}} -spec :: Spec -spec = beforeAll - (clearTable "postgrest.auth") . afterAll_ (clearTable "postgrest.auth") - $ around withApp +spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec struct pool = around (withApp cfgDefault struct pool) $ describe "authorization" $ do it "hides tables that anonymous does not own" $ diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs --- a/test/Feature/CorsSpec.hs +++ b/test/Feature/CorsSpec.hs @@ -6,13 +6,17 @@ import Network.Wai.Test (SResponse(simpleHeaders, simpleBody)) import qualified Data.ByteString.Lazy as BL +import Hasql as H +import Hasql.Postgres as P + import SpecHelper +import PostgREST.Types (DbStructure(..)) import Network.HTTP.Types -- }}} -spec :: Spec -spec = around withApp $ describe "CORS" $ do +spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec struct pool = around (withApp cfgDefault struct pool) $ describe "CORS" $ do let preflightHeaders = [ ("Accept", "*/*"), ("Origin", "http://example.com"), diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -2,13 +2,19 @@ import Test.Hspec import Test.Hspec.Wai +import Text.Heredoc + +import Hasql as H +import Hasql.Postgres as P + import SpecHelper +import PostgREST.Types (DbStructure(..)) import Network.HTTP.Types -spec :: Spec -spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items") - . around withApp $ +spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec struct pool = beforeAll resetDb + . around (withApp cfgDefault struct pool) $ describe "Deleting" $ do context "existing record" $ do it "succeeds with 204 and deletion count" $ @@ -23,7 +29,7 @@ _ <- request methodDelete "/items?id=lt.15" [] "" get "/items" `shouldRespondWith` ResponseMatcher { - matchBody = Just "[{\"id\":15}]" + matchBody = Just [str|[{"id":15}]|] , matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-0/1"] } diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -5,7 +5,11 @@ import Test.Hspec.Wai.JSON import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus)) +import Hasql as H +import Hasql.Postgres as P + import SpecHelper +import PostgREST.Types (DbStructure(..)) import qualified Data.Aeson as JSON import Data.Maybe (fromJust) @@ -16,8 +20,8 @@ import TestTypes(IncPK(..), CompoundPK(..)) -spec :: Spec -spec = afterAll_ resetDb $ around withApp $ do +spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec struct pool = beforeAll_ resetDb $ around (withApp cfgDefault struct pool) $ do describe "Posting new record" $ do after_ (clearTable "menagerie") . context "disparate csv types" $ do it "accepts disparate json types" $ do @@ -45,10 +49,10 @@ it "includes related data after insert" $ request methodPost "/projects?select=id,name,clients{id,name}" [("Prefer", "return=representation")] - [str|{"id":5,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher { - matchBody = Just [str|{"id":5,"name":"New Project","clients":{"id":2,"name":"Apple"}}|] + [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}|] , matchStatus = 201 - , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.5"] + , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.6"] } @@ -89,6 +93,15 @@ simpleHeaders p `shouldSatisfy` matchHeader hLocation "/no_pk\\?a=eq.bar&b=eq.baz" simpleStatus p `shouldBe` created201 + it "can insert in tables with no select privileges" $ do + p <- request methodPost "/insertonly" + [("Prefer", "return=minimal")] + [json| { "v":"some value" } |] + liftIO $ do + simpleBody p `shouldBe` "" + simpleStatus p `shouldBe` created201 + + it "can post nulls" $ do p <- request methodPost "/no_pk" [("Prefer", "return=representation")] @@ -301,17 +314,16 @@ context "on an empty table" $ it "indicates no records found to update" $ - request methodPatch "/simple_pk" [] + request methodPatch "/empty_table" [] [json| { "extra":20 } |] `shouldRespondWith` 404 - context "in a nonempty table" . before_ (clearTable "items" >> createItems 15) . - after_ (clearTable "items") $ do + context "in a nonempty table" $ do it "can update a single item" $ do g <- get "/items?id=eq.42" liftIO $ simpleHeaders g `shouldSatisfy` matchHeader "Content-Range" "\\*/0" - request methodPatch "/items?id=eq.1" [] + request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |] `shouldRespondWith` ResponseMatcher { matchBody = Nothing, diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -6,23 +6,15 @@ import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleHeaders)) +import Hasql as H +import Hasql.Postgres as P + import SpecHelper +import PostgREST.Types (DbStructure(..)) import Text.Heredoc - -spec :: Spec -spec = - beforeAll (clearTable "items" >> createItems 15) - . beforeAll clearProjectsTable - . beforeAll (clearTable "complex_items" >> createComplexItems) - . beforeAll (clearTable "nullable_integer" >> createNullInteger) - . beforeAll ( - clearTable "no_pk" >> - createNulls 2 >> - createLikableStrings >> - createJsonData) - . afterAll_ (clearTable "items" >> clearTable "complex_items" >> clearTable "no_pk" >> clearTable "simple_pk") - . around withApp $ do +spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec struct pool = around (withApp cfgDefault struct pool) $ do describe "Querying a table with a column called count" $ it "should not confuse count column with pg_catalog.count aggregate" $ @@ -98,25 +90,25 @@ get "/no_pk?a=is.null" `shouldRespondWith` [json| [{"a": null, "b": null}] |] - get "/nullable_integer?a=is.null" `shouldRespondWith` "[{\"a\":null}]" + get "/nullable_integer?a=is.null" `shouldRespondWith` [str|[{"a":null}]|] it "matches with like" $ do get "/simple_pk?k=like.*yx" `shouldRespondWith` - "[{\"k\":\"xyyx\",\"extra\":\"u\"}]" + [str|[{"k":"xyyx","extra":"u"}]|] get "/simple_pk?k=like.xy*" `shouldRespondWith` - "[{\"k\":\"xyyx\",\"extra\":\"u\"}]" + [str|[{"k":"xyyx","extra":"u"}]|] get "/simple_pk?k=like.*YY*" `shouldRespondWith` - "[{\"k\":\"xYYx\",\"extra\":\"v\"}]" + [str|[{"k":"xYYx","extra":"v"}]|] it "matches with like using not operator" $ get "/simple_pk?k=not.like.*yx" `shouldRespondWith` - "[{\"k\":\"xYYx\",\"extra\":\"v\"}]" + [str|[{"k":"xYYx","extra":"v"}]|] it "matches with ilike" $ do get "/simple_pk?k=ilike.xy*&order=extra.asc" `shouldRespondWith` - "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]" + [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|] get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith` - "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]" + [str|[{"k":"xyyx","extra":"u"},{"k":"xYYx","extra":"v"}]|] it "matches with ilike using not operator" $ get "/simple_pk?k=not.ilike.xy*&order=extra.asc" `shouldRespondWith` "[]" @@ -130,12 +122,16 @@ [json| [{"text_search_vector":"'baz':1 'qux':2"}] |] it "matches with computed column" $ - get "/items?always_true=eq.true" `shouldRespondWith` + get "/items?always_true=eq.true&order=id.asc" `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 "order by computed column" $ + get "/items?order=anti_id.desc" `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\"}]}]}]" + [str|[{"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"}]}]}]|] it "matches with @> operator" $ get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith` @@ -196,28 +192,49 @@ 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\"}]}]" + [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|] it "requesting parents and filtering parent columns" $ get "/projects?id=eq.1&select=id, name, clients{id}" `shouldRespondWith` - "[{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1}}]" + [str|[{"id":1,"name":"Windows 7","clients":{"id":1}}]|] + it "rows with missing parents are included" $ + get "/projects?id=in.1,5&select=id,clients{id}" `shouldRespondWith` + [str|[{"id":1,"clients":{"id":1}},{"id":5,"clients":null}]|] + + it "rows with no children return [] instead of null" $ + get "/projects?id=in.5&select=id,tasks{id}" `shouldRespondWith` + [str|[{"id":5,"tasks":[]}]|] + 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}]}]}]" + [str|[{"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}]" + [str|[{"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":[]}]|] 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\"}]}]" + [str|[{"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" $ get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments{content}" `shouldRespondWith` - "[{\"user_id\":2,\"task_id\":6,\"comments\":[{\"content\":\"Needs to be delivered ASAP\"}]}]" + [str|[{"user_id":2,"task_id":6,"comments":[{"content":"Needs to be delivered ASAP"}]}]|] + it "detect relations in views from exposed schema that are based on tables in private schema and have columns renames" $ + get "/articles?id=eq.1&select=id,articleStars{users{*}}" `shouldRespondWith` + [str|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|] + + it "can select by column name" $ + get "/projects?id=in.1,3&select=id,name,client_id,client_id{id,name}" `shouldRespondWith` + [str|[{"id":1,"name":"Windows 7","client_id":1,"client_id":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client_id":{"id":2,"name":"Apple"}}]|] + + it "can select by column name sans id" $ + get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith` + [str|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|] + + describe "Plurality singular" $ do it "will select an existing object" $ request methodGet "/items?id=eq.5" [("Prefer","plurality=singular")] "" @@ -244,7 +261,7 @@ it "can shape plurality singular object routes" $ request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [("Prefer","plurality=singular")] "" `shouldRespondWith` - "{\"id\":1,\"name\":\"Windows 7\",\"clients\":{\"id\":1,\"name\":\"Microsoft\"},\"tasks\":[{\"id\":1,\"name\":\"Design w7\"},{\"id\":2,\"name\":\"Code w7\"}]}" + [str|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|] describe "ordering response" $ do @@ -351,8 +368,7 @@ [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |] describe "remote procedure call" $ do - context "a proc that returns a set" . before_ (clearTable "items" >> createItems 10) . - after_ (clearTable "items") $ + context "a proc that returns a set" $ it "returns proper json" $ post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith` [json| [ {"id": 3}, {"id":4} ] |] diff --git a/test/Feature/RangeSpec.hs b/test/Feature/RangeSpec.hs --- a/test/Feature/RangeSpec.hs +++ b/test/Feature/RangeSpec.hs @@ -6,11 +6,15 @@ import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus)) +import Hasql as H +import Hasql.Postgres as P + import SpecHelper +import PostgREST.Types (DbStructure(..)) -spec :: Spec -spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items") - . around withApp $ +spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec struct pool = beforeAll resetDb + . around (withApp cfgDefault struct pool) $ describe "GET /items" $ do context "without range headers" $ do diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -4,12 +4,16 @@ import Test.Hspec.Wai import Test.Hspec.Wai.JSON +import Hasql as H +import Hasql.Postgres as P + import SpecHelper +import PostgREST.Types (DbStructure(..)) import Network.HTTP.Types -spec :: Spec -spec = around withApp $ do +spec :: DbStructure -> H.Pool P.Postgres -> Spec +spec struct pool = around (withApp cfgDefault struct pool) $ do describe "GET /" $ do it "lists views in schema" $ request methodGet "/" [] "" @@ -24,6 +28,7 @@ , {"schema":"test","name":"has_count_column","insertable":false} , {"schema":"test","name":"has_fk","insertable":true} , {"schema":"test","name":"insertable_view_with_join","insertable":true} + , {"schema":"test","name":"insertonly","insertable":true} , {"schema":"test","name":"items","insertable":true} , {"schema":"test","name":"json","insertable":true} , {"schema":"test","name":"materialized_view","insertable":false} @@ -208,16 +213,14 @@ } |] - it "includes foreign key data" $ do - pendingWith "have to resolve issue #107" - + it "includes foreign key data" $ request methodOptions "/has_fk" [] "" `shouldRespondWith` [json| { "pkey": ["id"], "columns":[ { - "default": "nextval('\"1\".has_fk_id_seq'::regclass)", + "default": "nextval('test.has_fk_id_seq'::regclass)", "precision": 64, "updatable": true, "schema": "test", @@ -239,7 +242,7 @@ "nullable": true, "position": 2, "enum": [], - "references": {"table": "auto_incrementing_pk", "column": "id"} + "references": {"schema":"test", "table": "auto_incrementing_pk", "column": "id"} }, { "default": null, "precision": null, @@ -251,7 +254,7 @@ "nullable": true, "position": 3, "enum": [], - "references": {"table": "simple_pk", "column": "k"} + "references": {"schema":"test", "table": "simple_pk", "column": "k"} } ] } diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,7 +2,36 @@ import Test.Hspec import SpecHelper -import Spec +--import PostgREST.Types (DbStructure(..)) + +import qualified Feature.AuthSpec +import qualified Feature.CorsSpec +import qualified Feature.DeleteSpec +import qualified Feature.InsertSpec +import qualified Feature.QueryLimitedSpec +import qualified Feature.QuerySpec +import qualified Feature.RangeSpec +import qualified Feature.StructureSpec + main :: IO () -main = resetDb >> hspec spec +main = do + setupDb + + pool <- specDbPool + dbStructure <- specDbStructure pool + + -- Not using hspec-discover because we want to precompute + -- the db structure and pass it to specs for speed + hspec $ specs dbStructure pool + + where + specs dbStructure pool = do + describe "Feature.AuthSpec" $ Feature.AuthSpec.spec dbStructure pool + describe "Feature.CorsSpec" $ Feature.CorsSpec.spec dbStructure pool + describe "Feature.DeleteSpec" $ Feature.DeleteSpec.spec dbStructure pool + describe "Feature.InsertSpec" $ Feature.InsertSpec.spec dbStructure pool + describe "Feature.QueryLimitedSpec" $ Feature.QueryLimitedSpec.spec dbStructure pool + describe "Feature.QuerySpec" $ Feature.QuerySpec.spec dbStructure pool + describe "Feature.RangeSpec" $ Feature.RangeSpec.spec dbStructure pool + describe "Feature.StructureSpec" $ Feature.StructureSpec.spec dbStructure pool diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 --- a/test/Spec.hs +++ /dev/null @@ -1,1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-} diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -12,8 +12,8 @@ import Data.Monoid import Data.Text hiding (map) import qualified Data.Vector as V +import Data.Time.Clock.POSIX (getPOSIXTime) import Control.Monad (void) -import Control.Applicative import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange, hRange, hAuthorization, hAccept) @@ -25,67 +25,67 @@ import System.Process (readProcess) import Web.JWT (secret) -import qualified Data.Aeson.Types as J - import PostgREST.App (app) import PostgREST.Config (AppConfig(..)) import PostgREST.Middleware import PostgREST.Error(pgErrResponse) import PostgREST.DbStructure +import PostgREST.Types dbString :: String -dbString = "postgres://postgrest_test@localhost:5432/postgrest_test" +dbString = "postgres://postgrest_test_authenticator@localhost:5432/postgrest_test" -isLeft :: Either a b -> Bool -isLeft (Left _ ) = True -isLeft _ = False +cfg :: String -> Maybe Int -> AppConfig +cfg conStr = AppConfig conStr 3000 "postgrest_test_anonymous" "test" (secret "safe") 10 -cfg :: AppConfig -cfg = AppConfig dbString 3000 "postgrest_anonymous" "test" (secret "safe") 10 +cfgDefault :: AppConfig +cfgDefault = cfg dbString Nothing +cfgLimitRows :: Int -> AppConfig +cfgLimitRows = cfg dbString . Just + testPoolOpts :: PoolSettings testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30 pgSettings :: P.Settings pgSettings = P.StringSettings $ cs dbString -withApp :: ActionWith Application -> IO () -withApp perform = do - pool :: H.Pool P.Postgres - <- H.acquirePool pgSettings testPoolOpts +specDbPool :: IO (H.Pool P.Postgres) +specDbPool = H.acquirePool pgSettings testPoolOpts - let txSettings = Just (H.ReadCommitted, Just True) - dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema cfg) - db <- either (fail . show) return dbOrError +specDbStructure :: H.Pool P.Postgres -> IO DbStructure +specDbStructure pool = do + dbOrError <- H.session pool $ H.tx specTxSettings + $ getDbStructure "test" + either (fail . show) return dbOrError +withApp :: AppConfig -> DbStructure -> H.Pool P.Postgres + -> ActionWith Application -> IO () +withApp config dbStructure pool perform = do perform $ middle $ \req resp -> do + time <- getPOSIXTime body <- strictRequestBody req - result <- liftIO $ H.session pool $ H.tx txSettings - $ runWithClaims cfg (app db cfg body) req + result <- liftIO $ H.session pool $ H.tx specTxSettings + $ runWithClaims config time (app dbStructure config body) req either (resp . pgErrResponse) resp result where middle = defaultMiddle - -resetDb :: IO () -resetDb = do - pool :: H.Pool P.Postgres - <- H.acquirePool pgSettings testPoolOpts - void . liftIO $ H.session pool $ - H.tx Nothing $ do - H.unitEx [H.stmt| drop schema if exists test cascade |] - H.unitEx [H.stmt| drop schema if exists private cascade |] - H.unitEx [H.stmt| drop schema if exists postgrest cascade |] - +setupDb :: IO () +setupDb = do + void $ readProcess "psql" ["-d", "postgres", "-a", "-f", "test/fixtures/database.sql"] [] loadFixture "roles" loadFixture "schema" + loadFixture "privileges" + resetDb +resetDb :: IO () +resetDb = loadFixture "data" loadFixture :: FilePath -> IO() loadFixture name = void $ readProcess "psql" ["-U", "postgrest_test", "-d", "postgrest_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] [] - rangeHdrs :: ByteRange -> [Header] rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)] @@ -114,69 +114,7 @@ clearTable table = do pool <- testPool void . liftIO $ H.session pool $ H.tx Nothing $ - H.unitEx $ B.Stmt ("delete from test."<>table) V.empty True - -clearProjectsTable :: IO () -clearProjectsTable = do - pool <- testPool - void . liftIO $ H.session pool $ H.tx Nothing $ - H.unitEx $ B.Stmt "delete from test.projects where id > 4" V.empty True - - -createItems :: Int -> IO () -createItems n = do - pool <- testPool - void . liftIO $ H.session pool $ H.tx Nothing txn - where - txn = mapM_ H.unitEx stmts - stmts = map [H.stmt|insert into test.items (id) values (?)|] [1..n] - -createComplexItems :: IO () -createComplexItems = do - pool <- testPool - void . liftIO $ H.session pool $ H.tx Nothing txn - where - txn = mapM_ H.unitEx stmts - stmts = getZipList $ [H.stmt|insert into test.complex_items (id, name, settings, arr_data) values (?,?,?,?)|] - <$> ZipList ([1..3]::[Int]) - <*> ZipList (["One", "Two", "Three"]::[Text]) - <*> ZipList [jobj,jobj,jobj] - <*> ZipList ([[1], [1,2], [1,2,3]]::[[Int]]) - jobj = J.object [("foo", J.object [("int", J.Number 1),("bar", J.String "baz")])] - -createNulls :: Int -> IO () -createNulls n = do - pool <- testPool - void . liftIO $ H.session pool $ H.tx Nothing txn - where - txn = mapM_ H.unitEx (stmt':stmts) - stmt' = [H.stmt|insert into test.no_pk (a,b) values (null,null)|] - stmts = map [H.stmt|insert into test.no_pk (a,b) values (?,0)|] [1..n] - -createNullInteger :: IO () -createNullInteger = do - pool <- testPool - void . liftIO $ H.session pool $ H.tx Nothing $ - H.unitEx $ [H.stmt| insert into "test".nullable_integer (a) values (null) |] - -createLikableStrings :: IO () -createLikableStrings = do - pool <- testPool - void . liftIO $ H.session pool $ H.tx Nothing $ do - H.unitEx $ insertSimplePk "xyyx" "u" - H.unitEx $ insertSimplePk "xYYx" "v" - where - insertSimplePk :: Text -> Text -> H.Stmt P.Postgres - insertSimplePk = [H.stmt|insert into test.simple_pk (k, extra) values (?,?)|] + H.unitEx $ B.Stmt ("truncate table test." <> table <> " cascade") V.empty True -createJsonData :: IO () -createJsonData = do - pool <- testPool - void . liftIO $ H.session pool $ H.tx Nothing $ - H.unitEx $ - [H.stmt| - insert into test.json (data) values (?) - |] - (J.object [("id", J.Number 1) - ,("foo", J.object [("bar", J.String "baz")]) - ]) +specTxSettings :: Maybe (TxIsolationLevel, Maybe Bool) +specTxSettings = Just (H.ReadCommitted, Just True)