Delete rejected applications immediately

backend/db/migrations/20230928115610_remove-deletion-times.sql

@@ -0,0 +1,16 @@
+-- migrate:up
+
+delete from "users"
+    where "rejected" is not null or "seceded" is not null or "toBeDeleted" is not null;
+
+alter table "users"
+    drop "rejected",
+    drop "seceded",
+    drop "toBeDeleted";
+
+-- migrate:down
+
+alter table "users"
+    add "rejected" timestamp,
+    add "seceded" timestamp,
+    add "toBeDeleted" timestamp;

backend/src/Datarekisteri/Backend/API.hs

@@ -27,7 +27,6 @@ import Data.Maybe (fromJust)
 import Data.Morpheus.Server (deriveApp, runApp)
 import Data.Morpheus.Server.Types (defaultRootResolver, RootResolver(..), Undefined)
 import Data.Morpheus.Types (Arg(..), GQLType, GQLError, App)
-import Data.Time (nominalDay)
 import Database.Persist (Entity, entityVal, entityKey, get, (=.))
 import Datarekisteri.Core.Types
 import Datarekisteri.Backend.DB
@@ -69,8 +68,7 @@ dbUserToUser user = let id = entityToID user
                         , homeplace = pure homeplace
                         , registered = pure dBUserRegistered
                         , accepted = pure dBUserAccepted
-                        , seceded = pure dBUserSeceded
-                        , isMember = pure $ isJust dBUserAccepted && not (isJust dBUserSeceded)
+                        , isMember = pure $ isJust dBUserAccepted
                         , permissions = pure dBUserPermissions
                         , application = pure application
                         }
@@ -107,7 +105,6 @@ newUser :: (MonadEmail m, MonadDB m, MonadRandom m, MonadTime m, MonadError GQLE
     ApplicationData -> m UserID
 newUser (ApplicationData {..}) = do
     time <- currentTime
-    verificationExpires <- verificationExpireTime
     secret <- genVerificationSecret
     passwordHash <- hashPassword password
     permissions <- defaultPermissions
@@ -117,12 +114,9 @@ newUser (ApplicationData {..}) = do
     let memberData = MemberData { nickname = nickname >>= \x -> if T.null x then Nothing else Just x, ..}
     user <- addUser $ DBUser
         { dBUserRegistered = time
-        , dBUserToBeDeleted = Just $ verificationExpires
         , dBUserPasswordCrypt = passwordHash
         , dBUserPermissions = permissions
         , dBUserAccepted = Nothing
-        , dBUserSeceded = Nothing
-        , dBUserRejected = Nothing
         , dBUserMemberData = toJSON memberData
         }
     verification <- addEmailVerification secret
@@ -134,9 +128,6 @@ newUser (ApplicationData {..}) = do
     sendVerificationSecret email
     return user
 
-verificationExpireTime :: MonadTime m => m Time
-verificationExpireTime = addTime (7 * nominalDay) <$> currentTime
-
 genVerificationSecret :: MonadRandom m => m Text
 genVerificationSecret = T.intercalate "-" . T.chunksOf 4 . base32 <$> getRandomBytes 10
 
@@ -216,9 +207,9 @@ rejectApplication user = void $ do
     case maybeEmail of
       Nothing -> throwError $ "No valid application for " <> show user <> "!"
       Just email -> do
-          time <- currentTime
-          markAsRejected user time
-          void $ sendApplicationRejectedEmail $ dBEmailEmail $ entityVal email
+          applicationDeleted <- deleteApplication user
+          when applicationDeleted $
+              sendApplicationRejectedEmail $ dBEmailEmail $ entityVal email
 
 resolveQuery :: (MonadRequest m, MonadDB m, MonadError GQLError m, MonadPermissions m) => Query m
 resolveQuery = Query
@@ -281,7 +272,6 @@ data User m = User
     , homeplace :: m Text
     , registered :: m Time
     , accepted :: m (Maybe Time)
-    , seceded :: m (Maybe Time)
     , permissions :: m Text
     , isMember :: m Bool
     , application :: m Text

backend/src/Datarekisteri/Backend/DB.hs

@@ -29,9 +29,6 @@ DBUser sql=users
   passwordCrypt PasswordHash
   permissions Text
   accepted (Maybe Time)
-  rejected (Maybe Time)
-  seceded (Maybe Time)
-  toBeDeleted (Maybe Time)
   memberData Value sqltype=jsonb
 
   deriving (Show)

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

@@ -89,10 +89,9 @@ hasVerifiedEmail userId = not_ $ isNothing $ subSelect $ do
 isApplicant :: SqlExpr (Entity DBUser) -> SqlExpr (Value Bool)
 isApplicant user = isNothing (user ^. DBUserAccepted)
     &&. hasVerifiedEmail (user ^. DBUserId)
-    &&. isNothing (user ^. DBUserRejected)
 
 isMember :: SqlExpr (Entity DBUser) -> SqlExpr (Value Bool)
-isMember user = not_ (isNothing (user ^. DBUserAccepted)) &&. isNothing (user ^. DBUserSeceded)
+isMember user = not_ $ isApplicant user
 
 verifyEmailSecret :: MonadDB m => Text -> m Bool
 verifyEmailSecret secret = runQuery $ do
@@ -166,9 +165,9 @@ markAsAccepted userID time = runQuery $ update $ \user -> do
     set user [DBUserAccepted =. just (val time)]
     where_ $ user ^. DBUserId ==. val (toDBKey userID) &&. isApplicant user
 
-markAsRejected :: MonadDB m => UserID -> Time -> m ()
-markAsRejected userID time = runQuery $ update $ \user -> do
-    set user [DBUserRejected =. just (val time)]
+deleteApplication :: MonadDB m => UserID -> m Bool
+deleteApplication userID = fmap (> 0) $ runQuery $ deleteCount $ do
+    user <- from $ table @DBUser
     where_ $ user ^. DBUserId ==. val (toDBKey userID) &&. isApplicant user
 
 updateUserData :: MonadDB m => UserID -> [Persist.Update DBUser] -> [UserUpdate] -> m UserID

backend/src/Datarekisteri/CLI.hs

@@ -33,12 +33,9 @@ addUserMain AddUserOpts {..} = do
     passwordHash <- putStr "Password: " >> liftIO (withoutInputEcho getLine) >>= hashPassword
     userID <- addUser $ DBUser
         { dBUserRegistered = time
-        , dBUserToBeDeleted = Nothing
         , dBUserPasswordCrypt = passwordHash
         , dBUserPermissions = show addUserPermissions
         , dBUserAccepted = Just time
-        , dBUserSeceded = Nothing
-        , dBUserRejected = Nothing
         , dBUserMemberData = toJSON $ MemberData
             { nickname = addUserNickname
             , name = addUserName

frontend/schema.gql

@@ -50,7 +50,6 @@ type User {
   homeplace: String!
   registered: Time!
   accepted: Time
-  seceded: Time
   permissions: String!
   isMember: Boolean!
   application: String!
@@ -76,4 +75,3 @@ type Mutation {
   accept(user: UserID!): Unit!
   reject(user: UserID!): Unit!
 }
-