Add option for overriding root spec (#1317)

* Only for pg >= 9.6

* Disallow specifying schema on root-spec

* Increase memory test upper bound

CHANGELOG.md

@@ -13,6 +13,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - #1264, Add support for bulk RPC call - @steve-chavez
 - #1278, Add db-pool-timeout config option - @qu4tro
 - #1285, Abort on wrong database password - @qu4tro
+- #790, Allow override of OpenAPI spec through `root-spec` config option - @steve-chavez
 
 ### Fixed
 

postgrest.cabal

@@ -135,6 +135,7 @@ test-suite spec
                       Feature.QueryLimitedSpec
                       Feature.QuerySpec
                       Feature.RangeSpec
+                      Feature.RootSpec
                       Feature.RpcSpec
                       Feature.SingularSpec
                       Feature.StructureSpec

src/PostgREST/ApiRequest.hs

@@ -60,8 +60,8 @@ data Action = ActionCreate  | ActionRead
             deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
-            | TargetProc  QualifiedIdentifier
+            | TargetProc{tpQi :: QualifiedIdentifier, tpIsRootSpec :: Bool}
-            | TargetRoot
+            | TargetDefaultSpec -- The default spec offered at root "/"
             | TargetUnknown [Text]
             deriving Eq
 -- | How to return the inserted data
@@ -114,8 +114,8 @@ data ApiRequest = ApiRequest {
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest :: Schema -> Maybe QualifiedIdentifier -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest schema req reqBody
+userApiRequest schema rootSpec req reqBody
   | isTargetingProc && method `notElem` ["GET", "POST"] = Left ActionInappropriate
   | topLevelRange == emptyRange = Left InvalidRange
   | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) witness payload
@@ -161,7 +161,9 @@ userApiRequest schema req reqBody
                       ((<> ".") <$> "not":M.keys operators) ++
                       ((<> "(") <$> M.keys ftsOperators)
   isEmbedPath = T.isInfixOf "."
-  isTargetingProc = (== Just "rpc") $ listToMaybe path
+  isTargetingProc = case target of
+    TargetProc _ _ -> True
+    _              -> False
   contentType = decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type"
   columns | action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}] = toS <$> join (lookup "columns" qParams)
           | otherwise = Nothing
@@ -188,7 +190,7 @@ userApiRequest schema req reqBody
   topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
   action =
     case method of
-      "GET"      | target == TargetRoot -> ActionInspect
+      "GET"      | target == TargetDefaultSpec -> ActionInspect
                  | isTargetingProc -> ActionInvoke{isReadOnly=True}
                  | otherwise -> ActionRead
 
@@ -201,12 +203,13 @@ userApiRequest schema req reqBody
       "OPTIONS" -> ActionInfo
       _         -> ActionInspect
   target = case path of
-              []            -> TargetRoot
+    []            -> case rootSpec of
-              [table]       -> TargetIdent
+                       Just rsQi -> TargetProc rsQi True
-                              $ QualifiedIdentifier schema table
+                       Nothing   -> TargetDefaultSpec
-              ["rpc", proc] -> TargetProc
+    [table]       -> TargetIdent $ QualifiedIdentifier schema table
-                              $ QualifiedIdentifier schema proc
+    ["rpc", proc] -> TargetProc (QualifiedIdentifier schema proc) False
-              other         -> TargetUnknown other
+    other         -> TargetUnknown other
+
   shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}]
   relevantPayload | shouldParsePayload = rightToMaybe payload
                   | otherwise = Nothing

src/PostgREST/App.hs

@@ -66,7 +66,7 @@ postgrest conf refDbStructure pool getTime worker =
       Just dbStructure -> do
         response <- do
           -- Need to parse ?columns early because findProc needs it to solve overloaded functions
-          let apiReq = userApiRequest (configSchema conf) req body
+          let apiReq = userApiRequest (configSchema conf) (configRootSpec conf) req body
               apiReqCols = (,) <$> apiReq <*> (pRequestColumns =<< iColumns <$> apiReq)
           case apiReqCols of
             Left err -> return . errorResponseFor $ err
