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

DB: Migration: When switching repos dir to new layout, remove old sharer dirs

Browse source
This commit is contained in:
fr33domlover 2022-09-26 13:27:16 +00:00
parent 6b0783a10b
commit 482e2e806e
1 changed files with 19 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
src/Vervis/Migration.hs
View file

@ -62,6 +62,7 @@ import Web.PathPieces (toPathPiece)
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as M
import qualified Data.List.Ordered as LO
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
@ -2225,20 +2226,35 @@ changes hLocal ctx =
-- 396
, unchecked $ lift $ do
rs <- selectList [] [Asc Repo396Id]
for_ rs $ \ (Entity rid r) -> do
oldSharerDirs <- fmap (LO.nubSort . catMaybes) $ for rs $ \ (Entity rid r) -> do
root <- asksSite $ appRepoDir . appSettings
parent <- sharer396Ident <$> getJust (repo396Sharer r)
dir <- actor396Name <$> getJust (repo396Actor r)
let old =
let oldSharer =
root
</> (T.unpack $ CI.foldedCase $ unShrIdent parent)
old =
oldSharer
</> (T.unpack $ CI.foldCase dir)
new =
root
</> (T.unpack $ keyHashidText $
encodeKeyHashidPure ctx rid)
--E.toSqlKey $ E.fromSqlKey rid)
liftIO $ renameDirectory old new
liftIO $ do
oldExists <- doesDirectoryExist old
newExists <- doesDirectoryExist new
case (oldExists, newExists) of
(True, False) -> do
renameDirectory old new
return $ Just oldSharer
(True, True) -> error "Both old and new dirs exist"
(False, False) -> error "Repo dir missing"
(False, True) -> do
oldSharerExists <- doesDirectoryExist oldSharer
when oldSharerExists $ removeDirectory oldSharer
pure Nothing
liftIO $ for_ oldSharerDirs removeDirectory
-- 397
, removeField "Repo" "sharer"
-- 398