Fix some OpenAPI issues (PostgREST#970)

* Fix PostgREST#933, update externals docs url to current version

* Fix PostgREST#962, openApi don't err on nonexistent schema

* Fix PostgREST#954, make OpenAPI rpc output dependent on user privileges

CHANGELOG.md

@@ -13,6 +13,9 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 ### Fixed
 
 - #968, Treat blank proxy uri as missing - @begriffs
+- #933, OpenAPI externals docs url to current version - @steve-chavez
+- #962, OpenAPI don't err on nonexistent schema - @steve-chavez
+- #954, make OpenAPI rpc output dependent on user privileges - @steve-chavez
 
 ## [0.4.3.0] - 2017-09-06
 

postgrest.cabal

@@ -127,6 +127,7 @@ Test-Suite spec
                      , Feature.UnicodeSpec
                      , Feature.AndOrParamsSpec
                      , Feature.RpcSpec
+                     , Feature.NonexistentSchemaSpec
                      , SpecHelper
                      , TestTypes
   Build-Depends:       aeson

src/PostgREST/App.hs

@@ -268,8 +268,8 @@ app dbStructure conf apiRequest =
               uri Nothing = ("http", host, port, "/")
               uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b)
               uri' = uri proxy
-              encodeApi ti sd = encodeOpenAPI (M.elems allProcs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
-          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription
+              encodeApi ti sd procs = encodeOpenAPI (M.elems procs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure)
+          body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
         _ -> return notFound

src/PostgREST/Config.hs

@@ -14,6 +14,7 @@ turned in configurable behaviour if needed.
 Other hardcoded options such as the minimum version number also belong here.
 -}
 module PostgREST.Config ( prettyVersion
+                        , docsVersion
                         , readOptions
                         , corsPolicy
                         , minimumPgVersion
@@ -33,7 +34,7 @@ import           Data.Configurator.Types     (Value(..))
 import           Data.List                   (lookup)
 import           Data.Monoid
 import           Data.Scientific             (floatingOrInteger)
-import           Data.Text                   (strip, intercalate, lines)
+import           Data.Text                   (strip, intercalate, lines, dropAround)
 import           Data.Text.Encoding          (encodeUtf8)
 import           Data.Text.IO                (hPutStrLn)
 import           Data.Version                (versionBranch)
@@ -92,6 +93,10 @@ corsPolicy req = case lookup "origin" headers of
 prettyVersion :: Text
 prettyVersion = intercalate "." $ map show $ versionBranch version
 
+-- | Version number used in docs
+docsVersion :: Text
+docsVersion = "v" <> dropAround (== '.') (dropAround (/= '.') prettyVersion)
+
 -- | Function to read and parse options from the command line
 readOptions :: IO AppConfig
 readOptions = do

src/PostgREST/DbStructure.hs

@@ -6,6 +6,7 @@
 module PostgREST.DbStructure (
   getDbStructure
 , accessibleTables
+, accessibleProcs
 , schemaDescription
 ) where
 
@@ -35,7 +36,7 @@ getDbStructure schema = do
   syns <- H.query () $ allSynonyms cols
   rels <- H.query () $ allRelations tabs cols
   keys <- H.query () $ allPrimaryKeys tabs
-  procs <- H.query schema accessibleProcs
+  procs <- H.query schema allProcs
 
   let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels
       cols' = addForeignKeys rels' cols
@@ -100,59 +101,64 @@ decodeSynonyms cols =
     <*> HD.value HD.text <*> HD.value HD.text
     <*> HD.value HD.text <*> HD.value HD.text
 
+decodeProcs :: HD.Result (M.HashMap Text ProcDescription)
+decodeProcs =
+  M.fromList . map addName <$> HD.rowsList tblRow
+  where
+    tblRow = ProcDescription
+              <$> HD.value HD.text
+              <*> HD.nullableValue HD.text
+              <*> (parseArgs <$> HD.value HD.text)
+              <*> (parseRetType
+                  <$> HD.value HD.text
+                  <*> HD.value HD.text
+                  <*> HD.value HD.bool
+                  <*> HD.value HD.char)
+              <*> (parseVolatility <$> HD.value HD.char)
+
+    addName :: ProcDescription -> (Text, ProcDescription)
+    addName pd = (pdName pd, pd)
+
+    parseArgs :: Text -> [PgArg]
+    parseArgs = mapMaybe (parseArg . strip) . split (==',')
+
+    parseArg :: Text -> Maybe PgArg
+    parseArg a =
+      let (body, def) = breakOn " DEFAULT " a
+          (name, typ) = breakOn " " body in
+      if T.null typ
+         then Nothing
+         else Just $
+           PgArg (dropAround (== '"') name) (strip typ) (T.null def)
+
+    parseRetType :: Text -> Text -> Bool -> Char -> RetType
+    parseRetType schema name isSetOf typ
+      | isSetOf   = SetOf pgType
+      | otherwise = Single pgType
+      where
+        qi = QualifiedIdentifier schema name
+        pgType = case typ of
+          'c' -> Composite qi
+          'p' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
+                   then Composite qi
+                   else Scalar qi
+          _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
+
+    parseVolatility :: Char -> ProcVolatility
+    parseVolatility v | v == 'i' = Immutable
+                      | v == 's' = Stable
+                      | otherwise = Volatile -- only 'v' can happen here
+
+allProcs :: H.Query Schema (M.HashMap Text ProcDescription)
+allProcs = H.statement (toS procsSqlQuery) (HE.value HE.text) decodeProcs True
+
 accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription)
