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.

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_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
+            -- 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

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
 
 

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
+        usrUpdate = catMaybes [usrPostUp, usrPrefPostUp, usrDisplayEmailUp]
-        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/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