Fix #1181, correct qualify of function argument type

CHANGELOG.md

@@ -12,6 +12,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - #1182, Fix embedding on views with composite pks - @steve-chavez
 - #1180, Fix embedding on views with subselects in pg10 - @steve-chavez
 - #1197, Allow CORS for PUT - @bkylerussell
+- #1181, Correctly qualify function argument of custom type in public schema - @steve-chavez
 
 ## [5.1.0] - 2018-08-31
 

main/Main.hs

@@ -3,37 +3,38 @@
 module Main where
 
 
-import           PostgREST.App            (postgrest)
-import           PostgREST.Config         (AppConfig (..),
-                                           prettyVersion, readOptions)
-import           PostgREST.DbStructure    (getDbStructure, getPgVersion)
-import           PostgREST.Error          (encodeError)
-import           PostgREST.OpenAPI        (isMalformedProxyUri)
-import           PostgREST.Types          (DbStructure, Schema, PgVersion(..), minimumPgVersion)
-import           Protolude                hiding (hPutStrLn, replace)
+import           PostgREST.App              (postgrest)
+import           PostgREST.Config           (AppConfig (..),
+                                             prettyVersion, readOptions)
+import           PostgREST.DbStructure      (getDbStructure, getPgVersion)
+import           PostgREST.Error            (encodeError)
+import           PostgREST.OpenAPI          (isMalformedProxyUri)
+import           PostgREST.Types            (DbStructure, Schema, PgVersion(..), minimumPgVersion)
+import           Protolude                  hiding (hPutStrLn, replace)
 
 
-import           Control.AutoUpdate       (defaultUpdateSettings,
-                                           mkAutoUpdate, updateAction)
-import           Control.Retry            (RetryStatus, capDelay,
-                                           exponentialBackoff,
-                                           retrying, rsPreviousDelay)
-import qualified Data.ByteString          as BS
-import qualified Data.ByteString.Base64   as B64
-import           Data.IORef               (IORef, atomicWriteIORef,
-                                           newIORef, readIORef)
-import           Data.String              (IsString (..))
-import           Data.Text                (pack, replace, stripPrefix, strip)
-import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
-import           Data.Text.IO             (hPutStrLn)
-import           Data.Time.Clock          (getCurrentTime)
-import qualified Hasql.Pool               as P
-import qualified Hasql.Session            as H
-import           Network.Wai.Handler.Warp (defaultSettings,
-                                           runSettings, setHost,
-                                           setPort, setServerName)
-import           System.IO                (BufferMode (..),
-                                           hSetBuffering)
+import           Control.AutoUpdate         (defaultUpdateSettings,
+                                             mkAutoUpdate, updateAction)
+import           Control.Retry              (RetryStatus, capDelay,
+                                             exponentialBackoff,
+                                             retrying, rsPreviousDelay)
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Base64     as B64
+import           Data.IORef                 (IORef, atomicWriteIORef,
+                                             newIORef, readIORef)
+import           Data.String                (IsString (..))
+import           Data.Text                  (pack, replace, stripPrefix, strip)
+import           Data.Text.Encoding         (decodeUtf8, encodeUtf8)
+import           Data.Text.IO               (hPutStrLn)
+import           Data.Time.Clock            (getCurrentTime)
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Session              as H
+import qualified Hasql.Transaction.Sessions as HT
+import           Network.Wai.Handler.Warp   (defaultSettings,
+                                             runSettings, setHost,
+                                             setPort, setServerName)
+import           System.IO                  (BufferMode (..),
+                                             hSetBuffering)
 
 #ifndef mingw32_HOST_OS
 import           System.Posix.Signals
@@ -82,7 +83,7 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
               ("Cannot run in this PostgreSQL version, PostgREST needs at least "
               <> pgvName minimumPgVersion)
             killThread mainTid
-          dbStructure <- getDbStructure schema actualPgVersion
+          dbStructure <- HT.transaction HT.ReadCommitted HT.Read $ getDbStructure schema actualPgVersion
           liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure
         case result of
           Left e -> do

postgrest.cabal

@@ -35,6 +35,7 @@ executable postgrest
                      , base >= 4.8 && < 4.10
                      , hasql >= 1.3 && < 1.4
                      , hasql-pool >= 0.5 && < 0.6
