From f906b107de06de07a032a0e9a51867a543738625 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 26 Apr 2023 13:22:29 +0000 Subject: [PATCH] chore(user): complete user assimilation for avs data --- src/Handler/Users.hs | 7 +++--- src/Handler/Utils/Users.hs | 44 +++++++++++++++++++++++--------------- 2 files changed, 31 insertions(+), 20 deletions(-) diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 45802a918..67e3ac395 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -563,8 +563,8 @@ postAdminUserR uuid = do redirect $ AdminUserR uuid let assimilateForm' = renderAForm FormStandard $ areq (checkMap (first $ const MsgAssimilateUserNotFound) Right $ userField False Nothing) (fslI MsgUserAssimilateUser) Nothing - assimilateAction oldUserId = do - res <- try . runDB . setSerializable $ assimilateUser oldUserId uid + assimilateAction newUserId = do + res <- try . runDB . setSerializable $ assimilateUser newUserId uid case res of Left (err :: UserAssimilateException) -> addMessageModal Error (i18n MsgAssimilateUserHaveError) $ Right @@ -583,7 +583,8 @@ postAdminUserR uuid = do #{tshow warning} |] addMessageI Success MsgAssimilateUserSuccess - redirect $ AdminUserR uuid + newUuid <- encrypt newUserId + redirect $ AdminUserR newUuid ((rightsResult, rightsFormWidget), rightsFormEnctype) <- runFormPost . identifyForm FIDUserRights $ userRightsForm ((authResult, authFormWidget), authFormEnctype) <- runFormPost . identifyForm FIDUserAuthentication $ userAuthenticationForm ((systemFunctionsResult, systemFunctionsWidget), systemFunctionsEnctype) <- runFormPost . identifyForm FIDUserSystemFunctions $ renderAForm FormStandard systemFunctionsForm' diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index f5ed9107f..b5948021e 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -869,41 +869,51 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do (\current _excluded -> [ UserCompanySupervisor E.=. (current E.^. UserCompanySupervisor)] ) deleteWhere [ UserCompanyUser ==. oldUserId] + mbOldAvsId <- getBy $ UniqueUserAvsUser oldUserId + mbNewAvsId <- getBy $ UniqueUserAvsUser newUserId + case (mbOldAvsId,mbNewAvsId) of + (Nothing, _) + -> return () + (Just Entity{entityVal=UserAvs{userAvsPersonId=oldAvsId}}, Just _) + -> deleteWhere [UserAvsCardPersonId ==. oldAvsId] >> deleteBy (UniqueUserAvsUser oldUserId) + (Just Entity{entityVal=oldUserAvs}, Nothing) + -> -- deleteBy $ UniqueUserAvsUser oldUserId -- maybe we need this due to double uniqueness?! + void $ upsertBy (UniqueUserAvsId (oldUserAvs ^. _userAvsPersonId)) oldUserAvs{userAvsUser=newUserId} [UserAvsUser =. newUserId] + -- merge some optional / incomplete user fields - let mergeBy :: forall a . PersistField a => (a -> a -> Bool) -> EntityField User a -> (Bool, Update User) + let mergeBy :: forall a . PersistField a => (a -> a -> Bool) -> EntityField User a -> Maybe (Update User) mergeBy cmp uf = let ufl = fieldLens uf oldV = oldUserEnt ^. ufl newV = newUserEnt ^. ufl - in (cmp oldV newV, uf =. oldV) + in toMaybe (cmp oldV newV) (uf =. oldV) - mergeMaybe :: forall b . PersistField b => EntityField User (Maybe b) -> (Bool, Update User) + mergeMaybe :: forall b . PersistField b => EntityField User (Maybe b) -> Maybe (Update User) mergeMaybe = mergeBy (\oldV newV -> isNothing newV && isJust oldV) - update newUserId [upd | (True, upd) <- -- NOTE: persist does shortcircuit null updates as expected + update newUserId $ catMaybes -- NOTE: persist does shortcircuit null updates as expected [ mergeMaybe UserLdapPrimaryKey , mergeBy (<) UserAuthentication , mergeBy (>) UserLastAuthentication , mergeBy (<) UserCreated - , ( not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail) - , UserEmail =. oldUser ^. _userEmail) - , ( not (validEmail' (newUser ^. _userDisplayEmail)) && validEmail' (oldUser ^. _userDisplayEmail) - , UserDisplayEmail =. oldUser ^. _userDisplayEmail) + , toMaybe (not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail)) + (UserEmail =. oldUser ^. _userEmail) + , toMaybe (not (validEmail' (newUser ^. _userDisplayEmail)) && validEmail' (oldUser ^. _userDisplayEmail)) + (UserDisplayEmail =. oldUser ^. _userDisplayEmail) , mergeMaybe 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 ) + , toMaybe (isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress)) + (UserPostAddress =. oldUser ^. _userPostAddress) + , toMaybe (isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress)) + (UserPostLastUpdate =. oldUser ^. _userPostLastUpdate) + , toMaybe ((isJust (newUser ^. _userPostAddress) || isJust (oldUser ^. _userPostAddress)) + && (newUser ^. _userPrefersPostal || oldUser ^. _userPrefersPostal)) + (UserPrefersPostal =. True) , mergeMaybe UserPinPassword , mergeMaybe UserLanguages , mergeMaybe UserSex , mergeMaybe UserBirthday , mergeMaybe UserTelephone , mergeMaybe UserMobile - ] - ] + ] delete oldUserId let oldUsrIdent = oldUser ^. _userIdent