-accessibleProcs =
-  H.statement sql (HE.value HE.text)
-    (M.fromList . map addName <$>
-      HD.rowsList (
-        ProcDescription <$> HD.value HD.text
-                        <*> HD.nullableValue HD.text
-                        <*> (parseArgs <$> HD.value HD.text)
-                        <*> (parseRetType <$>
-                            HD.value HD.text <*>
-                            HD.value HD.text <*>
-                            HD.value HD.bool <*>
-                            HD.value HD.char)
-                        <*> (parseVolatility <$>
-                            HD.value HD.char)
-      )
-    ) True
- where
-  addName :: ProcDescription -> (Text, ProcDescription)
-  addName pd = (pdName pd, pd)
-
-  parseArgs :: Text -> [PgArg]
-  parseArgs = mapMaybe (parseArg . strip) . split (==',')
-
-  parseArg :: Text -> Maybe PgArg
-  parseArg a =
-    let (body, def) = breakOn " DEFAULT " a
-        (name, typ) = breakOn " " body in
-    if T.null typ
-       then Nothing
-       else Just $
-         PgArg (dropAround (== '"') name) (strip typ) (T.null def)
-
-  parseRetType :: Text -> Text -> Bool -> Char -> RetType
-  parseRetType schema name isSetOf typ
-    | isSetOf   = SetOf pgType
-    | otherwise = Single pgType
-    where
-      qi = QualifiedIdentifier schema name
-      pgType = case typ of
-        'c' -> Composite qi
-        'p' -> if name == "record" -- Only pg pseudo type that is a row type is 'record'
-                 then Composite qi
-                 else Scalar qi
-        _   -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange
-
-  parseVolatility :: Char -> ProcVolatility
-  parseVolatility 'i' = Immutable
-  parseVolatility 's' = Stable
-  parseVolatility 'v' = Volatile
-  parseVolatility _   = Volatile -- should not happen, but be pessimistic
+accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True
+  where
+    sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
 
-  sql = [q|
+procsSqlQuery :: SqlQuery
+procsSqlQuery = [q|
   SELECT p.proname as "proc_name",
          d.description as "proc_description",
          pg_get_function_arguments(p.oid) as "args",
@@ -167,11 +173,12 @@ accessibleProcs =
     JOIN pg_namespace tn ON tn.oid = t.typnamespace
     LEFT JOIN pg_class comp ON comp.oid = t.typrelid
     LEFT JOIN pg_catalog.pg_description as d on d.objoid = p.oid
-  WHERE  pn.nspname = $1|]
+  WHERE  pn.nspname = $1
+|]
 
 schemaDescription :: H.Query Schema (Maybe Text)
 schemaDescription =
-    H.statement sql (HE.value HE.text) (HD.singleRow $ HD.nullableValue HD.text) True
+    H.statement sql (HE.value HE.text) (join <$> HD.maybeRow (HD.nullableValue HD.text)) True
   where
     sql = [q|
       select

src/PostgREST/OpenAPI.hs

@@ -22,7 +22,7 @@ import           Protolude hiding              ((&), Proxy, get, intercalate, dr
 import           Data.Swagger
 
 import           PostgREST.ApiRequest        (ContentType(..))
-import           PostgREST.Config            (prettyVersion)
+import           PostgREST.Config            (prettyVersion, docsVersion)
 import           PostgREST.Types             (Table(..), Column(..), PgArg(..), ForeignKey(..),
                                               PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
 
@@ -260,7 +260,7 @@ postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
       & description ?~ d)
   & externalDocs ?~ ((mempty :: ExternalDocs)
     & description ?~ "PostgREST Documentation"
-    & url .~ URL "https://postgrest.com/en/latest/api.html")
+    & url .~ URL ("https://postgrest.com/en/" <> docsVersion <> "/api.html"))
   & host .~ h'
   & definitions .~ fromList (map (makeTableDef pks) ti)
   & parameters .~ fromList (makeParamDefs ti)

test/Feature/AuthSpec.hs

@@ -1,6 +1,5 @@
 module Feature.AuthSpec where
 
--- {{{ Imports
 import Text.Heredoc
 import Test.Hspec
 import Test.Hspec.Wai
@@ -11,7 +10,6 @@ import SpecHelper
 import Network.Wai (Application)
 
 import Protolude hiding (get)
--- }}}
 
 spec :: SpecWith Application
 spec = describe "authorization" $ do
@@ -39,6 +37,17 @@ spec = describe "authorization" $ do
       , matchHeaders = []
       }
 
