fix(avs): fix #173 by not using firm superior email as display email

Instead, a valid firm superior email is used as `UserEmail` so that it can be used as a fallback address.

src/Handler/Utils/Avs.hs

@@ -51,6 +51,7 @@ import Jobs.Queue
 
 import Utils.Avs
 import Utils.Users
+import Utils.Mail (validEmail)
 import Handler.Utils.Users
 import Handler.Utils.Company
 import Handler.Utils.Qualification
@@ -365,11 +366,12 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
                       , CU_API_UserMatrikelnummer
                       -- , CU_API_UserCompanyPersonalNumber -- needs special treatment, see ldap_ups above
                       ]
-            eml_up =  mkUpdate  usr newAvsDataContact oldAvsDataContact $ mkCheckUpdate CU_ADC_UserDisplayEmail                            -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
+            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
             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 = eml_up `mcons` (frm_up `mcons` (pin_up `mcons` (ldap_ups <> per_ups)))
+            usr_up1 = catMaybes [eml_up1, eml_up2, frm_up, pin_up] <> ldap_ups <> per_ups
             avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
                       [ UserAvsLastSynch      =. now
                       , UserAvsLastSynchError =. Nothing
@@ -443,8 +445,9 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
                   -- newAPs <- count $ (UserSupervisorUser ==. usrId) : (UserSupervisorCompany ==. Just newCompanyId) : (UserSupervisorReason ~=. superReasonComDef)
                   -- when (oldAPs > 0 && newAPs <= 0) $ reportAdminProblem $ AdminProblemNewlyUnsupervised usrId oldCompanyId newCompanyId
                   -- return pst_up
-        update usrId $ usr_up2 <> usr_up1                                         -- update user eventually
+        update usrId usr_up2                                         -- update user by company switch first (due to possible conflicts with usr_up2)
-        update uaId    avs_ups                                                    -- update stored avsinfo for future updates
+        update usrId usr_up1                                         -- update user eventually
+        update uaId  avs_ups                                         -- update stored avsinfo for future updates
       return (apid, usrId)
 
 
@@ -528,13 +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
                 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            = "AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI
+                  , audEmail            = maybe ("AVSNO:" <> cpi ^. _avsInfoPersonNo . from _CI) stripCI superiorEmail
                   , audIdent            = "AVSID:" <> ciShow api
                   , audAuth             = maybe AuthKindNoLogin (const AuthKindLDAP) internalPersNo
                   , audMatriculation    = cpi ^. _avsInfoPersonNo     & Just

src/Handler/Utils/AvsUpdate.hs

@@ -87,6 +87,7 @@ instance MkCheckUpdate CU_AvsDataContcat_User where
 
 data CU_AvsFirmInfo_User
   = CU_AFI_UserPostAddress
+  | CU_AFI_UserEmail
   -- CU_AFI_UserDisplayEmail        -- use _avsContactPrimaryEmailAddress instead
   deriving (Show, Eq)
 
@@ -94,7 +95,8 @@ 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_UserDisplayEmail          = CheckUpdateOpt  UserDisplayEmail          $ _avsFirmPrimaryEmail . _Just . from _CI                                  -- Maybe im AvsInfo, aber nicht im User, daher Opt
+  mkCheckUpdate CU_AFI_UserEmail                 = CheckUpdateOpt  UserEmail                 $ _avsFirmEMailSuperior . _Just . from _CI   -- in rare cases, firm superior email is used as fallback here
+  -- mkCheckUpdate CU_AFI_UserDisplayEmail       = CheckUpdateOpt  UserDisplayEmail          $ _avsFirmPrimaryEmail  . _Just . from _CI   -- Maybe im AvsInfo, aber nicht im User, daher Opt
 
 
 -- NOTE: Ensure that the lenses between CU_UserAvs_User and CU_AvsPersonInfo_User/CU_AvsFirmInfo_User agree!

src/Handler/Utils/Company.hs

@@ -163,10 +163,14 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d
         usrPrefPost = userPrefersPostal usrRec
         usrPrefPostUp = toMaybe (Just usrPrefPost == (mbOldComp ^? _Just . _companyPrefersPostal))
                       (UserPrefersPostal  =. companyPrefersPostal newCompany)
-        usrEmail :: UserEmail       = userDisplayEmail usrRec
+        -- 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
-        usrEmailUp = toMaybe (usrPostEmailUpds && avsEmail == Just usrEmail) (UserDisplayEmail =. "")
+        usrDisplayEmailUp = toMaybe (usrPostEmailUpds && avsEmail == Just usrDisplayEmail) (UserDisplayEmail =. "") -- delete DisplayEmail, if equal to AVS Firm Email
-        usrUpdate = catMaybes [usrPostUp, usrPrefPostUp, usrEmailUp]
+        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]
                 --  [UserPostAddress =. Nothing, UserPrefersPostal =. companyPrefersPostal newCompany] -- unconditional
     -- update uid usrUpdate
     -- repsertSuperiorSupervisor is not called here, since the Superior is indepentent of the actual company association

src/Model/Types/Avs.hs

@@ -731,7 +731,7 @@ _avsContactPrimaryEmail = to mkEmail
             [ adc ^. _avsContactFirmInfo   . _avsFirmCommunication . _Just . _avsCommunicationEMail
             , adc ^. _avsContactFirmInfo   . _avsFirmEMail
             , adc ^. _avsContactPersonInfo . _avsInfoPersonEMail
-            , adc ^. _avsContactFirmInfo   . _avsFirmEMailSuperior   -- only set for Fraport departments, hence this is a non-personal department wide email suitable as company email      
+            -- , adc ^. _avsContactFirmInfo   . _avsFirmEMailSuperior   -- only set for Fraport departments, hence this is a non-personal department wide email suitable as company email. Superior email is used as systemEmail only.
             ]
       in pickValidEmail candidates -- should we return an invalid email rather than none?
 

src/Utils.hs

@@ -991,6 +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]
 fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a
 fromMaybeM act = maybeM act pure