+                     , hasql-transaction >= 0.7 && < 0.8
                      , postgrest
                      , protolude == 0.2.2
                      , text
@@ -154,6 +155,7 @@ Test-Suite spec
                      , contravariant
                      , hasql >= 1.3 && < 1.4
                      , hasql-pool >= 0.5 && < 0.6
+                     , hasql-transaction >= 0.7 && < 0.8
                      , heredoc
                      , hjsonschema == 1.5.0.1
                      , hspec

src/PostgREST/DbStructure.hs

@@ -25,6 +25,7 @@ import           Data.Text                     (split, strip,
                                                 splitOn)
 import qualified Data.Text                     as T
 import qualified Hasql.Session                 as H
+import qualified Hasql.Transaction             as HT
 import           PostgREST.Types
 import           Text.InterpolatedString.Perl6 (q, qc)
 
@@ -32,14 +33,15 @@ import           GHC.Exts                      (groupWith)
 import           Protolude
 import           Unsafe (unsafeHead)
 
-getDbStructure :: Schema -> PgVersion -> H.Session DbStructure
+getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure
 getDbStructure schema pgVer = do
-  tabs      <- H.statement () allTables
-  cols      <- H.statement schema $ allColumns tabs
-  syns      <- H.statement schema $ allSynonyms cols pgVer
-  childRels <- H.statement () $ allChildRelations tabs cols
-  keys      <- H.statement () $ allPrimaryKeys tabs
-  procs     <- H.statement schema allProcs
+  HT.sql "set local schema ''" -- for getting the fully qualified name(schema.name) of every db object
+  tabs      <- HT.statement () allTables
+  cols      <- HT.statement schema $ allColumns tabs
+  syns      <- HT.statement schema $ allSynonyms cols pgVer
+  childRels <- HT.statement () $ allChildRelations tabs cols
+  keys      <- HT.statement () $ allPrimaryKeys tabs
+  procs     <- HT.statement schema allProcs
 
   let rels = addManyToManyRelations . addParentRelations $ addViewChildRelations syns childRels
       cols' = addForeignKeys rels cols

src/PostgREST/Middleware.hs

@@ -42,7 +42,7 @@ runWithClaims conf eClaims app req =
         appSettingsSql = pgFmtSetLocal mempty <$> configSettings conf
         setRoleSql = maybeToList $
           (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole
-        setSchemaSql = ["set schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text]
+        setSchemaSql = ["set local schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text]
         -- role claim defaults to anon if not specified in jwt
         claimsWithRole = M.union claims (M.singleton "role" anon)
         anon = JSON.String . toS $ configAnonRole conf

test/Feature/RpcSpec.hs

@@ -371,3 +371,8 @@ spec =
         get "/rpc/get_tsearch?text_search_vector=not.fts(english).fun%7Crat" `shouldRespondWith`
           [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|]
           { matchHeaders = [matchContentTypeJson] }
+
+    it "should work with an argument of custom type in public schema" $ do
+        get "/rpc/test_arg?my_arg=something" `shouldRespondWith`
+          [json|"foobar"|]
+          { matchHeaders = [matchContentTypeJson] }

test/Main.hs

@@ -4,6 +4,7 @@ import Test.Hspec
 import SpecHelper
 
 import qualified Hasql.Pool as P
+import qualified Hasql.Transaction.Sessions as HT
 
 import PostgREST.App (postgrest)
 import PostgREST.DbStructure (getDbStructure, getPgVersion)
@@ -46,7 +47,9 @@ main = do
 
   pool <- P.acquire (3, 10, toS testDbConn)
 
-  result <- P.use pool $ getDbStructure "test" =<< getPgVersion
+  result <- P.use pool $ do
+    ver <- getPgVersion
+    HT.transaction HT.ReadCommitted HT.Read $ getDbStructure "test" ver
 
   dbStructure <- pure $ either (panic.show) id result
 

test/fixtures/schema.sql

@@ -1602,3 +1602,9 @@ create table test.contract (
 create view test.player_view as select * from private.player;
 
 create view test.contract_view as select * from test.contract;
+
+create type public.my_type AS enum ('something');
+
+CREATE FUNCTION test.test_arg(my_arg public.my_type) RETURNS text AS $$
+  SELECT 'foobar'::text;
+$$ LANGUAGE sql;