+  it "denies execution on functions that anonymous does not own" $
+    post "/rpc/privileged_hello" [json|{"name": "anonymous"}|] `shouldRespondWith` 401
+
+  it "allows execution on a function that postgrest_test_author owns" $
+    let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in
+    request methodPost "/rpc/privileged_hello" [auth] [json|{"name": "jdoe"}|]
+      `shouldRespondWith` [json|"Privileged hello to jdoe"|]
+      { matchStatus = 200
+      , matchHeaders = [matchContentTypeJson]
+      }
+
   it "returns jwt functions as jwt tokens" $
     request methodPost "/rpc/login" [single]
       [json| { "id": "jdoe", "pass": "1234" } |]

test/Feature/NonexistentSchemaSpec.hs

@@ -0,0 +1,15 @@
+module Feature.NonexistentSchemaSpec where
+
+import Network.Wai (Application)
+import Protolude hiding (get)
+import Test.Hspec
+import Test.Hspec.Wai
+
+spec :: SpecWith Application
+spec =
+  describe "Non existent api schema" $ do
+    it "succeeds when requesting root path" $
+      get "/" `shouldRespondWith` 200
+
+    it "gives 404 when requesting a nonexistent table in this nonexistent schema" $
+      get "/nonexistent_table" `shouldRespondWith` 404

test/Feature/StructureSpec.hs

@@ -4,7 +4,9 @@ import Test.Hspec hiding (pendingWith)
 import Test.Hspec.Wai
 import Network.HTTP.Types
 
+import PostgREST.Config (docsVersion)
 import Control.Lens ((^?))
+import Data.Aeson.Types (Value (..))
 import Data.Aeson.Lens
 import Data.Aeson.QQ
 
@@ -27,7 +29,14 @@ spec = do
               (acceptHdrs "application/openapi+json") ""
         `shouldRespondWith` 415
 
-    describe "table" $
+    it "includes postgrest.com current version api docs" $ do
+      r <- simpleBody <$> get "/"
+
+      let docsUrl = r ^? key "externalDocs" . key "url"
+
+      liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.com/en/" <> docsVersion <> "/api.html"))
+
+    describe "table" $ do
 
       it "includes paths to tables" $ do
         r <- simpleBody <$> get "/"
@@ -76,7 +85,7 @@ spec = do
 
           deleteResponse `shouldBe` Just "No Content"
 
-    it "includes definitions to tables" $ do
+      it "includes definitions to tables" $ do
         r <- simpleBody <$> get "/"
 
         let def = r ^? key "definitions" . key "child_entities"
@@ -108,7 +117,21 @@ spec = do
               }
             |]
 
-    describe "RPC" $
+      it "doesn't include privileged table for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let tablePath = r ^? key "paths" . key "/authors_only"
+
+        liftIO $ tablePath `shouldBe` Nothing
+
+      it "includes table if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let tableTag = r ^? key "paths" . key "/authors_only"
+                      . key "post"  . key "tags"
+                      . nth 0
+        liftIO $ tableTag `shouldBe` Just [aesonQQ|"authors_only"|]
+
+    describe "RPC" $ do
 
       it "includes body schema for arguments" $ do
         r <- simpleBody <$> get "/"
@@ -162,6 +185,21 @@ spec = do
               }
             |]
 
+      it "doesn't include privileged function for anonymous" $ do
+        r <- simpleBody <$> get "/"
+        let funcPath = r ^? key "paths" . key "/rpc/privileged_hello"
+
+        liftIO $ funcPath `shouldBe` Nothing
+
+      it "includes function if user has permission" $ do
+        let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA"
+        r <- simpleBody <$> request methodGet "/" [auth] ""
+        let funcTag = r ^? key "paths" . key "/rpc/privileged_hello"
+                      . key "post"  . key "tags"
+                      . nth 0
+
+        liftIO $ funcTag `shouldBe` Just [aesonQQ|"(rpc) privileged_hello"|]
+
   describe "Allow header" $ do
 
     it "includes read/write verbs for writeable table" $ do