fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(user): complete user assimilation for avs data

Browse Source
This commit is contained in:
Steffen Jost 2023-04-26 13:22:29 +00:00
parent 5340bf25dc
commit f906b107de
2 changed files with 31 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Handler/Users.hs
View File

@ -563,8 +563,8 @@ postAdminUserR uuid = do
redirect $ AdminUserR uuid redirect $ AdminUserR uuid
let assimilateForm' = renderAForm FormStandard $ let assimilateForm' = renderAForm FormStandard $
areq (checkMap (first $ const MsgAssimilateUserNotFound) Right $ userField False Nothing) (fslI MsgUserAssimilateUser) Nothing areq (checkMap (first $ const MsgAssimilateUserNotFound) Right $ userField False Nothing) (fslI MsgUserAssimilateUser) Nothing
assimilateAction oldUserId = do assimilateAction newUserId = do
res <- try . runDB . setSerializable $ assimilateUser oldUserId uid res <- try . runDB . setSerializable $ assimilateUser newUserId uid
case res of case res of
Left (err :: UserAssimilateException) -> Left (err :: UserAssimilateException) ->
addMessageModal Error (i18n MsgAssimilateUserHaveError) $ Right addMessageModal Error (i18n MsgAssimilateUserHaveError) $ Right
@ -583,7 +583,8 @@ postAdminUserR uuid = do
#{tshow warning} #{tshow warning}
|] |]
addMessageI Success MsgAssimilateUserSuccess addMessageI Success MsgAssimilateUserSuccess
redirect $ AdminUserR uuid newUuid <- encrypt newUserId
redirect $ AdminUserR newUuid
((rightsResult, rightsFormWidget), rightsFormEnctype) <- runFormPost . identifyForm FIDUserRights $ userRightsForm ((rightsResult, rightsFormWidget), rightsFormEnctype) <- runFormPost . identifyForm FIDUserRights $ userRightsForm
((authResult, authFormWidget), authFormEnctype) <- runFormPost . identifyForm FIDUserAuthentication $ userAuthenticationForm ((authResult, authFormWidget), authFormEnctype) <- runFormPost . identifyForm FIDUserAuthentication $ userAuthenticationForm
((systemFunctionsResult, systemFunctionsWidget), systemFunctionsEnctype) <- runFormPost . identifyForm FIDUserSystemFunctions $ renderAForm FormStandard systemFunctionsForm' ((systemFunctionsResult, systemFunctionsWidget), systemFunctionsEnctype) <- runFormPost . identifyForm FIDUserSystemFunctions $ renderAForm FormStandard systemFunctionsForm'

44
src/Handler/Utils/Users.hs
View File

@ -869,41 +869,51 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
(\current _excluded -> [ UserCompanySupervisor E.=. (current E.^. UserCompanySupervisor)] ) (\current _excluded -> [ UserCompanySupervisor E.=. (current E.^. UserCompanySupervisor)] )
deleteWhere [ UserCompanyUser ==. oldUserId] 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 -- 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 mergeBy cmp uf = let ufl = fieldLens uf
oldV = oldUserEnt ^. ufl oldV = oldUserEnt ^. ufl
newV = newUserEnt ^. 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) 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 [ mergeMaybe UserLdapPrimaryKey
, mergeBy (<) UserAuthentication , mergeBy (<) UserAuthentication
, mergeBy (>) UserLastAuthentication , mergeBy (>) UserLastAuthentication
, mergeBy (<) UserCreated , mergeBy (<) UserCreated
, ( not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail) , toMaybe (not (validEmail' (newUser ^. _userEmail )) && validEmail' (oldUser ^. _userEmail))
, UserEmail =. oldUser ^. _userEmail) (UserEmail =. oldUser ^. _userEmail)
, ( not (validEmail' (newUser ^. _userDisplayEmail)) && validEmail' (oldUser ^. _userDisplayEmail) , toMaybe (not (validEmail' (newUser ^. _userDisplayEmail)) && validEmail' (oldUser ^. _userDisplayEmail))
, UserDisplayEmail =. oldUser ^. _userDisplayEmail) (UserDisplayEmail =. oldUser ^. _userDisplayEmail)
, mergeMaybe UserMatrikelnummer , mergeMaybe UserMatrikelnummer
, ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress) , toMaybe (isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress))
, UserPostAddress =. oldUser ^. _userPostAddress ) (UserPostAddress =. oldUser ^. _userPostAddress)
, ( isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress) , toMaybe (isNothing (newUser ^. _userPostAddress) && isJust (oldUser ^. _userPostAddress))
, UserPostLastUpdate =. oldUser ^. _userPostLastUpdate ) (UserPostLastUpdate =. oldUser ^. _userPostLastUpdate)
, ( (isJust (newUser ^. _userPostAddress) || isJust (oldUser ^. _userPostAddress)) , toMaybe ((isJust (newUser ^. _userPostAddress) || isJust (oldUser ^. _userPostAddress))
&& (newUser ^. _userPrefersPostal || oldUser ^. _userPrefersPostal) && (newUser ^. _userPrefersPostal || oldUser ^. _userPrefersPostal))
, UserPrefersPostal =. True ) (UserPrefersPostal =. True)
, mergeMaybe UserPinPassword , mergeMaybe UserPinPassword
, mergeMaybe UserLanguages , mergeMaybe UserLanguages
, mergeMaybe UserSex , mergeMaybe UserSex
, mergeMaybe UserBirthday , mergeMaybe UserBirthday
, mergeMaybe UserTelephone , mergeMaybe UserTelephone
, mergeMaybe UserMobile , mergeMaybe UserMobile
] ]
]
delete oldUserId delete oldUserId
let oldUsrIdent = oldUser ^. _userIdent let oldUsrIdent = oldUser ^. _userIdent