chore(avs): email updating implemented
This commit is contained in:
parent
e8d66a4734
commit
9bf38d8198
@ -578,9 +578,9 @@ data CheckAvsUpdate record iavs = forall typ. (Eq typ, PersistField typ) => Chec
|
|||||||
-- | Compute necessary updates. Given an database record, a new and an old avs response and a pair consisting of a getter from avs response to a value and and EntityField of the same value,
|
-- | Compute necessary updates. Given an database record, a new and an old avs response and a pair consisting of a getter from avs response to a value and and EntityField of the same value,
|
||||||
-- an update is returned, if the current value is identical to the old avs value, which changed in the new avs query
|
-- an update is returned, if the current value is identical to the old avs value, which changed in the new avs query
|
||||||
mkUpdate :: PersistEntity record => record -> iavs -> iavs -> CheckAvsUpdate record iavs -> Maybe (Update record)
|
mkUpdate :: PersistEntity record => record -> iavs -> iavs -> CheckAvsUpdate record iavs -> Maybe (Update record)
|
||||||
mkUpdate usr npi opi (CheckAvsUpdate up la)
|
mkUpdate usr newapi oldapi (CheckAvsUpdate up la)
|
||||||
| let newval = npi ^. la
|
| let newval = newapi ^. la
|
||||||
, let oldval = opi ^. la
|
, let oldval = oldapi ^. la
|
||||||
, let usrval = getField up usr
|
, let usrval = getField up usr
|
||||||
, oldval /= newval
|
, oldval /= newval
|
||||||
, oldval == usrval
|
, oldval == usrval
|
||||||
@ -599,7 +599,7 @@ updateAvsUserByIds apids = do
|
|||||||
updateWhere [UserAvsPersonId <-. missing] [UserAvsLastSynch =. now, UserAvsLastSynchError =. Just "Contact unknown for AvsPersonId"]
|
updateWhere [UserAvsPersonId <-. missing] [UserAvsLastSynch =. now, UserAvsLastSynchError =. Just "Contact unknown for AvsPersonId"]
|
||||||
return res
|
return res
|
||||||
where
|
where
|
||||||
procResp (AvsDataContact apid avsPersonInfo avsFirmInfo)
|
procResp (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo)
|
||||||
| apid `Set.notMember` apids = return mempty -- should not occur, neither should one apid occur multiple times withtin the response (if so, all responses processed here in random order)
|
| apid `Set.notMember` apids = return mempty -- should not occur, neither should one apid occur multiple times withtin the response (if so, all responses processed here in random order)
|
||||||
| otherwise = fmap maybeMonoid . runDB . runMaybeT $ do
|
| otherwise = fmap maybeMonoid . runDB . runMaybeT $ do
|
||||||
(Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
|
(Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
|
||||||
@ -608,29 +608,31 @@ updateAvsUserByIds apids = do
|
|||||||
let usrId = userAvsUser usravs
|
let usrId = userAvsUser usravs
|
||||||
usr <- MaybeT $ get usrId
|
usr <- MaybeT $ get usrId
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
let usr_ups = maybeEmpty oldAvsPersonInfo $ \oldAvsPersonInfo' -> mapMaybe (mkUpdate usr avsPersonInfo oldAvsPersonInfo')
|
let per_ups = maybeEmpty oldAvsPersonInfo $ \oldAvsPersonInfo' -> mapMaybe (mkUpdate usr newAvsPersonInfo oldAvsPersonInfo')
|
||||||
[ CheckAvsUpdate UserFirstName _avsInfoFirstName
|
[ CheckAvsUpdate UserFirstName _avsInfoFirstName
|
||||||
, CheckAvsUpdate UserSurname _avsInfoLastName
|
, CheckAvsUpdate UserSurname _avsInfoLastName
|
||||||
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName
|
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName
|
||||||
, CheckAvsUpdate UserBirthday _avsInfoDateOfBirth
|
, CheckAvsUpdate UserBirthday _avsInfoDateOfBirth
|
||||||
, CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo
|
, CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo
|
||||||
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
|
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
|
||||||
-- , CheckAvsUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe nicht im User, aber im AvsInfo
|
-- , CheckAvsUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe nicht im User, aber im AvsInfo PROBLEM: Hängt auch von der FirmenEmail ab und muss daher im Verbund betrachtet werden.
|
||||||
, CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
|
, CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
|
||||||
]
|
]
|
||||||
frm_ups = maybeEmpty oldAvsFirmInfo $ \oldAvsFirmInfo' -> mapMaybe (mkUpdate usr avsFirmInfo oldAvsFirmInfo')
|
frm_ups = maybeEmpty oldAvsFirmInfo $ \oldAvsFirmInfo' -> mapMaybe (mkUpdate usr newAvsFirmInfo oldAvsFirmInfo')
|
||||||
[ CheckAvsUpdate UserPostAddress $ _avsFirmAddress . to (Just . plaintextToStoredMarkup)
|
[ CheckAvsUpdate UserPostAddress $ _avsFirmAddress . to (Just . plaintextToStoredMarkup)
|
||||||
|
|
||||||
]
|
]
|
||||||
-- TODO: update Email
|
eml_up = let -- Comm > Superior > Company > Personal; NOTE: Email update depends on both AvsFirmInfo and AvsPersonInfo simultaneously
|
||||||
-- _avsFirmPrimaryEmail <|> _avsInfoPersonEMail
|
eml_old = (oldAvsFirmInfo ^. _Just . _avsFirmPrimaryEmail) <|> (oldAvsPersonInfo ^. _Just . _avsInfoPersonEMail)
|
||||||
|
eml_new = (newAvsFirmInfo ^. _avsFirmPrimaryEmail) <|> (newAvsPersonInfo ^. _avsInfoPersonEMail)
|
||||||
|
in mkUpdate usr eml_new eml_old $ CheckAvsUpdate UserDisplayEmail $ to (fromMaybe mempty) . from _CI
|
||||||
|
usr_ups = mcons eml_up $ frm_ups <> per_ups
|
||||||
-- TODO: update Company
|
-- TODO: update Company
|
||||||
avs_ups = maybeToList ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo avsPersonInfo))
|
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
|
||||||
<> [ UserAvsLastSynch =. now
|
[ UserAvsLastSynch =. now
|
||||||
, UserAvsLastSynchError =. Nothing
|
, UserAvsLastSynchError =. Nothing
|
||||||
, UserAvsLastPersonInfo =. Just avsPersonInfo
|
, UserAvsLastPersonInfo =. Just newAvsPersonInfo
|
||||||
, UserAvsLastFirmInfo =. Just avsFirmInfo
|
, UserAvsLastFirmInfo =. Just newAvsFirmInfo
|
||||||
]
|
]
|
||||||
lift $ update usrId $ usr_ups <> frm_ups
|
lift $ update usrId usr_ups
|
||||||
lift $ update uaId avs_ups
|
lift $ update uaId avs_ups
|
||||||
return $ Set.singleton (apid, usrId)
|
return $ Set.singleton (apid, usrId)
|
||||||
|
|||||||
Reference in New Issue
Block a user