@@ -78,7 +78,7 @@ postgrest conf refDbStructure pool getTime worker =
                     (Just RawJSON{}, Just cls)      -> cls
                     _                               -> S.empty
                   proc = case iTarget apiRequest of
-                    TargetProc qi -> findProc qi cols (iPreferSingleObjectParameter apiRequest) $ dbProcs dbStructure
+                    TargetProc qi _ -> findProc qi cols (iPreferSingleObjectParameter apiRequest) $ dbProcs dbStructure
                     _ -> Nothing
                   handleReq = runWithClaims conf eClaims (app dbStructure proc cols conf) apiRequest
                   txMode = transactionMode proc (iAction apiRequest)
@@ -103,7 +103,7 @@ transactionMode proc action =
 
 app :: DbStructure -> Maybe ProcDescription -> S.Set FieldName -> AppConfig -> ApiRequest -> H.Transaction Response
 app dbStructure proc cols conf apiRequest =
-  case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) of
+  case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) (iTarget apiRequest) of
     Left errorResponse -> return errorResponse
     Right contentType ->
       case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of
@@ -259,7 +259,7 @@ app dbStructure proc cols conf apiRequest =
               let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
               return $ responseLBS status200 [allOrigins, acceptH] ""
 
-        (ActionInvoke _, TargetProc qi, Just pJson) ->
+        (ActionInvoke _, TargetProc qi _, Just pJson) ->
           let returnsScalar = case proc of
                 Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
                 _ -> False
@@ -290,7 +290,7 @@ app dbStructure proc cols conf apiRequest =
                       return . errorResponseFor . singularityError $ queryTotal
                     else return $ responseLBS status ([toHeader contentType, contentRange] ++ toHeaders hs) (toS body)
 
-        (ActionInspect, TargetRoot, Nothing) -> do
+        (ActionInspect, TargetDefaultSpec, Nothing) -> do
           let host = configHost conf
               port = toInteger $ configPort conf
               proxy = pickProxy $ toS <$> configProxyUri conf
@@ -300,6 +300,7 @@ app dbStructure proc cols conf apiRequest =
               toTableInfo :: [Table] -> [(Table, [Column], [Text])]
               toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn))
               encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure
+
           body <- encodeApi <$> H.statement schema accessibleTables <*> H.statement schema schemaDescription <*> H.statement schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
@@ -329,19 +330,18 @@ app dbStructure proc cols conf apiRequest =
         (,) <$> selectQuery
             <*> (requestToQuery schema False . DbMutate <$> mutationDbRequest s t)
 
-responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
+responseContentTypeOrError :: [ContentType] -> Action -> Target -> Either Response ContentType
-responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
+responseContentTypeOrError accepts action target = serves contentTypesForRequest accepts
   where
-    contentTypesForRequest =
+    contentTypesForRequest = case action of
-      case action of
+      ActionRead         ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
-        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+      ActionCreate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionUpdate       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionDelete       ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      ActionInvoke _     ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream] ++ [CTOpenAPI | tpIsRootSpec target]
-        ActionInvoke _ ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream]
+      ActionInspect      ->  [CTOpenAPI, CTApplicationJSON]
-        ActionInspect -> [CTOpenAPI, CTApplicationJSON]
+      ActionInfo         ->  [CTTextCSV]
-        ActionInfo ->    [CTTextCSV]
+      ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
-        ActionSingleUpsert ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
     serves sProduces cAccepts =
       case mutuallyAgreeable sProduces cAccepts of
         Nothing -> Left . errorResponseFor . ContentTypeError . map toMime $ cAccepts

src/PostgREST/Config.hs

@@ -58,8 +58,10 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
 
 import PostgREST.Error   (ApiRequestError (..))
 import PostgREST.Parsers (pRoleClaimKey)
-import PostgREST.Types   (JSPath, JSPathExp (..))
+import PostgREST.Types   (JSPath, JSPathExp (..),
-import Protolude         hiding (hPutStrLn, intercalate, take, (<>))
+                          QualifiedIdentifier (..))
+import Protolude         hiding (concat, hPutStrLn, intercalate, null,
+                          take, (<>))
 
 
 -- | Config file settings for the server
