Add CLI command to delete expired applications

backend/src/Datarekisteri/Backend/DB/Queries.hs

@@ -136,6 +136,13 @@ deleteExpiredEmails time = runQuery $ delete $ do
     verification <- from $ table @DBEmailVerification
     where_ $ verification ^. DBEmailVerificationExpires <=. val time
 
+deleteUsersWithoutEmail :: MonadDB m => m ()
+deleteUsersWithoutEmail = runQuery $ delete $ do
+    user <- from $ table @DBUser
+    where_ $ (==. val (0 :: Int)) $ subSelectCount $ do
+        email <- from $ table @DBEmail
+        where_ $ email ^. DBEmailUid ==. user ^. DBUserId
+        pure $ email ^. DBEmailId -- Not used anywhere
 
 updateEmail :: (MonadDB m, MonadTime m) => UserID -> Email -> Text -> m (Key DBEmail)
 updateEmail user email secret = getExpireTime >>= \expires -> runQuery $ do

backend/src/Datarekisteri/CLI.hs

@@ -26,6 +26,7 @@ main = do
     runCLIM optionsDBUrl $ case optionsSubCommand of
       (AddUser addUserOpts) -> addUserMain addUserOpts
       GCEmails -> gcEmailsMain
+      GCApplications -> gcApplicationsMain
 
 addUserMain :: AddUserOpts -> CLIM ()
 addUserMain AddUserOpts {..} = do
@@ -57,6 +58,10 @@ gcEmailsMain = do
     time <- currentTime
     deleteExpiredEmails time
 
+gcApplicationsMain :: CLIM ()
+gcApplicationsMain = do
+    deleteUsersWithoutEmail
+
 cliOptions :: Parser CLIOptions
 cliOptions = CLIOptions
     <$> strOption (short 'u' <> long "db-url" <> metavar "URL" <> value "postgres:///datarekisteri-backend")
@@ -66,6 +71,7 @@ cliCommandParser :: Parser CLISubCommand
 cliCommandParser = hsubparser
     $ command "add-user" (info addUserCommand (progDesc "Add a user to datarekisteri"))
     <> command "gc-expired-emails" (info (pure GCEmails) (progDesc "Delete emails that have not been verified in time."))
+    <> command "gc-applications" (info (pure GCApplications) (progDesc "Delete users without an email address"))
 
 addUserCommand :: Parser CLISubCommand
 addUserCommand = fmap AddUser $ AddUserOpts
@@ -90,6 +96,7 @@ data CLIOptions = CLIOptions
 
 data CLISubCommand = AddUser AddUserOpts
                    | GCEmails
+                   | GCApplications
 
 data AddUserOpts = AddUserOpts
         { addUserNickname :: Maybe Text