ry
/
datarekisteri
6
0
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Add CLI command to delete expired applications

This commit is contained in:
Saku Laesvuori 2023-09-28 21:54:59 +03:00
parent 47c6ebf9a1
commit 1ca82b4907
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
2 changed files with 14 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
backend/src/Datarekisteri/Backend/DB/Queries.hs
View File

@ -136,6 +136,13 @@ deleteExpiredEmails time = runQuery $ delete $ do
verification <- from $ table @DBEmailVerification verification <- from $ table @DBEmailVerification
where_ $ verification ^. DBEmailVerificationExpires <=. val time 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 :: (MonadDB m, MonadTime m) => UserID -> Email -> Text -> m (Key DBEmail)
updateEmail user email secret = getExpireTime >>= \expires -> runQuery $ do updateEmail user email secret = getExpireTime >>= \expires -> runQuery $ do

7
backend/src/Datarekisteri/CLI.hs
View File

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