search_path should not affect schemas

expected-schema/roles/codd_admin

@@ -1 +1 @@
-{"bypassrls":false,"canlogin":true,"config":null,"createdb":false,"createrole":true,"db_privileges":"[[\"cCT\", \"codd_admin\"]]","inherit":true,"membership":[],"replication":false,"superuser":false}
+{"bypassrls":false,"canlogin":true,"config":["search_path=public, collations_1"],"createdb":false,"createrole":true,"db_privileges":"[[\"cCT\", \"codd_admin\"]]","inherit":true,"membership":[],"replication":false,"superuser":false}

expected-schema/schemas/public/routines/floatmultirange;_floatrange

@@ -1 +1 @@
-{"argmodes":["v"],"argnames":null,"args":"VARIADIC floatrange[]","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"floatmultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}
+{"argmodes":["v"],"argnames":null,"args":"VARIADIC public.floatrange[]","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"floatmultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}

expected-schema/schemas/public/routines/floatmultirange;floatrange

@@ -1 +1 @@
-{"argmodes":null,"argnames":null,"args":"floatrange","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"floatmultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}
+{"argmodes":null,"argnames":null,"args":"public.floatrange","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"floatmultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}

expected-schema/schemas/public/routines/timemultirange;_timerange

@@ -1 +1 @@
-{"argmodes":["v"],"argnames":null,"args":"VARIADIC timerange[]","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"timemultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}
+{"argmodes":["v"],"argnames":null,"args":"VARIADIC public.timerange[]","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"timemultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}

expected-schema/schemas/public/routines/timemultirange;timerange

@@ -1 +1 @@
-{"argmodes":null,"argnames":null,"args":"timerange","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"timemultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}
+{"argmodes":null,"argnames":null,"args":"public.timerange","config":null,"definition_md5":null,"kind":"f","lang":"internal","leakproof":false,"nargs":1,"nargs_defaults":0,"owner":null,"parallel":"s","privileges":{"public":[["X",""]]},"return_type":"timemultirange","returns_set":false,"security_definer":false,"strict":true,"volatile":"i"}

expected-schema/schemas/public/tables/animals/cols/id

@@ -1 +1 @@
-{"collation":null,"collation_nsp":null,"default":"nextval('animals_id_seq'::regclass)","generated":"","hasdefault":true,"identity":"","inhcount":0,"local":true,"notnull":true,"order":1,"privileges":null,"type":"int4"}
+{"collation":null,"collation_nsp":null,"default":"nextval('public.animals_id_seq'::regclass)","generated":"","hasdefault":true,"identity":"","inhcount":0,"local":true,"notnull":true,"order":1,"privileges":null,"type":"int4"}

expected-schema/schemas/public/tables/employee/cols/employee_id

@@ -1 +1 @@
-{"collation":null,"collation_nsp":null,"default":"nextval('employee_employee_id_seq'::regclass)","generated":"","hasdefault":true,"identity":"","inhcount":0,"local":true,"notnull":true,"order":1,"privileges":null,"type":"int4"}
+{"collation":null,"collation_nsp":null,"default":"nextval('public.employee_employee_id_seq'::regclass)","generated":"","hasdefault":true,"identity":"","inhcount":0,"local":true,"notnull":true,"order":1,"privileges":null,"type":"int4"}

expected-schema/schemas/public/views/all_employee_names

@@ -1 +1 @@
-{"accessmethod":null,"amoptions":null,"compositetype":null,"definition_md5":"1016231b5f9b7fb2447b272e5d9c885a","forcerowsecurity":false,"kind":"v","owner":"codd_admin","partition":false,"persistence":"p","privileges":{"codd_admin":[["daxrtDw","codd_admin"]]},"replident":"n","rowsecurity":false,"rowtype":"all_employee_names","shared":false}
+{"accessmethod":null,"amoptions":null,"compositetype":null,"definition_md5":"ef867ea9db1f8413be91f8a510a7d0e8","forcerowsecurity":false,"kind":"v","owner":"codd_admin","partition":false,"persistence":"p","privileges":{"codd_admin":[["daxrtDw","codd_admin"]]},"replident":"n","rowsecurity":false,"rowtype":"all_employee_names","shared":false}

sql-migrations/all/2023-05-03-20-35-39-search-path-change-mig.sql

