hpqtypes-extras 1.12.0.1 → 1.13.0.0

raw patch · 10 files changed

+59/−65 lines, 10 filesdep +transformers-basedep ~semigroupssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers-base

Dependency ranges changed: semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG.md +1/−7
• Setup.hs +1/−6
• hpqtypes-extras.cabal +4/−3
• src/Database/PostgreSQL/PQTypes/Checks.hs +24/−5
• src/Database/PostgreSQL/PQTypes/ExtrasOptions.hs +3/−4
• src/Database/PostgreSQL/PQTypes/Migrate.hs +4/−4
• src/Database/PostgreSQL/PQTypes/Model/Check.hs +5/−11
• src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs +3/−9
• src/Database/PostgreSQL/PQTypes/Model/Index.hs +13/−15
• test/Main.hs +1/−1

@@ -1,10 +1,4 @@-# hpqtypes-extras-1.12.0.1aou-aoeu-ao-eua-oe-uao-eu (2021-10-11)+# hpqtypes-extras-1.12.0.1 (2021-10-11) * Add support for log-base-0.11.0.0  # hpqtypes-extras-1.12.0.0 (2021-10-??)

@@ -1,7 +1,2 @@-aoeu-aoe-uao-eua-oeu-aoeuimport Distribution.Simple+import Distribution.Simple main = defaultMain

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                hpqtypes-extras-version:             1.12.0.1+version:             1.13.0.0 synopsis:            Extra utilities for hpqtypes library description:         The following extras for hpqtypes library:                      .@@ -74,7 +74,7 @@    build-depends: base              >= 4.9     && < 5                , hpqtypes          >= 1.8.0.0 && < 2.0.0.0-               , base16-bytestring >= 0.1     && < 1.0.2.0+               , base16-bytestring >= 0.1     && < 1.1                , bytestring        >= 0.10    && < 0.12                , containers        >= 0.5     && < 0.7                , cryptohash        >= 0.11    && < 0.12@@ -87,7 +87,8 @@                , monad-control     >= 1.0.3.1 && < 1.1                , semigroups        >= 0.16    && < 0.20                , text-show         >= 3.7     && < 4-               , log-base          >= 0.7     && < 0.12+               , transformers-base+               , log-base          >= 0.11    && < 0.12                , safe              >= 0.3     && < 0.4    default-language: Haskell2010

@@ -14,6 +14,8 @@   ) where  import Control.Arrow ((&&&))+import Control.Concurrent.Lifted (threadDelay)+import Control.Monad.Base import Control.Monad.Catch import Control.Monad.Reader import Data.Int@@ -22,6 +24,7 @@ import Data.Monoid import Data.Monoid.Utils import Data.Ord (comparing)+import Data.Typeable (cast) import qualified Data.String import Data.Text (Text) import Database.PostgreSQL.PQTypes@@ -49,7 +52,7 @@  -- | Run migrations and check the database structure. migrateDatabase-  :: (MonadDB m, MonadLog m, MonadMask m)+  :: (MonadBase IO m, MonadDB m, MonadLog m, MonadMask m)   => ExtrasOptions   -> [Extension]   -> [CompositeType]@@ -539,7 +542,7 @@ --   * all 'mgrFrom' are less than table version number of the table in --     the 'tables' list checkDBConsistency-  :: forall m. (MonadDB m, MonadLog m, MonadMask m)+  :: forall m. (MonadBase IO m, MonadDB m, MonadLog m, MonadMask m)   => ExtrasOptions -> [Domain] -> TablesWithVersions -> [Migration m]   -> m () checkDBConsistency options domains tablesWithVersions migrations = do@@ -819,12 +822,28 @@       validateMigrationsToRun migrationsToRun dbTablesWithVersions       when (not . null $ migrationsToRun) $ do         logInfo_ "Running migrations..."-        forM_ migrationsToRun $ \mgr -> do-          runMigration mgr-          when (eoCommitAfterEachMigration options) $ do+        forM_ migrationsToRun $ \mgr -> fix $ \loop -> do+          let restartMigration query = do+                logAttention "Failed to acquire a lock" $ object ["query" .= query]+                logInfo_ "Restarting the migration shortly..."+                threadDelay 1000000+                loop+          handleJust lockNotAvailable restartMigration $ do+            forM_ (eoLockTimeoutMs options) $ \lockTimeout -> do+              runSQL_ $ "SET LOCAL lock_timeout TO" <+> intToSQL lockTimeout+            runMigration mgr `onException` rollback             logInfo_ $ "Committing migration changes..."             commit         logInfo_ "Running migrations... done."+      where+        intToSQL :: Int -> SQL+        intToSQL = unsafeSQL . show++        lockNotAvailable :: DBException -> Maybe String+        lockNotAvailable DBException{..}+          | Just DetailedQueryError{..} <- cast dbeError+          , qeErrorCode == LockNotAvailable = Just $ show dbeQueryContext+          | otherwise                       = Nothing      validateMigrationsToRun :: [Migration m] -> [(Text, Int32)] -> m ()     validateMigrationsToRun migrationsToRun dbTablesWithVersions = do

