DB: Migration: Check for surprisingly named foreign constraints, fail if found

Because finding them may be a sign of undetected error in the migration plan,
so it's best to stop and find it
This commit is contained in:
fr33domlover 2022-09-26 12:48:21 +00:00
parent 0e6a9d3269
commit 206d140b95

View file

@ -24,6 +24,7 @@ import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Data.Aeson
@ -45,6 +46,7 @@ import Database.Persist
import Database.Persist.BackendDataType (backendDataType, PersistDefault (..))
import Database.Persist.Migration
import Database.Persist.Schema (SchemaT, Migration)
import Database.Persist.Schema.SQL
import Database.Persist.Schema.Types hiding (Entity)
import Database.Persist.Schema.PostgreSQL (schemaBackend)
import Database.Persist.Sql (SqlBackend, toSqlKey, fromSqlKey)
@ -2707,6 +2709,12 @@ changes hLocal ctx =
migrateDB
:: (MonadSite m, SiteEnv m ~ App)
=> Host -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
migrateDB hLocal ctx =
let f cs = fmap (, length cs) <$> runMigrations schemaBackend "" 1 cs
in f $ changes hLocal ctx
migrateDB hLocal ctx = runExceptT $ do
ExceptT $ flip runReaderT (schemaBackend, "") $ runExceptT $ do
foreigns <- lift findMisnamedForeigns
unless (null foreigns) $
throwE $ T.intercalate " ; " (map displayMisnamedForeign foreigns)
let migrations = changes hLocal ctx
(,length migrations) <$>
ExceptT (runMigrations schemaBackend "" 1 migrations)