fraport/fradrive
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
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'

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)] )
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