diff --git a/backend/src/Datarekisteri/Backend/DB/Queries.hs b/backend/src/Datarekisteri/Backend/DB/Queries.hs index 7f68596..6990e5d 100644 --- a/backend/src/Datarekisteri/Backend/DB/Queries.hs +++ b/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 diff --git a/backend/src/Datarekisteri/CLI.hs b/backend/src/Datarekisteri/CLI.hs index 3c3d633..a0c0d2f 100644 --- a/backend/src/Datarekisteri/CLI.hs +++ b/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