diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index c48e31169..aa17b586d 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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 diff --git a/src/Handler/Utils/AvsUpdate.hs b/src/Handler/Utils/AvsUpdate.hs index 6b60c0780..a468d4392 100644 --- a/src/Handler/Utils/AvsUpdate.hs +++ b/src/Handler/Utils/AvsUpdate.hs @@ -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 diff --git a/src/Handler/Utils/Company.hs b/src/Handler/Utils/Company.hs index b60423756..81b76d10f 100644 --- a/src/Handler/Utils/Company.hs +++ b/src/Handler/Utils/Company.hs @@ -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 diff --git a/src/Utils.hs b/src/Utils.hs index 94baeef10..4d6113ba0 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -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