From 482e2e806e9dd5ad0b19e7df99fd821c52812a18 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Mon, 26 Sep 2022 13:27:16 +0000
Subject: [PATCH] DB: Migration: When switching repos dir to new layout, remove
 old sharer dirs

---
 src/Vervis/Migration.hs | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index 9b970ec..fa23bda 100644
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@@ -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