beam-postgres 0.5.3.1 → 0.5.4.0

raw patch · 10 files changed

+189/−59 lines, 10 filesdep +testcontainersdep −tmp-postgresnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: testcontainers

Dependencies removed: tmp-postgres

API changes (from Hackage documentation)

Files

• ChangeLog.md +14/−3
• Database/Beam/Postgres.hs +3/−2
• Database/Beam/Postgres/Connection.hs +8/−4
• Database/Beam/Postgres/Full.hs +4/−2
• Database/Beam/Postgres/Migrate.hs +38/−18
• Database/Beam/Postgres/PgSpecific.hs +6/−5
• Database/Beam/Postgres/Syntax.hs +27/−4
• beam-postgres.cabal +8/−8
• test/Database/Beam/Postgres/Test/Migrate.hs +41/−0
• test/Main.hs +40/−13

@@ -1,17 +1,28 @@+# 0.5.4.0++## Added features++ * Better error messages on column type mismatches (#696).+ * Added support for creating and dropping database schemas and associated tables with `createDatabaseSchema`, `dropDatabaseSchema`, `` and `createTableWithSchema` (#716).++## Documentation+ + * Make `runBeamPostgres` and `runBeamPostgresDebug` easier to find (#663).+ # 0.5.3.1 -# Added features+## Added features   * Loosen some version bounds  # 0.5.3.0 -# Bug fixes+## Bug fixes   * Make sure lateral join names do not overlap  * Fix `bool_or` -# Addded features+## Addded features   * Add `runSelectReturningFirst`  * `IN (SELECT ...)` syntax via `inQuery_`

@@ -21,6 +21,9 @@   (  -- * Beam Postgres backend     Postgres(..), Pg, liftIOWithHandle +    -- ** Executing actions against the backend+  , runBeamPostgres, runBeamPostgresDebug+     -- ** Postgres syntax   , PgCommandSyntax, PgSyntax   , PgSelectSyntax, PgInsertSyntax@@ -40,8 +43,6 @@   , smallserial, serial, bigserial    , module Database.Beam.Postgres.PgSpecific--  , runBeamPostgres, runBeamPostgresDebug      -- ** Postgres extension support   , PgExtensionEntity, IsPgExtension(..)

@@ -154,12 +154,14 @@                           case pgErr of                             Pg.ConversionFailed { Pg.errSQLType = sql                                                 , Pg.errHaskellType = hs-                                                , Pg.errMessage = msg } ->-                              pure (ColumnTypeMismatch hs sql msg)+                                                , Pg.errMessage = msg+                                                , Pg.errSQLField = field } ->+                              pure (ColumnTypeMismatch hs sql ("Conversion failed for field'" <> field <> "': " <> msg))                             Pg.Incompatible { Pg.errSQLType = sql                                             , Pg.errHaskellType = hs-                                            , Pg.errMessage = msg } ->-                              pure (ColumnTypeMismatch hs sql msg)+                                            , Pg.errMessage = msg+                                            , Pg.errSQLField = field } ->+                              pure (ColumnTypeMismatch hs sql ("Incompatible field: '" <> field <> "': " <> msg))                             Pg.UnexpectedNull {} ->                               pure ColumnUnexpectedNull              in pure (Left (BeamRowReadError (Just (fromIntegral curCol)) err))@@ -307,6 +309,8 @@ -- @beam-postgres@ also provides functions that let you run queries without -- 'MonadBeam'. These functions may be more efficient and offer a conduit -- API. See "Database.Beam.Postgres.Conduit" for more information.+--+-- You can execute 'Pg' actions using 'runBeamPostgres' or 'runBeamPostgresDebug'. newtype Pg a = Pg { runPg :: F PgF a }     deriving (Monad, Applicative, Functor, MonadFree PgF) 

