sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 11:24:51 +09:00
Code Issues Activity

Run DB migrations in Worker monad, to allow convenient MonadSite access

Browse source
This commit is contained in:
fr33domlover 2019-06-12 22:17:06 +00:00
parent b40ef116b1
commit 42febca91f
2 changed files with 18 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
src/Vervis/Application.hs
View file

@ -167,24 +167,25 @@ makeFoundation appSettings = do
hashidsSalt <- loadKeyFile loadMode $ appHashidsSaltFile appSettings hashidsSalt <- loadKeyFile loadMode $ appHashidsSaltFile appSettings
let hashidsCtx = hashidsContext hashidsSalt let hashidsCtx = hashidsContext hashidsSalt
app = mkFoundation pool capSignKey hashidsCtx
-- Perform database migration using our application's logging settings. -- Perform database migration using our application's logging settings.
--runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc --runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
flip runLoggingT logFunc $ flip runWorker app $ runSiteDB $ do
flip runSqlPool pool $ do let hLocal = appInstanceHost appSettings
let hLocal = appInstanceHost appSettings r <- migrateDB hLocal hashidsCtx
r <- migrateDB hLocal hashidsCtx case r of
case r of Left err -> do
Left err -> do let msg = "DB migration failed: " <> err
let msg = "DB migration failed: " <> err $logError msg
$logError msg error $ T.unpack msg
error $ T.unpack msg Right (_from, _to) -> do
Right (_from, _to) -> do $logInfo "DB migration success"
$logInfo "DB migration success" fixRunningDeliveries
fixRunningDeliveries deleteUnusedURAs
deleteUnusedURAs
-- Return the foundation -- Return the foundation
return $ mkFoundation pool capSignKey hashidsCtx return app
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applying some additional middlewares. -- applying some additional middlewares.

5
src/Vervis/Migration.hs
View file

@ -62,6 +62,7 @@ import Database.Persist.JSON
import Web.ActivityPub import Web.ActivityPub
import Yesod.FedURI import Yesod.FedURI
import Yesod.Hashids import Yesod.Hashids
import Yesod.MonadSite
import Data.Either.Local import Data.Either.Local
import Database.Persist.Local import Database.Persist.Local
@ -86,7 +87,7 @@ withPrepare (validate, apply) prepare = (validate, prepare >> apply)
--withPrePost :: Monad m => Apply m -> Mig m -> Apply m -> Mig m --withPrePost :: Monad m => Apply m -> Mig m -> Apply m -> Mig m
--withPrePost pre (validate, apply) post = (validate, pre >> apply >> post) --withPrePost pre (validate, apply) post = (validate, pre >> apply >> post)
changes :: MonadIO m => Text -> HashidsContext -> [Mig m] changes :: MonadSite m => Text -> HashidsContext -> [Mig m]
changes hLocal ctx = changes hLocal ctx =
[ -- 1 [ -- 1
addEntities model_2016_08_04 addEntities model_2016_08_04
@ -671,7 +672,7 @@ changes hLocal ctx =
] ]
migrateDB migrateDB
:: MonadIO m :: MonadSite m
=> Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int)) => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
migrateDB hLocal ctx = migrateDB hLocal ctx =
let f cs = fmap (, length cs) <$> runMigrations schemaBackend 1 cs let f cs = fmap (, length cs) <$> runMigrations schemaBackend 1 cs