From 3666f29756e253731cdc7c2d45d6065a4141729b Mon Sep 17 00:00:00 2001
From: Saku Laesvuori <saku@laesvuori.fi>
Date: Fri, 29 Sep 2023 13:48:07 +0300
Subject: [PATCH] Make GC emails also delete orphaned verifications

---
 backend/src/Datarekisteri/Backend/DB/Queries.hs | 7 +++++++
 backend/src/Datarekisteri/CLI.hs                | 1 +
 2 files changed, 8 insertions(+)

diff --git a/backend/src/Datarekisteri/Backend/DB/Queries.hs b/backend/src/Datarekisteri/Backend/DB/Queries.hs
index d31578f..c351533 100644
--- a/backend/src/Datarekisteri/Backend/DB/Queries.hs
+++ b/backend/src/Datarekisteri/Backend/DB/Queries.hs
@@ -137,6 +137,13 @@ deleteExpiredEmails time = runQuery $ delete $ do
     verification <- from $ table @DBEmailVerification
     where_ $ verification ^. DBEmailVerificationExpires <=. val time
 
+deleteOrphanedVerifications :: MonadDB m => m ()
+deleteOrphanedVerifications = runQuery $ delete $ do
+    verification <- from $ table @DBEmailVerification
+    where_ $ (==. val (0 :: Int)) $ subSelectCount $ do
+        email <- from $ table @DBEmail
+        where_ $ email ^. DBEmailVid ==. just (verification ^. DBEmailVerificationId)
+
 deleteUsersWithoutEmail :: MonadDB m => m ()
 deleteUsersWithoutEmail = runQuery $ delete $ do
     user <- from $ table @DBUser
diff --git a/backend/src/Datarekisteri/CLI.hs b/backend/src/Datarekisteri/CLI.hs
index 6458d54..1e4d224 100644
--- a/backend/src/Datarekisteri/CLI.hs
+++ b/backend/src/Datarekisteri/CLI.hs
@@ -58,6 +58,7 @@ gcEmailsMain :: CLIM ()
 gcEmailsMain = do
     time <- currentTime
     deleteExpiredEmails time
+    deleteOrphanedVerifications
 
 gcApplicationsMain :: CLIM ()
 gcApplicationsMain = do