@@ -4,6 +4,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeOperators #-}  -- | Module providing (almost) full support for Postgres query and data -- manipulation statements. These functions shadow the functions in@@ -64,6 +65,7 @@  import           Control.Monad.Free.Church +import           Data.Kind (Type) import           Data.Proxy (Proxy(..)) import qualified Data.Text as T #if !MIN_VERSION_base(4, 11, 0)@@ -229,7 +231,7 @@  -- | What to do when an @INSERT@ statement inserts a row into the table @tbl@ -- that violates a constraint.-newtype PgInsertOnConflict (tbl :: (* -> *) -> *) =+newtype PgInsertOnConflict (tbl :: (Type -> Type) -> Type) =     PgInsertOnConflict (tbl (QField QInternal) -> PgInsertOnConflictSyntax)  -- | Postgres @LATERAL JOIN@ support@@ -397,7 +399,7 @@ -- * General @RETURNING@ support  class PgReturning cmd where-  type PgReturningType cmd :: * -> *+  type PgReturningType cmd :: Type -> Type    returning :: (Beamable tbl, Projectible Postgres a)             => cmd Postgres tbl -> (tbl (QExpr Postgres PostgresInaccessible) -> a)

@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -29,7 +31,7 @@   ) where  import           Database.Beam.Backend.SQL-import           Database.Beam.Migrate.Actions (defaultActionProvider)+import           Database.Beam.Migrate.Actions (defaultActionProvider, defaultSchemaActionProvider) import qualified Database.Beam.Migrate.Backend as Tool import qualified Database.Beam.Migrate.Checks as Db import qualified Database.Beam.Migrate.SQL as Db@@ -77,6 +79,8 @@ #endif import           Data.Word (Word64) +import           GHC.Generics ( Generic )+ -- | Top-level migration backend for use by @beam-migrate@ tools migrationBackend :: Tool.BeamMigrationBackend Postgres Pg migrationBackend = Tool.BeamMigrationBackend@@ -95,8 +99,12 @@                          postgresDataTypeDeserializers <>                          Db.beamCheckDeserializers)                         (BCL.unpack . (<> ";") . pgRenderSyntaxScript . fromPgCommand) "postgres.sql"-                        pgPredConverter (defaultActionProvider <> pgExtensionActionProvider <>-                                         pgCustomEnumActionProvider)+                        pgPredConverter (mconcat [ defaultActionProvider+                                                 , defaultSchemaActionProvider+                                                 , pgExtensionActionProvider+                                                 , pgCustomEnumActionProvider+                                                 ]+                                        )                         (\options action ->                             bracket (Pg.connectPostgreSQL (fromString options)) Pg.close $ \conn ->                               left show <$> withPgDebug (\_ -> pure ()) conn action)@@ -321,27 +329,37 @@   PgDataTypeSyntax (PgDataTypeDescrOid oid pgMod) (emit "{- UNKNOWN -}")                    (pgDataTypeJSON (object [ "oid" .= (fromIntegral oid' :: Word), "mod" .= pgMod ])) --- * Create constraints from a connection +newtype SchemaName = MkSchemaName T.Text+  deriving (Generic, Pg.FromRow)++-- * Create constraints from a connection getDbConstraints :: Pg.Connection -> IO [ Db.SomeDatabasePredicate ]-getDbConstraints = getDbConstraintsForSchemas Nothing+getDbConstraints conn = do +  schemata <- Pg.query_ conn "SELECT schema_name FROM information_schema.schemata WHERE schema_name NOT LIKE '%pg_%' AND schema_name <> 'information_schema' AND schema_name <> 'public';"+  case schemata of+    [] -> getDbConstraintsForSchemas Nothing conn+    schemata' -> +        (++) <$> getDbConstraintsForSchemas (Just ((\(MkSchemaName nm) -> T.unpack nm) <$> schemata')) conn+             <*> getDbConstraintsForSchemas Nothing conn  getDbConstraintsForSchemas :: Maybe [String] -> Pg.Connection -> IO [ Db.SomeDatabasePredicate ] getDbConstraintsForSchemas subschemas conn =-  do tbls <- case subschemas of-        Nothing -> Pg.query_ conn "SELECT cl.oid, relname FROM pg_catalog.pg_class \"cl\" join pg_catalog.pg_namespace \"ns\" on (ns.oid = relnamespace) where nspname = any (current_schemas(false)) and relkind='r'"-        Just ss -> Pg.query  conn "SELECT cl.oid, relname FROM pg_catalog.pg_class \"cl\" join pg_catalog.pg_namespace \"ns\" on (ns.oid = relnamespace) where nspname IN ? and relkind='r'" (Pg.Only (Pg.In ss))-     let tblsExist = map (\(_, tbl) -> Db.SomeDatabasePredicate (Db.TableExistsPredicate (Db.QualifiedName Nothing tbl))) tbls-+  do (tbls :: [(Pg.Oid, Maybe T.Text, T.Text)]) <- case subschemas of+        Nothing -> Pg.query_ conn "SELECT cl.oid, NULL, relname FROM pg_catalog.pg_class \"cl\" join pg_catalog.pg_namespace \"ns\" on (ns.oid = relnamespace) where nspname = any (current_schemas(false)) and relkind='r'"+        Just ss -> Pg.query  conn "SELECT cl.oid, nspname, relname FROM pg_catalog.pg_class \"cl\" join pg_catalog.pg_namespace \"ns\" on (ns.oid = relnamespace) where nspname IN ? and relkind='r'" (Pg.Only (Pg.In ss))+     let tblsExist = map (\(_, mschema, tbl) -> Db.SomeDatabasePredicate (Db.TableExistsPredicate (Db.QualifiedName mschema tbl))) tbls+         schemaChecks = fromMaybe [] $ (fmap (Db.SomeDatabasePredicate . Db.SchemaExistsPredicate . T.pack)) <$> subschemas      enumerationData <-        Pg.query_ conn          (fromString (unlines                       [ "SELECT t.typname, t.oid, array_agg(e.enumlabel ORDER BY e.enumsortorder)"                       , "FROM pg_enum e JOIN pg_type t ON t.oid = e.enumtypid"-                      , "GROUP BY t.typname, t.oid" ]))+                      , "GROUP BY t.typname, t.oid" +                      ]))        columnChecks <--       fmap mconcat . forM tbls $ \(oid, tbl) ->+       fmap mconcat . forM tbls $ \(oid, mschema, tbl) ->        do columns <- Pg.query conn "SELECT attname, atttypid, atttypmod, attnotnull, pg_catalog.format_type(atttypid, atttypmod) FROM pg_catalog.pg_attribute att WHERE att.attrelid=? AND att.attnum>0 AND att.attisdropped='f'"                        (Pg.Only (oid :: Pg.Oid))           let columnChecks = map (\(nm, typId :: Pg.Oid, typmod, _, typ :: ByteString) ->@@ -351,24 +369,26 @@                                                      pgDataTypeFromAtt typ typId typmod' <|>                                                      pgEnumerationTypeFromAtt enumerationData typ typId typmod' -                                    in Db.SomeDatabasePredicate (Db.TableHasColumn (Db.QualifiedName Nothing tbl) nm pgDataType :: Db.TableHasColumn Postgres)) columns+                                    in Db.SomeDatabasePredicate (Db.TableHasColumn (Db.QualifiedName mschema tbl) nm pgDataType :: Db.TableHasColumn Postgres)) columns               notNullChecks = concatMap (\(nm, _, _, isNotNull, _) ->                                            if isNotNull then-                                            [Db.SomeDatabasePredicate (Db.TableColumnHasConstraint (Db.QualifiedName Nothing tbl) nm (Db.constraintDefinitionSyntax Nothing Db.notNullConstraintSyntax Nothing)+                                            [Db.SomeDatabasePredicate (Db.TableColumnHasConstraint (Db.QualifiedName mschema tbl) nm (Db.constraintDefinitionSyntax Nothing Db.notNullConstraintSyntax Nothing)                                               :: Db.TableColumnHasConstraint Postgres)]                                            else [] ) columns -          pure (columnChecks ++ notNullChecks)+          pure (columnChecks ++ notNullChecks ++ schemaChecks)       primaryKeys <--       map (\(relnm, cols) -> Db.SomeDatabasePredicate (Db.TableHasPrimaryKey (Db.QualifiedName Nothing relnm) (V.toList cols))) <$>-       Pg.query_ conn (fromString (unlines [ "SELECT c.relname, array_agg(a.attname ORDER BY k.n ASC)"+       map (\(schema, relnm, cols) -> Db.SomeDatabasePredicate (Db.TableHasPrimaryKey (Db.QualifiedName schema relnm) (V.toList cols))) <$>+                                            -- We nullify the 'public' schema, which is the implicit default in Postgres+       Pg.query_ conn (fromString (unlines [ "SELECT NULLIF(ns.nspname, 'public'), c.relname, array_agg(a.attname ORDER BY k.n ASC)"                                            , "FROM pg_index i"                                            , "CROSS JOIN unnest(i.indkey) WITH ORDINALITY k(attid, n)"                                            , "JOIN pg_attribute a ON a.attnum=k.attid AND a.attrelid=i.indrelid"                                            , "JOIN pg_class c ON c.oid=i.indrelid"                                            , "JOIN pg_namespace ns ON ns.oid=c.relnamespace"-                                           , "WHERE ns.nspname = any (current_schemas(false)) AND c.relkind='r' AND i.indisprimary GROUP BY relname, i.indrelid" ]))+                                           -- Recall that schema of the form 'pg_' are Postgres internal tables that should not be taken into account+                                           , "WHERE nspname NOT LIKE '%pg_%' AND c.relkind='r' AND i.indisprimary GROUP BY nspname, relname, i.indrelid" ]))       let enumerations =            map (\(enumNm, _, options) -> Db.SomeDatabasePredicate (PgHasEnum enumNm (V.toList options))) enumerationData

