hpqtypes-extras 1.10.4.0 → 1.11.0.0

raw patch · 6 files changed

+67/−75 lines, 6 filesdep ~log-basedep ~text-showPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: log-base, text-show

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−2
• hpqtypes-extras.cabal +1/−1
• src/Database/PostgreSQL/PQTypes/Checks.hs +38/−55
• src/Database/PostgreSQL/PQTypes/ExtrasOptions.hs +16/−5
• src/Database/PostgreSQL/PQTypes/Model/Table.hs +0/−6
• test/Main.hs +7/−6

@@ -1,8 +1,11 @@-# hpqtypes-extra-1.10.4.0 (2021-02-04)+# hpqtypes-extras-1.11.0.0 (2021-03-29)+* Support running with higher table versions in the database than in the code++# hpqtypes-extras-1.10.4.0 (2021-02-04) * Generate valid INSERT SELECT query with data modifying WITH clauses * Add DerivingVia helpers for enums -# hpqtypes-extra-1.10.3.0 (2020-11-16)+# hpqtypes-extras-1.10.3.0 (2020-11-16) * Include LIMIT clause in UNION subqueries of the select  # hpqtypes-extras-1.10.2.1 (2020-05-05)

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                hpqtypes-extras-version:             1.10.4.0+version:             1.11.0.0 synopsis:            Extra utilities for hpqtypes library description:         The following extras for hpqtypes library:                      .

