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

refactor(users): fieldLens function allwos more generic code

Browse Source
This commit is contained in:
Steffen Jost 2023-04-25 16:24:47 +00:00
parent 52afd13b6d
commit 5340bf25dc
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -870,30 +870,38 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
deleteWhere [ UserCompanyUser ==. oldUserId]
-- merge some optional / incomplete user fields
let mergeBy :: forall a . PersistField a => (a -> a -> Bool) -> EntityField User a -> (Bool, Update User)
mergeBy cmp uf = let ufl = fieldLens uf
oldV = oldUserEnt ^. ufl
newV = newUserEnt ^. ufl
in (cmp oldV newV, uf =. oldV)
mergeMaybe :: forall b . PersistField b => EntityField User (Maybe b) -> (Bool, Update User)
mergeMaybe = mergeBy (\oldV newV -> isNothing newV && isJust oldV)
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 )
[ 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)
, ( isNothing (newUser ^. _userMatrikelnummer) && isJust (oldUser ^. _userMatrikelnummer)
, UserMatrikelnummer =. oldUser ^. _userMatrikelnummer )
, 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 )
, ( isNothing (newUser ^. _userPinPassword) && isJust (oldUser ^. _userPinPassword)
, UserPinPassword =. oldUser ^. _userPinPassword )
, UserPrefersPostal =. True )
, mergeMaybe UserPinPassword
, mergeMaybe UserLanguages
, mergeMaybe UserSex
, mergeMaybe UserBirthday
, mergeMaybe UserTelephone
, mergeMaybe UserMobile
]
]