@@ -141,6 +141,7 @@ import           Data.Functor import           Data.Hashable import           Data.Int+import           Data.Kind (Type) import qualified Data.List.NonEmpty as NE import           Data.Proxy import           Data.Scientific (Scientific, formatScientific, FPFormat(Fixed))@@ -308,10 +309,10 @@            -> QGenExpr context Postgres s text arrayDims_ (QExpr v) = QExpr (fmap (\(PgExpressionSyntax v') -> PgExpressionSyntax (emit "array_dims(" <> v' <> emit ")")) v) -type family CountDims (v :: *) :: Nat where+type family CountDims (v :: Type) :: Nat where   CountDims (V.Vector a) = 1 + CountDims a   CountDims a = 0-type family WithinBounds (dim :: Nat) (v :: *) :: Constraint where+type family WithinBounds (dim :: Nat) (v :: Type) :: Constraint where   WithinBounds dim v =     If ((dim <=? CountDims v) && (1 <=? dim))        (() :: Constraint)@@ -486,7 +487,7 @@ -- -- A reasonable example might be @Range PgInt8Range Int64@. -- This represents a range of Haskell @Int64@ values stored as a range of 'bigint' in Postgres.-data PgRange (n :: *) a+data PgRange (n :: Type) a   = PgEmptyRange   | PgRange (PgRangeBound a) (PgRangeBound a)   deriving (Eq, Show, Generic)@@ -789,7 +790,7 @@ -- section on -- <https://www.postgresql.org/docs/current/static/functions-json.html JSON>. ---class IsPgJSON (json :: * -> *) where+class IsPgJSON (json :: Type -> Type) where   -- | The @json_each@ or @jsonb_each@ function. Values returned as @json@ or   -- @jsonb@ respectively. Use 'pgUnnest' to join against the result   pgJsonEach     :: QGenExpr ctxt Postgres s (json a)@@ -1392,7 +1393,7 @@  -- ** Set-valued functions -data PgSetOf (tbl :: (* -> *) -> *)+data PgSetOf (tbl :: (Type -> Type) -> Type)  pgUnnest' :: forall tbl db s            . Beamable tbl

