fix(avs): using firm superior as UserEmail is a no-go due to uniqueness constraints
Thus, we do not save the firm superior as `UserEmail` any more. The firm superior email is still used as a fallback for `CompanyEmail` which in turn is used as a fallback email, if a `CompanyUser` has no valid email at all.
This commit is contained in:
parent
43f5c5f485
commit
507a7e02fc
@ -51,7 +51,7 @@ import Jobs.Queue
|
||||
|
||||
import Utils.Avs
|
||||
import Utils.Users
|
||||
import Utils.Mail (validEmail)
|
||||
-- import Utils.Mail (validEmail)
|
||||
import Handler.Utils.Users
|
||||
import Handler.Utils.Company
|
||||
import Handler.Utils.Qualification
|
||||
@ -366,12 +366,12 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
|
||||
, CU_API_UserMatrikelnummer
|
||||
-- , CU_API_UserCompanyPersonalNumber -- needs special treatment, see ldap_ups above
|
||||
]
|
||||
eml_up1 = mkUpdate usr newAvsDataContact oldAvsDataContact $ mkCheckUpdate CU_ADC_UserDisplayEmail -- DisplayEmail updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
|
||||
eml_up2 = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ mkCheckUpdate CU_AFI_UserEmail -- Email update erfolgt nur, wenn hier die SuperiorEmail als Fallback gespeichert wurde
|
||||
eml_up = mkUpdate usr newAvsDataContact oldAvsDataContact $ mkCheckUpdate CU_ADC_UserDisplayEmail -- DisplayEmail updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
|
||||
-- eml_up2 = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ mkCheckUpdate CU_AFI_UserEmail -- Email update erfolgt nur, wenn hier die SuperiorEmail als Fallback gespeichert wurde; UserEmail Uniqueness nicht gewährleistet
|
||||
frm_up = mkUpdate' usr newAvsFirmInfo oldAvsFirmInfo $ mkCheckUpdate CU_AFI_UserPostAddress -- Legacy, if company postal is stored in user; should no longer be true for new users, since company address should now be referenced with UserCompany instead
|
||||
pin_up = mkUpdate' usr newAvsCardNo oldAvsCardNo $ -- Maybe update PDF pin to latest card
|
||||
CheckUpdate UserPinPassword $ to $ fmap avsFullCardNo2pin -- _Just . to avsFullCardNo2pin . re _Just
|
||||
usr_up1 = catMaybes [eml_up1, eml_up2, frm_up, pin_up] <> ldap_ups <> per_ups
|
||||
usr_up1 = mconss [eml_up, frm_up, pin_up] $ ldap_ups <> per_ups
|
||||
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
|
||||
[ UserAvsLastSynch =. now
|
||||
, UserAvsLastSynchError =. Nothing
|
||||
@ -531,14 +531,14 @@ createAvsUserById muid api = do
|
||||
(Nothing, Nothing) -> do -- create fresh user
|
||||
Entity{entityKey=cid, entityVal=cmp} <- runDB $ upsertAvsCompany firmInfo Nothing -- individual runDB, since no need to rollback
|
||||
let pinPass = avsFullCardNo2pin <$> usrCardNo
|
||||
superiorEmail = filterMaybe validEmail $ adc ^. _avsContactFirmInfo . _avsFirmEMailSuperior
|
||||
-- superiorEmail = filterMaybe validEmail $ adc ^. _avsContactFirmInfo . _avsFirmEMailSuperior
|
||||
newUserData = AddUserData
|
||||
{ audTitle = Nothing
|
||||
, audFirstName = cpi ^. _avsInfoFirstName & Text.strip
|
||||
, audSurname = cpi ^. _avsInfoLastName & Text.strip
|
||||
, audDisplayName = cpi ^. _avsInfoDisplayName
|
||||
, audDisplayEmail = adc ^. _avsContactPrimaryEmail . to (fromMaybe mempty) . from _CI
|
||||
, audEmail = maybe ("AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI) stripCI superiorEmail
|
||||
, audEmail = "AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI
|
||||
, audIdent = "AVSID:" <> ciShow api
|
||||
, audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) internalPersNo
|
||||
, audMatriculation = cpi ^. _avsInfoPersonNo & Just
|
||||
|
||||
@ -87,7 +87,7 @@ instance MkCheckUpdate CU_AvsDataContcat_User where
|
||||
|
||||
data CU_AvsFirmInfo_User
|
||||
= CU_AFI_UserPostAddress
|
||||
| CU_AFI_UserEmail
|
||||
-- CU_AFI_UserEmail -- PROBLEM: UserEmail must be unique!
|
||||
-- CU_AFI_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead
|
||||
deriving (Show, Eq)
|
||||
|
||||
@ -95,7 +95,7 @@ instance MkCheckUpdate CU_AvsFirmInfo_User where
|
||||
type MCU_Rec CU_AvsFirmInfo_User = User
|
||||
type MCU_Raw CU_AvsFirmInfo_User = AvsFirmInfo
|
||||
mkCheckUpdate CU_AFI_UserPostAddress = CheckUpdate UserPostAddress _avsFirmPostAddress
|
||||
mkCheckUpdate CU_AFI_UserEmail = CheckUpdateOpt UserEmail $ _avsFirmEMailSuperior . _Just . from _CI -- in rare cases, firm superior email is used as fallback here
|
||||
-- mkCheckUpdate CU_AFI_UserEmail = CheckUpdateOpt UserEmail $ _avsFirmEMailSuperior . _Just . from _CI -- in rare cases, firm superior email is used as fallback here; but UserEmail must be unique!
|
||||
-- mkCheckUpdate CU_AFI_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _avsFirmPrimaryEmail . _Just . from _CI -- Maybe im AvsInfo, aber nicht im User, daher Opt
|
||||
|
||||
|
||||
|
||||
@ -164,13 +164,10 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d
|
||||
usrPrefPostUp = toMaybe (Just usrPrefPost == (mbOldComp ^? _Just . _companyPrefersPostal))
|
||||
(UserPrefersPostal =. companyPrefersPostal newCompany)
|
||||
-- newCmpEmail :: UserEmail = fromMaybe "" $ companyEmail newCompany
|
||||
usrEmail :: UserEmail = userEmail usrRec
|
||||
usrDisplayEmail :: UserEmail = userDisplayEmail usrRec
|
||||
avsEmail :: Maybe UserEmail = mbUsrAvs ^? _Just . _entityVal . _userAvsLastFirmInfo . _Just . _avsFirmPrimaryEmail . _Just . from _CI
|
||||
usrDisplayEmailUp = toMaybe (usrPostEmailUpds && avsEmail == Just usrDisplayEmail) (UserDisplayEmail =. "") -- delete DisplayEmail, if equal to AVS Firm Email
|
||||
supEmail :: Maybe UserEmail = mbUsrAvs ^? _Just . _entityVal . _userAvsLastFirmInfo . _Just . _avsFirmEMailSuperior . _Just . from _CI
|
||||
usrEmailUp = toMaybe (usrPostEmailUpds && supEmail == Just usrEmail) (UserEmail =. "") -- delete UserEmail, if equal to AVS Firm Superior
|
||||
usrUpdate = catMaybes [usrPostUp, usrPrefPostUp, usrDisplayEmailUp, usrEmailUp]
|
||||
usrUpdate = catMaybes [usrPostUp, usrPrefPostUp, usrDisplayEmailUp]
|
||||
-- [UserPostAddress =. Nothing, UserPrefersPostal =. companyPrefersPostal newCompany] -- unconditional
|
||||
-- update uid usrUpdate
|
||||
-- repsertSuperiorSupervisor is not called here, since the Superior is indepentent of the actual company association
|
||||
|
||||
@ -991,7 +991,7 @@ catchIfMPlus :: forall m e a. (MonadPlus m, MonadCatch m, Exception e) => (e ->
|
||||
catchIfMPlus p act = catchIf p act (const mzero)
|
||||
|
||||
-- | Monadic version of 'fromMaybe'
|
||||
-- Warning: fromMaybeM [1,2,3] [Nothing, Just 4, Just 5, Nothing] == [1,2,3,4,5,1,2,3] and fromMaybeM [1,2,3] [Just 4] == [4]
|
||||
-- Warning: fromMaybeM [1,2,3] [Nothing, Just 4, Just 5, Nothing] == [1,2,3,4,5,1,2,3] and fromMaybeM [1,2,3] [Just 4] == [4], use `mconss` instead
|
||||
fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a
|
||||
fromMaybeM act = maybeM act pure
|
||||
|
||||
@ -1002,6 +1002,13 @@ mcons :: Maybe a -> [a] -> [a]
|
||||
mcons Nothing xs = xs
|
||||
mcons (Just x) xs = x:xs
|
||||
|
||||
mconss :: [Maybe a] -> [a] -> [a]
|
||||
mconss [] tl = tl
|
||||
mconss (m:xs) tl
|
||||
| Just x <- m = x : mconss xs tl
|
||||
| otherwise = mconss xs tl
|
||||
|
||||
|
||||
-- | apply binary function to maybes, but ignores Nothing by using id if possible, unlike fmap/ap
|
||||
ignoreNothing :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
|
||||
ignoreNothing _ Nothing y = y
|
||||
|
||||
Loading…
Reference in New Issue
Block a user