@@ -1,20 +1,19 @@ module Database.PostgreSQL.PQTypes.Checks (   -- * Checks     checkDatabase-  , checkDatabaseAllowUnknownObjects   , createTable   , createDomain    -- * Options   , ExtrasOptions(..)   , defaultExtrasOptions+  , ObjectsValidationMode(..)    -- * Migrations   , migrateDatabase   ) where  import Control.Arrow ((&&&))-import Control.Applicative ((<$>)) import Control.Monad.Catch import Control.Monad.Reader import Data.Int@@ -67,49 +66,41 @@   checkDBConsistency options domains tablesWithVersions migrations   resultCheck =<< checkCompositesStructure tablesWithVersions                                            CreateCompositesIfDatabaseEmpty-                                           DontAllowUnknownObjects+                                           (eoObjectsValidationMode options)                                            composites   resultCheck =<< checkDomainsStructure domains   resultCheck =<< checkDBStructure options tablesWithVersions   resultCheck =<< checkTablesWereDropped migrations-  resultCheck =<< checkUnknownTables tables-  resultCheck =<< checkExistenceOfVersionsForTables (tableVersions : tables) +  when (eoObjectsValidationMode options == DontAllowUnknownObjects) $ do+    resultCheck =<< checkUnknownTables tables+    resultCheck =<< checkExistenceOfVersionsForTables (tableVersions : tables)++  -- After migrations are done make sure the table versions are correct.+  resultCheck . checkVersions options =<< getTableVersions (tableVersions : tables)+   -- everything is OK, commit changes   commit --- | Run checks on the database structure and whether the database--- needs to be migrated. Will do a full check of DB structure.+-- | Run checks on the database structure and whether the database needs to be+-- migrated. Will do a full check of DB structure. checkDatabase   :: forall m . (MonadDB m, MonadLog m, MonadThrow m)-  => ExtrasOptions -> [CompositeType] -> [Domain] -> [Table] -> m ()-checkDatabase options = checkDatabase_ options DontAllowUnknownObjects---- | Same as 'checkDatabase', but will not fail if there are additional tables--- and composite types in the database.-checkDatabaseAllowUnknownObjects-  :: forall m . (MonadDB m, MonadLog m, MonadThrow m)-  => ExtrasOptions -> [CompositeType] -> [Domain] -> [Table] -> m ()-checkDatabaseAllowUnknownObjects options = checkDatabase_ options AllowUnknownObjects--data ObjectsValidationMode = AllowUnknownObjects | DontAllowUnknownObjects-  deriving Eq--checkDatabase_-  :: forall m . (MonadDB m, MonadLog m, MonadThrow m)   => ExtrasOptions-  -> ObjectsValidationMode   -> [CompositeType]   -> [Domain]   -> [Table]   -> m ()-checkDatabase_ options ovm composites domains tables = do+checkDatabase options composites domains tables = do   tablesWithVersions <- getTableVersions (tableVersions : tables)-  resultCheck $ checkVersions tablesWithVersions-  resultCheck =<< checkCompositesStructure tablesWithVersions DontCreateComposites ovm composites+  resultCheck $ checkVersions options tablesWithVersions+  resultCheck =<< checkCompositesStructure tablesWithVersions+                                           DontCreateComposites+                                           (eoObjectsValidationMode options)+                                           composites   resultCheck =<< checkDomainsStructure domains   resultCheck =<< checkDBStructure options tablesWithVersions-  when (ovm == DontAllowUnknownObjects) $ do+  when (eoObjectsValidationMode options == DontAllowUnknownObjects) $ do     resultCheck =<< checkUnknownTables tables     resultCheck =<< checkExistenceOfVersionsForTables (tableVersions : tables) @@ -118,24 +109,6 @@   resultCheck =<< checkInitialSetups tables    where-    checkVersions :: TablesWithVersions -> ValidationResult-    checkVersions vs = mconcat . map checkVersion $ vs--    checkVersion :: (Table, Int32) -> ValidationResult-    checkVersion (t@Table{..}, v)-      | tblVersion `elem` tblAcceptedDbVersions-                  = validationError $-                    "Table '" <> tblNameText t <>-                    "' has its current table version in accepted db versions"-      | tblVersion == v || v `elem` tblAcceptedDbVersions-                  = mempty-      | v == 0    = validationError $-                    "Table '" <> tblNameText t <> "' must be created"-      | otherwise = validationError $-                    "Table '" <> tblNameText t-                    <> "' must be migrated" <+> showt v <+> "->"-                    <+> showt tblVersion-     checkInitialSetups :: [Table] -> m ValidationResult     checkInitialSetups tbls =       liftM mconcat . mapM checkInitialSetup' $ tbls@@ -198,6 +171,21 @@   dbTableNames <- fetchMany runIdentity   return dbTableNames +checkVersions :: ExtrasOptions -> TablesWithVersions -> ValidationResult+checkVersions options = mconcat . map checkVersion+  where+    checkVersion :: (Table, Int32) -> ValidationResult+    checkVersion (t@Table{..}, v)+      | if eoAllowHigherTableVersions options+        then tblVersion <= v+        else tblVersion == v = mempty+      | v == 0    = validationError $+                    "Table '" <> tblNameText t <> "' must be created"+      | otherwise = validationError $+                    "Table '" <> tblNameText t+                    <> "' must be migrated" <+> showt v <+> "->"+                    <+> showt tblVersion+ -- | Check that there's a 1-to-1 correspondence between the list of -- 'Table's and what's actually in the database. checkUnknownTables :: (MonadDB m, MonadLog m) => [Table] -> m ValidationResult@@ -395,13 +383,11 @@   => ExtrasOptions   -> TablesWithVersions   -> m ValidationResult-checkDBStructure options tables = fmap mconcat .-                                  forM tables $ \(table, version) ->-  do+checkDBStructure options tables = fmap mconcat . forM tables $ \(table, version) -> do   result <- topMessage "table" (tblNameText table) <$> checkTableStructure table-  -- If one of the accepted versions defined for the table is the current table-  -- version in the database, show inconsistencies as info messages only.-  return $ if version `elem` tblAcceptedDbVersions table+  -- If we allow higher table versions in the database, show inconsistencies as+  -- info messages only.+  return $ if eoAllowHigherTableVersions options && tblVersion table < version            then validationErrorsToInfos result            else result   where@@ -824,12 +810,9 @@         logInfo_ "Running migrations..."         forM_ migrationsToRun $ \mgr -> do           runMigration mgr--          when (eoForceCommit options) $ do+          when (eoCommitAfterEachMigration options) $ do             logInfo_ $ "Committing migration changes..."             commit-            logInfo_ $ "Committing migration changes done."-            logInfo_ "!IMPORTANT! Database has been permanently changed"         logInfo_ "Running migrations... done."      validateMigrationsToRun :: [Migration m] -> [(Text, Int32)] -> m ()