@@ -251,6 +251,7 @@ newtype PgAggregationSetQuantifierSyntax = PgAggregationSetQuantifierSyntax { fromPgAggregationSetQuantifier :: PgSyntax } newtype PgSelectSetQuantifierSyntax = PgSelectSetQuantifierSyntax { fromPgSelectSetQuantifier :: PgSyntax } newtype PgFromSyntax = PgFromSyntax { fromPgFrom :: PgSyntax }+newtype PgSchemaNameSyntax = PgSchemaNameSyntax { fromPgSchemaName :: PgSyntax } newtype PgTableNameSyntax = PgTableNameSyntax { fromPgTableName :: PgSyntax } newtype PgComparisonQuantifierSyntax = PgComparisonQuantifierSyntax { fromPgComparisonQuantifier :: PgSyntax } newtype PgExtractFieldSyntax = PgExtractFieldSyntax { fromPgExtractField :: PgSyntax }@@ -335,6 +336,9 @@   hashWithSalt salt (PgDataTypeDescrDomain t) =     hashWithSalt salt (1 :: Int, t) +newtype PgCreateSchemaSyntax = PgCreateSchemaSyntax { fromPgCreateSchema :: PgSyntax }+newtype PgDropSchemaSyntax = PgDropSchemaSyntax { fromPgDropSchema :: PgSyntax }+ newtype PgCreateTableSyntax = PgCreateTableSyntax { fromPgCreateTable :: PgSyntax } data PgTableOptionsSyntax = PgTableOptionsSyntax PgSyntax PgSyntax newtype PgColumnSchemaSyntax = PgColumnSchemaSyntax { fromPgColumnSchema :: PgSyntax } deriving (Show, Eq)@@ -410,6 +414,13 @@   deleteCmd = PgCommandSyntax PgCommandTypeDataUpdate . coerce   updateCmd = PgCommandSyntax PgCommandTypeDataUpdate . coerce +instance IsSql92DdlSchemaCommandSyntax PgCommandSyntax where+  type Sql92DdlCommandCreateSchemaSyntax PgCommandSyntax = PgCreateSchemaSyntax+  type Sql92DdlCommandDropSchemaSyntax PgCommandSyntax = PgDropSchemaSyntax++  createSchemaCmd = PgCommandSyntax PgCommandTypeDdl . coerce+  dropSchemaCmd = PgCommandSyntax PgCommandTypeDdl . coerce+ instance IsSql92DdlCommandSyntax PgCommandSyntax where   type Sql92DdlCommandCreateTableSyntax PgCommandSyntax = PgCreateTableSyntax   type Sql92DdlCommandDropTableSyntax PgCommandSyntax = PgDropTableSyntax@@ -419,6 +430,9 @@   dropTableCmd   = PgCommandSyntax PgCommandTypeDdl . coerce   alterTableCmd  = PgCommandSyntax PgCommandTypeDdl . coerce +instance IsSql92SchemaNameSyntax PgSchemaNameSyntax where+  schemaName s = PgSchemaNameSyntax (pgQuotedIdentifier s)+ instance IsSql92TableNameSyntax PgTableNameSyntax where   tableName Nothing t = PgTableNameSyntax (pgQuotedIdentifier t)   tableName (Just s) t = PgTableNameSyntax (pgQuotedIdentifier s <> emit "." <> pgQuotedIdentifier t)@@ -677,13 +691,10 @@ instance IsCustomSqlSyntax PgExpressionSyntax where   newtype CustomSqlSyntax PgExpressionSyntax =     PgCustomExpressionSyntax { fromPgCustomExpression :: PgSyntax }-    deriving Monoid+    deriving (Semigroup, Monoid)   customExprSyntax = PgExpressionSyntax . fromPgCustomExpression   renderSyntax = PgCustomExpressionSyntax . pgParens . fromPgExpression -instance Semigroup (CustomSqlSyntax PgExpressionSyntax) where-  (<>) = mappend- instance IsString (CustomSqlSyntax PgExpressionSyntax) where   fromString = PgCustomExpressionSyntax . emit . fromString @@ -1043,6 +1054,18 @@ instance IsSql92AlterColumnActionSyntax PgAlterColumnActionSyntax where   setNullSyntax = PgAlterColumnActionSyntax (emit "DROP NOT NULL")   setNotNullSyntax = PgAlterColumnActionSyntax (emit "SET NOT NULL")++instance IsSql92SchemaNameSyntax PgSchemaNameSyntax => IsSql92CreateSchemaSyntax PgCreateSchemaSyntax where+  type Sql92CreateSchemaSchemaNameSyntax PgCreateSchemaSyntax = PgSchemaNameSyntax++  createSchemaSyntax schemaName = PgCreateSchemaSyntax $+    emit "CREATE SCHEMA " <> fromPgSchemaName schemaName++instance IsSql92SchemaNameSyntax PgSchemaNameSyntax => IsSql92DropSchemaSyntax PgDropSchemaSyntax where+  type Sql92DropSchemaSchemaNameSyntax PgDropSchemaSyntax = PgSchemaNameSyntax++  dropSchemaSyntax schemaName = PgDropSchemaSyntax $+    emit "DROP SCHEMA " <> fromPgSchemaName schemaName  instance IsSql92CreateTableSyntax PgCreateTableSyntax where   type Sql92CreateTableTableNameSyntax PgCreateTableSyntax = PgTableNameSyntax

