diff --git a/backend/db/migrations/20230928115610_remove-deletion-times.sql b/backend/db/migrations/20230928115610_remove-deletion-times.sql new file mode 100644 index 0000000..50f4f34 --- /dev/null +++ b/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; diff --git a/backend/src/Datarekisteri/Backend/API.hs b/backend/src/Datarekisteri/Backend/API.hs index 1ef7269..0614c02 100644 --- a/backend/src/Datarekisteri/Backend/API.hs +++ b/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 diff --git a/backend/src/Datarekisteri/Backend/DB.hs b/backend/src/Datarekisteri/Backend/DB.hs index a115a93..cd24c54 100644 --- a/backend/src/Datarekisteri/Backend/DB.hs +++ b/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) diff --git a/backend/src/Datarekisteri/Backend/DB/Queries.hs b/backend/src/Datarekisteri/Backend/DB/Queries.hs index 79d08f7..976f26e 100644 --- a/backend/src/Datarekisteri/Backend/DB/Queries.hs +++ b/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 diff --git a/backend/src/Datarekisteri/CLI.hs b/backend/src/Datarekisteri/CLI.hs index 7efad22..3c3d633 100644 --- a/backend/src/Datarekisteri/CLI.hs +++ b/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 diff --git a/frontend/schema.gql b/frontend/schema.gql index 6a12ec1..e6be1f4 100644 --- a/frontend/schema.gql +++ b/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! } -