@@ -6,9 +6,8 @@  data ExtrasOptions =     ExtrasOptions-    { eoCommitAfterEachMigration :: Bool-      -- ^ Run commit after every migration.-    , eoEnforcePKs               :: Bool+    { eoLockTimeoutMs            :: !(Maybe Int)+    , eoEnforcePKs               :: !Bool       -- ^ Validate that every handled table has a primary key     , eoObjectsValidationMode    :: !ObjectsValidationMode       -- ^ Validation mode for unknown tables and composite types.@@ -19,7 +18,7 @@  defaultExtrasOptions :: ExtrasOptions defaultExtrasOptions = ExtrasOptions-  { eoCommitAfterEachMigration = False+  { eoLockTimeoutMs            = Nothing   , eoEnforcePKs               = False   , eoObjectsValidationMode    = DontAllowUnknownObjects   , eoAllowHigherTableVersions = False

@@ -17,7 +17,7 @@   -- create the domain   runQuery_ $ sqlCreateDomain dom   -- add constraint checks to the domain-  F.forM_ domChecks $ runQuery_ . sqlAlterDomain domName . sqlAddValidCheck+  F.forM_ domChecks $ runQuery_ . sqlAlterDomain domName . sqlAddValidCheckMaybeDowntime  createTable :: MonadDB m => Bool -> Table -> m () createTable withConstraints table@Table{..} = do@@ -25,7 +25,7 @@   runQuery_ $ sqlCreateTable tblName   runQuery_ $ sqlAlterTable tblName $ map sqlAddColumn tblColumns   -- Add indexes.-  forM_ tblIndexes $ runQuery_ . sqlCreateIndexSequentially tblName+  forM_ tblIndexes $ runQuery_ . sqlCreateIndexMaybeDowntime tblName   -- Add all the other constraints if applicable.   when withConstraints $ createTableConstraints table   -- Register the table along with its version.@@ -39,6 +39,6 @@   where     addConstraints = concat [         [sqlAddPK tblName pk | Just pk <- return tblPrimaryKey]-      , map sqlAddValidCheck tblChecks-      , map (sqlAddValidFK tblName) tblForeignKeys+      , map sqlAddValidCheckMaybeDowntime tblChecks+      , map (sqlAddValidFKMaybeDowntime tblName) tblForeignKeys       ]

@@ -1,8 +1,7 @@ module Database.PostgreSQL.PQTypes.Model.Check (     Check(..)   , tblCheck-  , sqlAddCheck-  , sqlAddValidCheck+  , sqlAddValidCheckMaybeDowntime   , sqlAddNotValidCheck   , sqlValidateCheck   , sqlDropCheck@@ -26,17 +25,12 @@   , chkValidated = True   } -{-# DEPRECATED sqlAddCheck "Use sqlAddValidCheck instead" #-}--- | Deprecated version of 'sqlAddValidCheck'.-sqlAddCheck :: Check -> RawSQL ()-sqlAddCheck = sqlAddCheck_ True- -- | Add valid check constraint. Warning: PostgreSQL acquires SHARE ROW -- EXCLUSIVE lock (that prevents updates) on modified table for the duration of -- the creation. If this is not acceptable, use 'sqlAddNotValidCheck' and -- 'sqlValidateCheck'.-sqlAddValidCheck :: Check -> RawSQL ()-sqlAddValidCheck = sqlAddCheck_ True+sqlAddValidCheckMaybeDowntime :: Check -> RawSQL ()+sqlAddValidCheckMaybeDowntime = sqlAddCheck_ True  -- | Add check marked as NOT VALID. This avoids potentially long validation -- blocking updates to modified table for its duration. However, checks created@@ -45,8 +39,8 @@ sqlAddNotValidCheck = sqlAddCheck_ False  -- | Validate check previously created as NOT VALID.-sqlValidateCheck :: Check -> RawSQL ()-sqlValidateCheck Check{..} = "VALIDATE CONSTRAINT" <+> chkName+sqlValidateCheck :: RawSQL () -> RawSQL ()+sqlValidateCheck checkName = "VALIDATE CONSTRAINT" <+> checkName  sqlAddCheck_ :: Bool -> Check -> RawSQL () sqlAddCheck_ valid Check{..} = smconcat [

@@ -4,8 +4,7 @@   , fkOnColumn   , fkOnColumns   , fkName-  , sqlAddFK-  , sqlAddValidFK+  , sqlAddValidFKMaybeDowntime   , sqlAddNotValidFK   , sqlValidateFK   , sqlDropFK@@ -66,17 +65,12 @@     -- PostgreSQL's limit for identifier is 63 characters     shorten = flip rawSQL () . T.take 63 . unRawSQL -{-# DEPRECATED sqlAddFK "Use sqlAddValidFK instead" #-}--- | Deprecated version of sqlAddValidFK.-sqlAddFK :: RawSQL () -> ForeignKey -> RawSQL ()-sqlAddFK = sqlAddFK_ True- -- | Add valid foreign key. Warning: PostgreSQL acquires SHARE ROW EXCLUSIVE -- lock (that prevents data updates) on both modified and referenced table for -- the duration of the creation. If this is not acceptable, use -- 'sqlAddNotValidFK' and 'sqlValidateFK'.-sqlAddValidFK :: RawSQL () -> ForeignKey -> RawSQL ()-sqlAddValidFK = sqlAddFK_ True+sqlAddValidFKMaybeDowntime :: RawSQL () -> ForeignKey -> RawSQL ()+sqlAddValidFKMaybeDowntime = sqlAddFK_ True  -- | Add foreign key marked as NOT VALID. This avoids potentially long -- validation blocking updates to both modified and referenced table for its

@@ -10,10 +10,9 @@   , uniqueIndexOnColumnWithCondition   , uniqueIndexOnColumns   , indexName-  , sqlCreateIndex-  , sqlCreateIndexSequentially+  , sqlCreateIndexMaybeDowntime   , sqlCreateIndexConcurrently-  , sqlDropIndex+  , sqlDropIndexMaybeDowntime   , sqlDropIndexConcurrently   ) where @@ -132,18 +131,13 @@     -- with the same columns, but different constraints can coexist     hashWhere = asText $ T.decodeUtf8 . encode . BS.take 10 . hash . T.encodeUtf8 -{-# DEPRECATED sqlCreateIndex "Use sqlCreateIndexSequentially instead" #-}--- | Deprecated version of 'sqlCreateIndexSequentially'.-sqlCreateIndex :: RawSQL () -> TableIndex -> RawSQL ()-sqlCreateIndex = sqlCreateIndex_ False---- | Create index sequentially. Warning: if the affected table is large, this--- will prevent the table from being modified during the creation. If this is--- not acceptable, use sqlCreateIndexConcurrently. See+-- | Create an index. Warning: if the affected table is large, this will prevent+-- the table from being modified during the creation. If this is not acceptable,+-- use 'CreateIndexConcurrentlyMigration'. See -- https://www.postgresql.org/docs/current/sql-createindex.html for more -- information.-sqlCreateIndexSequentially :: RawSQL () -> TableIndex -> RawSQL ()-sqlCreateIndexSequentially = sqlCreateIndex_ False+sqlCreateIndexMaybeDowntime :: RawSQL () -> TableIndex -> RawSQL ()+sqlCreateIndexMaybeDowntime = sqlCreateIndex_ False  -- | Create index concurrently. sqlCreateIndexConcurrently :: RawSQL () -> TableIndex -> RawSQL ()@@ -163,8 +157,12 @@   , maybe "" (" WHERE" <+>) idxWhere   ] -sqlDropIndex :: RawSQL () -> TableIndex -> RawSQL ()-sqlDropIndex tname idx = "DROP INDEX" <+> indexName tname idx+-- | Drop an index. Warning: if you don't want to lock out concurrent operations+-- on the index's table, use 'DropIndexConcurrentlyMigration'. See+-- https://www.postgresql.org/docs/current/sql-dropindex.html for more+-- information.+sqlDropIndexMaybeDowntime :: RawSQL () -> TableIndex -> RawSQL ()+sqlDropIndexMaybeDowntime tname idx = "DROP INDEX" <+> indexName tname idx  sqlDropIndexConcurrently :: RawSQL () -> TableIndex -> RawSQL () sqlDropIndexConcurrently tname idx = "DROP INDEX CONCURRENTLY" <+> indexName tname idx

@@ -589,7 +589,7 @@       composites    = []       domains       = []   step "Migrating the database (schema version 1 -> schema version 2)..."-  migrateDatabase defaultExtrasOptions extensions composites domains+  migrateDatabase defaultExtrasOptions { eoLockTimeoutMs = Just 1000 } extensions composites domains     schema2Tables schema2Migrations   checkDatabase defaultExtrasOptions composites domains schema2Tables