@@ -1,18 +1,29 @@ module Database.PostgreSQL.PQTypes.ExtrasOptions   ( ExtrasOptions(..)   , defaultExtrasOptions+  , ObjectsValidationMode(..)   ) where  data ExtrasOptions =     ExtrasOptions-    { eoForceCommit :: Bool-      -- ^ Force commit after every migration-    , eoEnforcePKs :: Bool+    { eoCommitAfterEachMigration :: Bool+      -- ^ Run commit after every migration.+    , eoEnforcePKs               :: Bool       -- ^ Validate that every handled table has a primary key+    , eoObjectsValidationMode    :: !ObjectsValidationMode+      -- ^ Validation mode for unknown tables and composite types.+    , eoAllowHigherTableVersions :: !Bool+      -- ^ Whether to allow tables in the database to have higher versions than+      -- the one in the code definition.     } deriving Eq  defaultExtrasOptions :: ExtrasOptions defaultExtrasOptions = ExtrasOptions-  { eoForceCommit = False-  , eoEnforcePKs  = False+  { eoCommitAfterEachMigration = False+  , eoEnforcePKs               = False+  , eoObjectsValidationMode    = DontAllowUnknownObjects+  , eoAllowHigherTableVersions = False   }++data ObjectsValidationMode = AllowUnknownObjects | DontAllowUnknownObjects+  deriving Eq

@@ -65,11 +65,6 @@   Table {   tblName               :: RawSQL () -- ^ Must be in lower case. , tblVersion            :: Int32-, tblAcceptedDbVersions :: [Int32] -- ^ List of database table versions that-                                   -- will be accepted even if they don't match-                                   -- the table definition (note that in such-                                   -- case structural differences are not-                                   -- errors). , tblColumns            :: [TableColumn] , tblPrimaryKey         :: Maybe PrimaryKey , tblChecks             :: [Check]@@ -87,7 +82,6 @@ tblTable = Table {   tblName = error "tblTable: table name must be specified" , tblVersion = error "tblTable: table version must be specified"-, tblAcceptedDbVersions = [] , tblColumns = error "tblTable: table columns must be specified" , tblPrimaryKey = Nothing , tblChecks = []

@@ -805,6 +805,7 @@       currentSchema   = schema1Tables       differentSchema = schema5Tables       extrasOptions   = defaultExtrasOptions { eoEnforcePKs = True }+      extrasOptionsWithUnknownObjects = extrasOptions { eoObjectsValidationMode = AllowUnknownObjects }    runQuery_ $ sqlCreateComposite composite @@ -814,15 +815,15 @@     checkDatabase extrasOptions [] [] currentSchema   assertNoException "checkDatabaseAllowUnknownTables runs fine \                     \for consistent DB" $-    checkDatabaseAllowUnknownObjects extrasOptions [composite] [] currentSchema+    checkDatabase extrasOptionsWithUnknownObjects [composite] [] currentSchema   assertNoException "checkDatabaseAllowUnknownTables runs fine \                     \for consistent DB with unknown composite type in the database" $-    checkDatabaseAllowUnknownObjects extrasOptions [] [] currentSchema+    checkDatabase extrasOptionsWithUnknownObjects [] [] currentSchema   assertException "checkDatabase should throw exception for wrong schema" $     checkDatabase extrasOptions [] [] differentSchema   assertException ("checkDatabaseAllowUnknownObjects \                    \should throw exception for wrong scheme") $-    checkDatabaseAllowUnknownObjects extrasOptions [] [] differentSchema+    checkDatabase extrasOptionsWithUnknownObjects [] [] differentSchema    runSQL_ "INSERT INTO table_versions (name, version) \           \VALUES ('unknown_table', 0)"@@ -830,14 +831,14 @@     checkDatabase extrasOptions [] [] currentSchema   assertNoException ("checkDatabaseAllowUnknownObjects \                      \accepts extra entry in 'table_versions'") $-    checkDatabaseAllowUnknownObjects extrasOptions [] [] currentSchema+    checkDatabase extrasOptionsWithUnknownObjects [] [] currentSchema   runSQL_ "DELETE FROM table_versions where name='unknown_table'"    runSQL_ "CREATE TABLE unknown_table (title text)"   assertException "checkDatabase should throw with unknown table" $     checkDatabase extrasOptions [] [] currentSchema   assertNoException "checkDatabaseAllowUnknownObjects accepts unknown table" $-    checkDatabaseAllowUnknownObjects extrasOptions [] [] currentSchema+    checkDatabase extrasOptionsWithUnknownObjects [] [] currentSchema    runSQL_ "INSERT INTO table_versions (name, version) \           \VALUES ('unknown_table', 0)"@@ -845,7 +846,7 @@     checkDatabase extrasOptions [] [] currentSchema   assertNoException ("checkDatabaseAllowUnknownObjects \                      \accepts unknown tables with version") $-    checkDatabaseAllowUnknownObjects extrasOptions [] [] currentSchema+    checkDatabase extrasOptionsWithUnknownObjects [] [] currentSchema    freshTestDB    step