From 52afd13b6dc2b870ab8dbba956874e8950e07973 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 25 Apr 2023 16:08:22 +0000 Subject: [PATCH] fix(users): assimilate merges possibly incomplete user fields --- .../uniworx/categories/user/de-de-formal.msg | 2 +- messages/uniworx/categories/user/en-eu.msg | 2 +- src/Handler/Users.hs | 2 +- src/Handler/Utils/Users.hs | 52 +++++++++++++++---- 4 files changed, 44 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index ab6cdb32b..2184d08e4 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -22,7 +22,7 @@ AdminUserPostAddress: Postalische Anschrift AdminUserPrefersPostal: Briefe anstatt Email bevorzugt AdminUserPinPassword: Passwort zur Verschlüsselung von PDF Anhängen in Emails AdminUserNoPassword: Kein Passwort gesetzt -AdminUserAssimilate: Benutzer assimilieren +AdminUserAssimilate: Diesen Benutzer assimilieren von UserAdded: Benutzer erfolgreich angelegt UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden HeadingUserAdd: Benutzer:in anlegen diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index 64145dcaf..e45b9e154 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -22,7 +22,7 @@ AdminUserPostAddress: Postal Address AdminUserPrefersPostal: Prefers postal letters over email AdminUserPinPassword: Password used for PDF attachments to emails AdminUserNoPassword: No password set -AdminUserAssimilate: Assimilate user +AdminUserAssimilate: Assimilate user by another user UserAdded: Successfully added user UserCollision: Could not create user due to uniqueness constraint HeadingUserAdd: Add user diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 6961ac1f9..45802a918 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -564,7 +564,7 @@ postAdminUserR uuid = do let assimilateForm' = renderAForm FormStandard $ areq (checkMap (first $ const MsgAssimilateUserNotFound) Right $ userField False Nothing) (fslI MsgUserAssimilateUser) Nothing assimilateAction oldUserId = do - res <- try . runDB . setSerializable $ assimilateUser uid oldUserId + res <- try . runDB . setSerializable $ assimilateUser oldUserId uid case res of Left (err :: UserAssimilateException) -> addMessageModal Error (i18n MsgAssimilateUserHaveError) $ Right diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 512291970..1a5e6a033 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -34,7 +34,7 @@ import qualified Data.Aeson as JSON import qualified Data.Aeson.Types as JSON import qualified Data.Set as Set -import qualified Data.List as List +-- import qualified Data.List as List import qualified Data.CaseInsensitive as CI import qualified Database.Esqueleto.Legacy as E @@ -287,6 +287,16 @@ assimilateUser :: UserId -- ^ @newUserId@ -- -- Fatal errors are thrown, non-fatal warnings are returned assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do + -- retrieve user entities first, to ensure they both exist + (oldUserEnt, newUserEnt) <- do + oldUser <- getEntity oldUserId + newUser <- getEntity newUserId + case (oldUser, newUser) of + (Just old, Just new) -> return (old,new) + _ -> tellError UserAssimilateCouldNotDetermineUserIdents + let oldUser = oldUserEnt ^. _entityVal + newUser = newUserEnt ^. _entityVal + E.insertSelectWithConflict UniqueCourseFavourite (E.from $ \courseFavourite -> do @@ -859,18 +869,38 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do (\current _excluded -> [ UserCompanySupervisor E.=. (current E.^. UserCompanySupervisor)] ) deleteWhere [ UserCompanyUser ==. oldUserId] - userIdents <- E.select . E.from $ \user -> do - E.where_ $ user E.^. UserId `E.in_` E.valList [newUserId, oldUserId] - return ( user E.^. UserId - , user E.^. UserIdent - ) - case (,) <$> List.lookup (E.Value oldUserId) userIdents <*> List.lookup (E.Value newUserId) userIdents of - Just (E.Value oldIdent, E.Value newIdent') - | oldIdent /= newIdent' -> audit $ TransactionUserIdentChanged oldIdent newIdent' - | otherwise -> return () - _other -> tellError UserAssimilateCouldNotDetermineUserIdents + -- merge some optional / incomplete user fields + update newUserId [upd | (True, upd) <- -- NOTE: persist does shortcircuit null updates as expected + [ ( isNothing (newUser ^. _userLdapPrimaryKey) && isJust (oldUser ^. _userLdapPrimaryKey) + , UserLdapPrimaryKey =. oldUser ^. _userLdapPrimaryKey ) + , ( newUser ^. _userAuthentication > oldUser ^. _userAuthentication + , UserAuthentication =. oldUser ^. _userAuthentication ) + , ( newUser ^. _userLastAuthentication < oldUser ^. _userLastAuthentication + , UserLastAuthentication =. oldUser ^. _userLastAuthentication ) + , ( newUser ^. _userCreated > oldUser ^. _userCreated + , UserCreated =. oldUser ^. _userCreated ) + , ( not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail) + , UserEmail =. oldUser ^. _userEmail) + , ( not (validEmail' (newUser ^. _userDisplayEmail)) && validEmail' (oldUser ^. _userDisplayEmail) + , UserDisplayEmail =. oldUser ^. _userDisplayEmail) + , ( isNothing (newUser ^. _userMatrikelnummer) && isJust (oldUser ^. _userMatrikelnummer) + , UserMatrikelnummer =. oldUser ^. _userMatrikelnummer ) + , ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress) + , UserPostAddress =. oldUser ^. _userPostAddress ) + , ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress) + , UserPostLastUpdate =. oldUser ^. _userPostLastUpdate ) + , ( (isJust (newUser ^. _userPostAddress) || isJust (oldUser ^. _userPostAddress)) + && (newUser ^. _userPrefersPostal || oldUser ^. _userPrefersPostal) + , UserPrefersPostal =. True ) + , ( isNothing (newUser ^. _userPinPassword) && isJust (oldUser ^. _userPinPassword) + , UserPinPassword =. oldUser ^. _userPinPassword ) + ] + ] delete oldUserId + let oldUsrIdent = oldUser ^. _userIdent + newUsrIdent = newUser ^. _userIdent + when (oldUsrIdent /= newUsrIdent) $ audit $ TransactionUserIdentChanged oldUsrIdent newUsrIdent audit $ TransactionUserAssimilated newUserId oldUserId where tellWarning :: UserAssimilateExceptionReason -> ReaderT SqlBackend (WriterT (Set UserAssimilateException) Handler) ()