diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,12 @@ +# 0.5.5.0 + +## Added features + +* Add support for creating secondary indices, supporting both `CREATE INDEX` and + `CREATE UNIQUE INDEX`. `getDbConstraintsForSchemas` now discovers user-created + secondary indices via `pg_index` (excluding primary keys and + constraint-backing indices). + # 0.5.4.4 ## Added features diff --git a/Database/Beam/Postgres/CustomTypes.hs b/Database/Beam/Postgres/CustomTypes.hs --- a/Database/Beam/Postgres/CustomTypes.hs +++ b/Database/Beam/Postgres/CustomTypes.hs @@ -40,9 +40,6 @@ import Data.Functor.Const import qualified Data.HashSet as HS import Data.Proxy (Proxy(..)) -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup -#endif import Data.Text (Text) import qualified Data.Text.Encoding as TE diff --git a/Database/Beam/Postgres/Migrate.hs b/Database/Beam/Postgres/Migrate.hs --- a/Database/Beam/Postgres/Migrate.hs +++ b/Database/Beam/Postgres/Migrate.hs @@ -31,7 +31,8 @@ ) where import Database.Beam.Backend.SQL -import Database.Beam.Migrate.Actions (defaultActionProvider, defaultSchemaActionProvider) +import Database.Beam.Migrate.Actions (defaultActionProvider, defaultSchemaActionProvider, + createIndexActionProvider, dropIndexActionProvider) import qualified Database.Beam.Migrate.Backend as Tool import qualified Database.Beam.Migrate.Checks as Db import qualified Database.Beam.Migrate.SQL as Db @@ -65,6 +66,7 @@ import qualified Data.ByteString.Lazy.Char8 as BCL import qualified Data.HashMap.Strict as HM import Data.Int +import qualified Data.List.NonEmpty as NE (nonEmpty) import Data.Maybe import Data.String import qualified Data.Text as T @@ -102,6 +104,8 @@ , Tool.backendActionProvider = mconcat [ defaultActionProvider , defaultSchemaActionProvider + , createIndexActionProvider + , dropIndexActionProvider , pgExtensionActionProvider , pgCustomEnumActionProvider ] @@ -402,6 +406,50 @@ -- 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" ])) + -- Collect user-created secondary indices. + -- + -- Excludes: + -- - primary keys + -- - indices that back a constraint (i.e. those created implicitly by UNIQUE/EXCLUDE) + -- - expression indices e.g. CREATE INDEX ON users (LOWER(email)) + secondaryIndices <- + mapMaybe (\(schema, tblNm, idxNm, isUniq, cols) -> + case NE.nonEmpty (V.toList cols) of + Nothing -> Nothing + Just colsNE -> + let opts = Db.setUniqueIndexOptions @(BeamSqlBackendSyntax Postgres) isUniq + $ Db.defaultIndexOptions @(BeamSqlBackendSyntax Postgres) + in + Just $ + Db.SomeDatabasePredicate @(Db.TableHasIndex Postgres) + (Db.TableHasIndex (Db.QualifiedName schema tblNm) idxNm colsNE opts)) <$> + Pg.query_ conn (fromString (unlines + [ -- NULL out 'public' since it is the implicit default schema in Postgres + "SELECT NULLIF(ns.nspname, 'public'), c.relname, i.relname, ix.indisunique," + -- re-aggregate column names in index-key order (see ORDINALITY below) + , " array_agg(a.attname ORDER BY k.n ASC)" + , "FROM pg_index ix" + , "JOIN pg_class c ON c.oid = ix.indrelid" + , "JOIN pg_class i ON i.oid = ix.indexrelid" + , "JOIN pg_namespace ns ON ns.oid = c.relnamespace" + -- ORDINALITY allows retaining ordering of index columns + , "CROSS JOIN unnest(ix.indkey) WITH ORDINALITY k(attid, n)" + , "JOIN pg_attribute a ON a.attnum = k.attid AND a.attrelid = ix.indrelid" + -- only regular tables (not views, sequences, etc.) + , "WHERE c.relkind = 'r'" + -- exclude Postgres system schemas + , " AND ns.nspname NOT LIKE 'pg_%'" + , " AND ns.nspname != 'information_schema'" + -- exclude primary key indices + , " AND NOT ix.indisprimary" + -- exclude indices created implicitly by a UNIQUE or EXCLUDE constraint + , " AND NOT EXISTS (SELECT 1 FROM pg_constraint con WHERE con.conindid = ix.indexrelid)" + -- exclude expression indices: a key column number of 0 means that + -- position is an expression (e.g. lower(col)) rather than a plain + -- column reference, which TableHasIndex cannot represent + , " AND NOT EXISTS (SELECT 1 FROM unnest(ix.indkey) AS k(attnum) WHERE k.attnum = 0)" + , "GROUP BY ns.nspname, c.relname, i.relname, ix.indisunique" ])) + let enumerations = map (\(enumNm, _, options) -> Db.SomeDatabasePredicate (PgHasEnum enumNm (V.toList options))) enumerationData @@ -409,7 +457,7 @@ map (\(Pg.Only extname) -> Db.SomeDatabasePredicate (PgHasExtension extname)) <$> Pg.query_ conn "SELECT extname from pg_extension" - pure (tblsExist ++ columnChecks ++ primaryKeys ++ enumerations ++ extensions) + pure (tblsExist ++ columnChecks ++ primaryKeys ++ secondaryIndices ++ enumerations ++ extensions) -- * Postgres-specific data types diff --git a/Database/Beam/Postgres/Syntax.hs b/Database/Beam/Postgres/Syntax.hs --- a/Database/Beam/Postgres/Syntax.hs +++ b/Database/Beam/Postgres/Syntax.hs @@ -46,6 +46,7 @@ , PgAlterTableSyntax(..), PgAlterTableActionSyntax(..), PgAlterColumnActionSyntax(..) + , PgWindowFrameSyntax(..), PgWindowFrameBoundsSyntax(..), PgWindowFrameBoundSyntax(..) , PgSelectLockingClauseSyntax(..) @@ -58,6 +59,8 @@ , PgDataTypeDescr(..) , PgHasEnum(..) + , PgIndexOptions(..) + , pgCreateExtensionSyntax, pgDropExtensionSyntax , pgCreateEnumSyntax, pgDropTypeSyntax @@ -97,7 +100,7 @@ import Control.Monad.Free import Control.Monad.Free.Church -import Data.Aeson (Value, object, (.=)) +import Data.Aeson (Value, object, withObject, (.=), (.:)) import Data.Bits import Data.ByteString (ByteString) import Data.ByteString.Builder (Builder, doubleDec, floatDec, byteString, char8, toLazyByteString) @@ -110,6 +113,7 @@ import Data.Functor.Classes import Data.Hashable import Data.Int +import qualified Data.List.NonEmpty as NE (toList) import Data.Maybe import Data.Scientific (Scientific) import Data.String (IsString(..), fromString) @@ -426,6 +430,35 @@ createTableCmd = PgCommandSyntax PgCommandTypeDdl . coerce dropTableCmd = PgCommandSyntax PgCommandTypeDdl . coerce alterTableCmd = PgCommandSyntax PgCommandTypeDdl . coerce + +newtype PgIndexOptions = PgIndexOptions { pgIndexUnique :: Bool } + deriving (Show, Eq, Hashable) + +instance IsSql92CreateDropIndexSyntax PgCommandSyntax where + type instance Sql92CreateIndexOptionsSyntax PgCommandSyntax = PgIndexOptions + + defaultIndexOptions = PgIndexOptions { pgIndexUnique = False } + + createIndexCmd idxNm tblNm cols opts = + PgCommandSyntax PgCommandTypeDdl $ + emit (if pgIndexUnique opts then "CREATE UNIQUE INDEX " else "CREATE INDEX ") <> + pgQuotedIdentifier idxNm <> + emit " ON " <> fromPgTableName tblNm <> + pgParens (pgSepBy (emit ", ") (NE.toList $ fmap pgQuotedIdentifier cols)) + + dropIndexCmd idxNm = + PgCommandSyntax PgCommandTypeDdl (emit "DROP INDEX " <> pgQuotedIdentifier idxNm) + + serializeIndexOptions opts = + object ["unique" .= pgIndexUnique opts] + + deserializeIndexOptions = + withObject "PgIndexOptions" $ \v -> + PgIndexOptions <$> v .: "unique" + +instance IsSql92UniqueIndexSyntax PgCommandSyntax where + setUniqueIndexOptions u opts = opts { pgIndexUnique = u } + indexIsUnique opts = pgIndexUnique opts instance IsSql92SchemaNameSyntax PgSchemaNameSyntax where schemaName s = PgSchemaNameSyntax (pgQuotedIdentifier s) diff --git a/beam-postgres.cabal b/beam-postgres.cabal --- a/beam-postgres.cabal +++ b/beam-postgres.cabal @@ -1,5 +1,5 @@ name: beam-postgres -version: 0.5.4.4 +version: 0.5.5.0 synopsis: Connection layer between beam and postgres description: Beam driver for , an advanced open-source RDBMS homepage: https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres @@ -34,7 +34,7 @@ build-depends: base >=4.11 && <5.0, beam-core >=0.10 && <0.11, - beam-migrate >=0.5 && <0.6, + beam-migrate >=0.5.4.0 && <0.6, postgresql-libpq >=0.8 && <0.12, postgresql-simple >=0.5 && <0.8, diff --git a/test/Database/Beam/Postgres/Test/Migrate.hs b/test/Database/Beam/Postgres/Test/Migrate.hs --- a/test/Database/Beam/Postgres/Test/Migrate.hs +++ b/test/Database/Beam/Postgres/Test/Migrate.hs @@ -10,8 +10,12 @@ import Database.Beam.Migrate.Simple import Data.ByteString (ByteString) +import Data.Int (Int32) +import qualified Data.List.NonEmpty as NE import Data.Text (Text) +import qualified Database.PostgreSQL.Simple as Pg + import Test.Tasty import Test.Tasty.HUnit @@ -25,6 +29,8 @@ , extensionVerification postgresConn , createTableWithSchemaWorks postgresConn , dropSchemaWorks postgresConn + , indexVerification postgresConn + , uniqueIndexVerification postgresConn ] data CharT f @@ -137,3 +143,52 @@ verifySchema migrationBackend db >>= \case VerificationFailed failures -> fail ("Verification failed: " ++ show failures) VerificationSucceeded -> pure () + +-- Shared table type for index tests + +newtype IdxT f = IdxT + { _idx_value :: C f Int32 + } deriving (Generic, Beamable) + +instance Table IdxT where + newtype PrimaryKey IdxT f = IdxPk (C f Int32) + deriving (Generic, Beamable) + primaryKey = IdxPk . _idx_value + +data IdxDb entity = IdxDb + { _idx_tbl :: entity (TableEntity IdxT) + } deriving (Generic, Database Postgres) + +-- | Verifies that 'verifySchema' correctly detects a secondary index +indexVerification :: IO ByteString -> TestTree +indexVerification pgConn = + testCase "verifySchema correctly detects a secondary index" $ + withTestPostgres "db_index" pgConn $ \conn -> do + Pg.execute_ conn "CREATE TABLE idx_tbl (idx_value integer NOT NULL PRIMARY KEY)" + Pg.execute_ conn "CREATE INDEX idx_tbl_value ON idx_tbl (idx_value)" + let db :: CheckedDatabaseSettings Postgres IdxDb + db = defaultMigratableDbSettings `withDbModification` + (dbModification @_ @Postgres) + { _idx_tbl = addTableIndex "idx_tbl_value" (defaultIndexOptions @PgCommandSyntax) + (\t -> selectorColumnName _idx_value t NE.:| []) } + runBeamPostgres conn (verifySchema migrationBackend db) >>= \case + VerificationSucceeded -> return () + VerificationFailed failures -> fail ("Verification failed: " ++ show failures) + +-- | Verifies that 'verifySchema' correctly detects a UNIQUE secondary index +uniqueIndexVerification :: IO ByteString -> TestTree +uniqueIndexVerification pgConn = + testCase "verifySchema correctly detects a UNIQUE secondary index" $ + withTestPostgres "db_unique_index" pgConn $ \conn -> do + Pg.execute_ conn "CREATE TABLE idx_tbl (idx_value integer NOT NULL PRIMARY KEY)" + Pg.execute_ conn "CREATE UNIQUE INDEX idx_tbl_value_uniq ON idx_tbl (idx_value)" + let idxOpts = setUniqueIndexOptions @PgCommandSyntax True + $ defaultIndexOptions @PgCommandSyntax + db :: CheckedDatabaseSettings Postgres IdxDb + db = defaultMigratableDbSettings `withDbModification` + (dbModification @_ @Postgres) + { _idx_tbl = addTableIndex "idx_tbl_value_uniq" idxOpts + (\t -> selectorColumnName _idx_value t NE.:| []) } + runBeamPostgres conn (verifySchema migrationBackend db) >>= \case + VerificationSucceeded -> return () + VerificationFailed failures -> fail ("Verification failed: " ++ show failures)