@@ -1,5 +1,5 @@ name:                 beam-postgres-version:              0.5.3.1+version:              0.5.4.0 synopsis:             Connection layer between beam and postgres description:          Beam driver for <https://www.postgresql.org/ PostgreSQL>, an advanced open-source RDBMS homepage:             https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres@@ -36,11 +36,11 @@                       beam-core            >=0.10 && <0.11,                       beam-migrate         >=0.5  && <0.6, -                      postgresql-libpq     >=0.8  && <0.10,-                      postgresql-simple    >=0.5  && <0.7,+                      postgresql-libpq     >=0.8  && <0.12,+                      postgresql-simple    >=0.5  && <0.8, -                      text                 >=1.0  && <2.1,-                      bytestring           >=0.10 && <0.12,+                      text                 >=1.0  && <2.2,+                      bytestring           >=0.10 && <0.13,                        attoparsec           >=0.13 && <0.15,                       hashable             >=1.1  && <1.5,@@ -48,9 +48,9 @@                       free                 >=4.12 && <5.3,                       time                 >=1.6  && <1.13,                       monad-control        >=1.0  && <1.1,-                      mtl                  >=2.1  && <2.3,+                      mtl                  >=2.1  && <2.4,                       conduit              >=1.2  && <1.4,-                      aeson                >=0.11 && <2.2,+                      aeson                >=0.11 && <2.3,                       uuid-types           >=1.0  && <1.1,                       case-insensitive     >=1.2  && <1.3,                       scientific           >=0.3  && <0.4,@@ -90,7 +90,7 @@     tasty-hunit,     tasty,     text,-    tmp-postgres,+    testcontainers,     uuid,     vector   default-language: Haskell2010

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} module Database.Beam.Postgres.Test.Migrate where  import Database.Beam@@ -22,6 +23,8 @@       , charWidthVerification postgresConn "CHAR" char       , charNoWidthVerification postgresConn "CHAR" char       , extensionVerification postgresConn+      , createTableWithSchemaWorks postgresConn+      , dropSchemaWorks postgresConn       ]  data CharT f@@ -96,3 +99,41 @@           case resAfter of             VerificationSucceeded -> return ()             VerificationFailed failures -> fail ("Verification failed: " ++ show failures)+++-- | Verifies that 'createTableWithSchema' correctly creates a table+-- with a schema.+createTableWithSchemaWorks :: IO ByteString -> TestTree+createTableWithSchemaWorks pgConn =+    testCase ("createTableWithSchema works correctly") $ do+      withTestPostgres "create_table_with_schema" pgConn $ \conn -> do+        res <- runBeamPostgres conn $ do+          db <- executeMigration runNoReturn $ do+                  internalSchema <- createDatabaseSchema "internal_schema"+                  (CharDb <$> createTableWithSchema (Just internalSchema) "char_test"+                                    (CharT (field "key" (varchar Nothing) notNull)))++          verifySchema migrationBackend db++        case res of+          VerificationSucceeded -> return ()+          VerificationFailed failures -> fail ("Verification failed: " ++ show failures)+++-- | Verifies that creating a schema and dropping it works+dropSchemaWorks :: IO ByteString -> TestTree+dropSchemaWorks pgConn =+    testCase ("dropDatabaseSchema works correctly") $ do+      withTestPostgres "drop_schema" pgConn $ \conn -> do+        runBeamPostgres conn $ do+          db <- executeMigration runNoReturn $ do+                  internalSchema <- createDatabaseSchema "internal_schema"+                  willBeDroppedSchema <- createDatabaseSchema "will_be_dropped"+                  db <- (CharDb <$> createTableWithSchema (Just internalSchema) "char_test"+                                    (CharT (field "key" (varchar Nothing) notNull)))+                  dropDatabaseSchema willBeDroppedSchema+                  pure db++          verifySchema migrationBackend db >>= \case+            VerificationFailed failures -> fail ("Verification failed: " ++ show failures)+            VerificationSucceeded -> pure ()

