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

@@ -29,6 +29,7 @@ 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)
@@ -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
+  HT.sql "set local schema ''" -- for getting the fully qualified name(schema.name) of every db object
-  cols      <- H.statement schema $ allColumns tabs
+  tabs      <- HT.statement () allTables
-  syns      <- H.statement schema $ allSynonyms cols pgVer
+  cols      <- HT.statement schema $ allColumns tabs
-  childRels <- H.statement () $ allChildRelations tabs cols
+  syns      <- HT.statement schema $ allSynonyms cols pgVer
-  keys      <- H.statement () $ allPrimaryKeys tabs
+  childRels <- HT.statement () $ allChildRelations tabs cols
-  procs     <- H.statement schema allProcs
+  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;