@@ -0,0 +1 @@
+alter role codd_admin set search_path to public, collations_1;

src/Codd/AppCommands/VerifySchema.hs

@@ -5,9 +5,9 @@ module Codd.AppCommands.VerifySchema
 import           Codd.Environment               ( CoddSettings(..) )
 import           Codd.Internal                  ( withConnection )
 import           Codd.Representations           ( logSchemasComparison
-                                                , readRepresentationsFromDbWithSettings
                                                 , readRepsFromDisk
                                                 )
+import           Codd.Representations.Database  ( readRepsFromDbWithNewTxn )
 import           Codd.Representations.Types     ( DbRep )
 import           Control.Monad                  ( when )
 import           Control.Monad.Logger           ( MonadLoggerIO
@@ -45,7 +45,7 @@ verifySchema dbInfoWithAllMigs@CoddSettings { onDiskReps, migsConnString } fromS
     dbSchema <- withConnection
       migsConnString
       (secondsToDiffTime 5)
-      (readRepresentationsFromDbWithSettings dbInfoDontApplyAnything)
+      (readRepsFromDbWithNewTxn dbInfoDontApplyAnything)
     when (dbSchema /= expectedSchemas) $ do
       logSchemasComparison dbSchema expectedSchemas
       liftIO $ exitWith (ExitFailure 1)

src/Codd/AppCommands/WriteSchema.hs

@@ -9,6 +9,7 @@ import qualified Codd.Internal                 as Codd
 import           Codd.Logging                   ( runErrorsOnlyLogger )
 import qualified Codd.Representations          as Codd
 import           Codd.Representations           ( detEncodeJSON )
+import           Codd.Representations.Database  ( readRepsFromDbWithNewTxn )
 import           Control.Monad.IO.Unlift        ( MonadIO(..)
                                                 , MonadUnliftIO
                                                 )
@@ -22,10 +23,9 @@ writeSchema
   :: (MonadUnliftIO m, MonadIO m) => CoddSettings -> WriteSchemaOpts -> m ()
 writeSchema dbInfo@CoddSettings { migsConnString } opts = case opts of
   WriteToDisk mdest -> runStdoutLoggingT $ do
-    dbSchema <- Codd.withConnection
-      migsConnString
-      (secondsToDiffTime 5)
-      (Codd.readRepresentationsFromDbWithSettings dbInfo)
+    dbSchema <- Codd.withConnection migsConnString
+                                    (secondsToDiffTime 5)
+                                    (readRepsFromDbWithNewTxn dbInfo)
     let
       dirToSave = case mdest of
         Just d  -> d
@@ -37,9 +37,9 @@ writeSchema dbInfo@CoddSettings { migsConnString } opts = case opts of
 
     Codd.persistRepsToDisk dbSchema dirToSave
   WriteToStdout -> runErrorsOnlyLogger $ do
-    dbSchema <- Codd.withConnection
-      migsConnString
-      (secondsToDiffTime 5)
-      (Codd.readRepresentationsFromDbWithSettings dbInfo)
+    dbSchema <- Codd.withConnection migsConnString
+                                    (secondsToDiffTime 5)
+                                    (readRepsFromDbWithNewTxn dbInfo)
 
     liftIO $ Text.putStr $ detEncodeJSON dbSchema
+

src/Codd/Internal.hs

@@ -22,7 +22,7 @@ import           Codd.Parsing                   ( AddedSqlMigration(..)
                                                 )
 import           Codd.Query                     ( execvoid_
                                                 , query
-                                                , unsafeQuery1
+                                                , unsafeQuery1, beginCommitTxnBracket
                                                 )
 import           Codd.Types                     ( RetryPolicy(..)
                                                 , TxnIsolationLvl(..)
@@ -57,14 +57,13 @@ import qualified Database.PostgreSQL.Simple    as DB
 import           System.Exit                    ( exitFailure )
 import           System.FilePath                ( (</>), takeFileName )
 import           UnliftIO                       ( MonadUnliftIO
-                                                , toIO, hClose
+                                                , hClose
                                                 )
 import           UnliftIO.Concurrent            ( threadDelay )
 import           UnliftIO.Directory             ( listDirectory )
 import           UnliftIO.Exception             ( IOException
                                                 , bracket
                                                 , handleJust
-                                                , onException
                                                 , throwIO
                                                 , tryJust, catchJust
                                                 )
@@ -123,30 +122,6 @@ isServerNotAvailableError e =
 isPermissionDeniedError :: DB.SqlError -> Bool
 isPermissionDeniedError e = DB.sqlState e == "42501"
 
--- | Returns a Query with a valid "BEGIN" statement that is READ WRITE and has
--- the desired isolation level.
-beginStatement :: TxnIsolationLvl -> DB.Query
-beginStatement = \case
-    DbDefault       -> "BEGIN READ WRITE"
-    Serializable    -> "BEGIN READ WRITE,ISOLATION LEVEL SERIALIZABLE"
-    RepeatableRead  -> "BEGIN READ WRITE,ISOLATION LEVEL REPEATABLE READ"
-    ReadCommitted   -> "BEGIN READ WRITE,ISOLATION LEVEL READ COMMITTED"
-    ReadUncommitted -> "BEGIN READ WRITE,ISOLATION LEVEL READ UNCOMMITTED"
-
-beginCommitTxnBracket
-    :: (MonadUnliftIO m, MonadIO m)
-    => TxnIsolationLvl
-    -> DB.Connection
-    -> m a
-    -> m a
-beginCommitTxnBracket isolLvl conn f = do
-    iof <- toIO f
-    liftIO $ do
-        execvoid_ conn $ beginStatement isolLvl
-        v <- iof `onException` DB.rollback conn
-        DB.commit conn
-        pure v
-
 data BootstrapCheck = BootstrapCheck {
     defaultConnAccessible :: Bool
     , coddSchemaExists :: Bool
@@ -314,7 +289,7 @@ collectPendingMigrations defaultConnString sqlMigrations txnIsolationLvl connect
             parseMigrationFiles migsAlreadyApplied sqlMigrations
 
 
-    
+
 
 -- | Opens a UTF-8 file allowing it to be read in streaming fashion.
 -- We can't use Streaming.fromHandle because it uses hGetLine, which removes '\n' from lines it
@@ -424,12 +399,13 @@ data ApplyMigsResult m a = ApplyMigsResult
 
 data CoddStateTransition = NoTransition | DefaultConnectionMadeAvailable
 
--- | Applies the supplied migrations, running blocks of (in-txn, same-connection-string) migrations with "txnBracket".
+-- | Applies the supplied migrations, running blocks of (in-txn, same-connection-string) migrations each within their own
+-- separate transactions.
 -- Behaviour here unfortunately is _really_ complex right now. Important notes:
 -- - Iff there's a single (in-txn, same-connection-string) block of migrations *with* the default connection string,
 --   then "actionAfter" runs in the same transaction (and thus in the same connection as well) as that block.
---   Otherwise - and including if there are no migrations - it runs after all migrations, not in an explicit transaction and
---   in the supplied connection - not necessarily in the same as the last migration's.
+--   Otherwise - and including if there are no migrations - it runs after all migrations, in an explicit transaction of
+--   its own and in the default connection - not necessarily in the same as the last migration's.
 baseApplyMigsBlock
     :: forall m a
      . (MonadUnliftIO m, MonadIO m, MonadLogger m)
@@ -453,7 +429,7 @@ baseApplyMigsBlock defaultConnInfo connectTimeout retryPol actionAfter isolLvl b
         -- and make sure to test the third code path very well.
         case blocksOfMigs of
             [] ->
-                withConnection defaultConnInfo connectTimeout $ fmap (ApplyMigsResult []) . actionAfter blocksOfMigs
+                withConnection defaultConnInfo connectTimeout $ \defaultConn -> beginCommitTxnBracket isolLvl defaultConn (ApplyMigsResult [] <$> actionAfter blocksOfMigs defaultConn)
             [block] | blockInTxn block && fromMaybe defaultConnInfo (blockCustomConnInfo block) == defaultConnInfo ->
                     -- Our very "special" and most common case case:
                     -- all migs being in-txn in the default connection-string
@@ -516,8 +492,8 @@ baseApplyMigsBlock defaultConnInfo connectTimeout retryPol actionAfter isolLvl b
                    unless (coddSchemaExists finalBootCheck) $ do
                      logInfoN "Creating codd_schema..."
                      createCoddSchema isolLvl defaultConn
-                   lift $ registerPendingMigrations defaultConn appliedMigs
-                   actAfterResult <- lift (actionAfter blocksOfMigs defaultConn)
+                   beginCommitTxnBracket isolLvl defaultConn $ lift $ registerPendingMigrations defaultConn appliedMigs
+                   actAfterResult <- beginCommitTxnBracket isolLvl defaultConn $ lift (actionAfter blocksOfMigs defaultConn)
 
                    pure $ ApplyMigsResult (map (\(am, t, _) -> (am, t)) appliedMigs) actAfterResult
 
@@ -571,7 +547,7 @@ baseApplyMigsBlock defaultConnInfo connectTimeout retryPol actionAfter isolLvl b
             else
                 ApplyMigsResult
                 <$> runMigs conn retryPol (allMigs migBlock) runAfterMig
-                <*> act conn
+                <*> beginCommitTxnBracket isolLvl conn (act conn)
 
 -- | This can be used as a last-action when applying migrations to
 -- strict-check schemas, logging differences, success and throwing

src/Codd/Query.hs

@@ -1,30 +1,65 @@
-module Codd.Query where
+module Codd.Query
+  ( execvoid_
+  , query
+  , unsafeQuery1
+  , beginCommitTxnBracket
+  ) where
 
+import           Codd.Types                     ( TxnIsolationLvl(..) )
 import           Control.Monad                  ( void )
 import qualified Database.PostgreSQL.Simple    as DB
-import           UnliftIO                       ( MonadIO(..) )
+import           UnliftIO                       ( MonadIO(..)
+                                                , MonadUnliftIO
+                                                , onException
+                                                , toIO
+                                                )
 
 execvoid_ :: MonadIO m => DB.Connection -> DB.Query -> m ()
 execvoid_ conn q = liftIO $ void $ DB.execute_ conn q
 
 query
-    :: (DB.FromRow b, MonadIO m, DB.ToRow a)
-    => DB.Connection
-    -> DB.Query
-    -> a
-    -> m [b]
+  :: (DB.FromRow b, MonadIO m, DB.ToRow a)
+  => DB.Connection
+  -> DB.Query
+  -> a
+  -> m [b]
 query conn q r = liftIO $ DB.query conn q r
 
 -- | Throws an exception if 0 or more than 1 results are returned.
 unsafeQuery1
-    :: (DB.FromRow b, MonadIO m, DB.ToRow a)
-    => DB.Connection
-    -> DB.Query
-    -> a
-    -> m b
+  :: (DB.FromRow b, MonadIO m, DB.ToRow a)
+  => DB.Connection
+  -> DB.Query
+  -> a
+  -> m b
 unsafeQuery1 conn q r = liftIO $ do
-    res <- DB.query conn q r
-    case res of
-        []  -> error "No results for query1"
-        [x] -> return x
-        _   -> error "More than one result for query1"
+  res <- DB.query conn q r
+  case res of
+    []  -> error "No results for query1"
+    [x] -> return x
+    _   -> error "More than one result for query1"
+
+
+-- | Returns a Query with a valid "BEGIN" statement that is READ WRITE and has
+-- the desired isolation level.
+beginStatement :: TxnIsolationLvl -> DB.Query
+beginStatement = \case
+  DbDefault       -> "BEGIN READ WRITE"
+  Serializable    -> "BEGIN READ WRITE,ISOLATION LEVEL SERIALIZABLE"
+  RepeatableRead  -> "BEGIN READ WRITE,ISOLATION LEVEL REPEATABLE READ"
+  ReadCommitted   -> "BEGIN READ WRITE,ISOLATION LEVEL READ COMMITTED"
+  ReadUncommitted -> "BEGIN READ WRITE,ISOLATION LEVEL READ UNCOMMITTED"
+
+beginCommitTxnBracket
+  :: (MonadUnliftIO m, MonadIO m)
+  => TxnIsolationLvl
+  -> DB.Connection
+  -> m a
+  -> m a
+beginCommitTxnBracket isolLvl conn f = do
+  iof <- toIO f
+  liftIO $ do
+    execvoid_ conn $ beginStatement isolLvl
+    v <- iof `onException` DB.rollback conn
+    DB.commit conn
+    pure v