@@ -1,23 +1,50 @@ module Main where -import qualified Database.Postgres.Temp as TempDb+import Data.ByteString ( ByteString )+import Data.Text ( unpack )+import qualified Data.Text.Lazy as TL+ import Test.Tasty+import qualified TestContainers.Tasty as TC  import qualified Database.Beam.Postgres.Test.Select as Select import qualified Database.Beam.Postgres.Test.Marshal as Marshal import qualified Database.Beam.Postgres.Test.DataTypes as DataType import qualified Database.Beam.Postgres.Test.Migrate as Migrate+import Database.PostgreSQL.Simple ( ConnectInfo(..), defaultConnectInfo )+import qualified Database.PostgreSQL.Simple as Postgres  main :: IO ()-main = defaultMain $ withDb $ \getDb ->-  let getConnStr = TempDb.toConnectionString <$> getDb-  in testGroup "beam-postgres tests"-      [ Marshal.tests getConnStr-      , Select.tests getConnStr-      , DataType.tests getConnStr-      , Migrate.tests getConnStr-      ]-  where-    withDb = withResource-      (either (\e -> error $ "Failed to start DB: " <> show e) pure =<< TempDb.startConfig mempty)-      TempDb.stop+main = defaultMain +     $ TC.withContainers setupTempPostgresDB +     $ \getConnStr -> +        testGroup "beam-postgres tests"+          [ Marshal.tests getConnStr+          , Select.tests getConnStr+          , DataType.tests getConnStr+          , Migrate.tests getConnStr+          ]+++setupTempPostgresDB :: TC.MonadDocker m => m ByteString+setupTempPostgresDB = do+    let user     = "postgres"+        password = "root"+        db       = "testdb"++    timescaleContainer <- TC.run $ TC.containerRequest (TC.fromTag "postgres:16.4")+        TC.& TC.setExpose [ 5432 ]+        TC.& TC.setEnv [ ("POSTGRES_USER", user)+                       , ("POSTGRES_PASSWORD", password)+                       , ("POSTGRES_DB", db)+                       ]+        TC.& TC.setWaitingFor (TC.waitForLogLine TC.Stderr ("database system is ready to accept connections" `TL.isInfixOf`))+    +    pure $ Postgres.postgreSQLConnectionString +                   ( defaultConnectInfo { connectHost     = "localhost"+                                        , connectUser     = unpack user +                                        , connectPassword = unpack password+                                        , connectDatabase = unpack db+                                        , connectPort     = fromIntegral $ TC.containerPort timescaleContainer 5432+                                        }+                   )