@@ -84,6 +86,8 @@ data AppConfig = AppConfig {
   , configSettings          :: [(Text, Text)]
   , configRoleClaimKey      :: Either ApiRequestError JSPath
   , configExtraSearchPath   :: [Text]
+
+  , configRootSpec          :: Maybe QualifiedIdentifier
   }
 
 configPoolTimeout' :: (Fractional a) => AppConfig -> a
@@ -142,12 +146,13 @@ readOptions = do
       return appConf
 
   where
+    dbSchema = reqString "db-schema"
     parseConfig =
       AppConfig
         <$> reqString "db-uri"
         <*> reqString "db-anon-role"
         <*> optString "server-proxy-uri"
-        <*> reqString "db-schema"
+        <*> dbSchema
         <*> (fromMaybe "!4" <$> optString "server-host")
         <*> (fromMaybe 3000 <$> optInt "server-port")
         <*> optString "server-unix-socket"
@@ -162,6 +167,7 @@ readOptions = do
         <*> (fmap (fmap coerceText) <$> C.subassocs "app.settings" C.value)
         <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> optValue "role-claim-key")
         <*> (maybe ["public"] splitExtraSearchPath <$> optValue "db-extra-search-path")
+        <*> ((\x y -> QualifiedIdentifier x <$> y) <$> dbSchema <*> optString "root-spec")
 
     parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI)
     parseJwtAudience k =
@@ -263,6 +269,10 @@ readOptions = do
           |
           |## extra schemas to add to the search_path of every request
           |# db-extra-search-path = "extensions, util"
+          |
+          |## stored proc that overrides the root "/" spec
+          |## it must be inside the db-schema
+          |# root-spec = "stored_proc_name"
           |]
 
 pathParser :: Parser FilePath

src/PostgREST/DbRequestBuilder.hs

@@ -9,7 +9,6 @@ A query tree is built in case of resource embedding. By inferring the relationsh
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE LambdaCase            #-}
-{-# LANGUAGE MultiWayIf            #-}
 {-# LANGUAGE NamedFieldPuns        #-}
 
 module PostgREST.DbRequestBuilder (
@@ -59,7 +58,7 @@ readRequest maxRows allRels proc apiRequest  =
       let target = iTarget apiRequest in
       case target of
         (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)
-        (TargetProc  (QualifiedIdentifier s pName) ) -> Just (s, tName)
+        (TargetProc  (QualifiedIdentifier s pName) _ ) -> Just (s, tName)
           where
             tName = case pdReturnType <$> proc of
               Just (SetOf (Composite qi))  -> qiName qi

src/PostgREST/Types.hs

@@ -179,6 +179,10 @@ data OrderTerm = OrderTerm {
 , otNullOrder :: Maybe OrderNulls
 } deriving (Show, Eq)
 
+{-|
+  Represents a pg identifier with a prepended schema name "schema.table"
+  When qiSchema is "", the schema is defined by the pg search_path
+-}
 data QualifiedIdentifier = QualifiedIdentifier {
   qiSchema :: Schema
 , qiName   :: TableName

test/Feature/RootSpec.hs

@@ -0,0 +1,30 @@
+module Feature.RootSpec where
+
+import Network.HTTP.Types
+import Network.Wai        (Application)
+
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude hiding (get)
+
+import SpecHelper
+
+spec :: SpecWith Application
+spec =
+  describe "root spec function" $ do
+    it "accepts application/openapi+json" $
+      request methodGet "/"
+        [("Accept","application/openapi+json")] "" `shouldRespondWith`
+        [json|{
+           "swagger": "2.0",
+           "info": {"title": "PostgREST API", "description": "This is a dynamic API generated by PostgREST"}
+          }|]
+        { matchHeaders = ["Content-Type" <:> "application/openapi+json; charset=utf-8"] }
+
+    it "accepts application/json" $
+      request methodGet "/"
+        [("Accept", "application/json")] "" `shouldRespondWith`
+        [json| [{"table": "items"}, {"table": "subitems"}] |]
+        { matchHeaders = [matchContentTypeJson] }

test/Main.hs

@@ -37,6 +37,7 @@ import qualified Feature.ProxySpec
 import qualified Feature.QueryLimitedSpec
 import qualified Feature.QuerySpec
 import qualified Feature.RangeSpec
+import qualified Feature.RootSpec
 import qualified Feature.RpcSpec
 import qualified Feature.SingularSpec
 import qualified Feature.StructureSpec
@@ -72,6 +73,7 @@ main = do
       asymJwkSetApp        = return $ postgrest (testCfgAsymJWKSet testDbConn)        refDbStructure pool getTime $ pure ()
       nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure ()
       extraSearchPathApp   = return $ postgrest (testCfgExtraSearchPath testDbConn)   refDbStructure pool getTime $ pure ()
+      rootSpecApp          = return $ postgrest (testCfgRootSpec testDbConn)          refDbStructure pool getTime $ pure ()
 
   let reset :: IO ()
       reset = resetDb testDbConn
@@ -139,3 +141,8 @@ main = do
     -- this test runs with an extra search path
     beforeAll_ reset . before extraSearchPathApp $
       describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec
+
+    -- this test runs with a root spec function override
+    when (actualPgVersion >= pgVersion96) $
+      beforeAll_ reset . before rootSpecApp $
+        describe "Feature.RootSpec" Feature.RootSpec.spec

test/SpecHelper.hs

@@ -23,7 +23,7 @@ import Test.Hspec.Wai
 import Text.Heredoc
 
 import PostgREST.Config (AppConfig (..))
-import PostgREST.Types  (JSPathExp (..))
+import PostgREST.Types  (JSPathExp (..), QualifiedIdentifier (..))
 import Protolude
 
 matchContentTypeJson :: MatchHeader
@@ -79,6 +79,8 @@ _baseCfg =  -- Connection Settings
             (Right [JSPKey "role"])
             -- Empty db-extra-search-path
             []
+            -- No root spec override
+            Nothing
 
 testCfg :: Text -> AppConfig
 testCfg testDbConn = _baseCfg { configDatabase = testDbConn }
@@ -126,6 +128,9 @@ testNonexistentSchemaCfg testDbConn = (testCfg testDbConn) { configSchema = "non
 testCfgExtraSearchPath :: Text -> AppConfig
 testCfgExtraSearchPath testDbConn = (testCfg testDbConn) { configExtraSearchPath = ["public", "extensions"] }
 
+testCfgRootSpec :: Text -> AppConfig
+testCfgRootSpec testDbConn = (testCfg testDbConn) { configRootSpec = Just $ QualifiedIdentifier "test" "root"}
+
 setupDb :: Text -> IO ()
 setupDb dbConn = do
   loadFixture dbConn "database"

test/fixtures/schema.sql

@@ -1680,3 +1680,36 @@ create function add_them(a integer, b integer)
 returns integer as $$
   select a + b;
 $$ language sql;
+
+create function root() returns jsonb as $_$
+declare
+openapi jsonb = $$
+  {
+    "swagger": "2.0",
+    "info":{
+      "title":"PostgREST API",
+      "description":"This is a dynamic API generated by PostgREST"
+    }
+  }
+$$;
+simple jsonb = $$
+  [
+    {
+      "table":"items"
+    },
+    {
+      "table":"subitems"
+    }
+  ]
+$$;
+begin
+case current_setting('request.header.accept', true)
+  when 'application/openapi+json' then
+    return openapi;
+  when 'application/json' then
+    return simple;
+  else
+    return openapi;
+  end case;
+end
+$_$ language plpgsql;

test/memory-tests.sh

@@ -106,7 +106,7 @@ jsonKeyTest "50M" "POST" "/rpc/leak?columns=blob" "170M"
 jsonKeyTest "50M" "POST" "/leak?columns=blob" "170M"
 jsonKeyTest "50M" "PATCH" "/leak?id=eq.1&columns=blob" "170M"
 
-postJsonArrayTest "1000" "/perf_articles?columns=id,body" "9M"
+postJsonArrayTest "1000" "/perf_articles?columns=id,body" "10M"
 postJsonArrayTest "10000" "/perf_articles?columns=id,body" "10M"
 postJsonArrayTest "100000" "/perf_articles?columns=id,body" "20M"