fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

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

Browse Source 
Instead, a valid firm superior email is used as `UserEmail` so that it can be used as a fallback address.
This commit is contained in:
Steffen Jost 2024-07-31 14:16:40 +02:00
parent b9f70c7796
commit 43f5c5f485
5 changed files with 40 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Handler/Utils/Avs.hs
View File

@ -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 uaId avs_ups -- update stored avsinfo for future updates
update usrId usr_up2 -- update user by company switch first (due to possible conflicts with usr_up2)
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

4
src/Handler/Utils/AvsUpdate.hs
View File

@ -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!

10
src/Handler/Utils/Company.hs
View File

@ -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 =. "")
usrUpdate = catMaybes [usrPostUp, usrPrefPostUp, usrEmailUp]
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]
-- [UserPostAddress =. Nothing, UserPrefersPostal =. companyPrefersPostal newCompany] -- unconditional
-- update uid usrUpdate
-- repsertSuperiorSupervisor is not called here, since the Superior is indepentent of the actual company association

40
src/Model/Types/Avs.hs
View File

@ -216,7 +216,7 @@ instance PersistFieldSql AvsFullCardNo where
parseAvsCardNo :: Text -> Maybe (Either AvsCardNo AvsFullCardNo)
parseAvsCardNo = splitDigitsByDot AvsCardNo (AvsFullCardNo . AvsCardNo)
discernAvsCardPersonalNo :: Text -> Maybe (Either AvsInternalPersonalNo AvsFullCardNo)
discernAvsCardPersonalNo :: Text -> Maybe (Either AvsInternalPersonalNo AvsFullCardNo)
discernAvsCardPersonalNo = splitDigitsByDot mkAvsInternalPersonalNo (AvsFullCardNo . AvsCardNo)
-- | Just implies that argument is a whole number or decimal with one single digit after the point. Helper functions receive digit-parts without dot
@ -227,7 +227,7 @@ splitDigitsByDot fl fr (Text.span Char.isDigit -> (c, pv))
= Just $ Left $ fl c
| Just ('.', v) <- Text.uncons pv
, Just (Char.isDigit -> True, "") <- Text.uncons v
= Just $ Right $ fr c v
= Just $ Right $ fr c v
splitDigitsByDot _ _ _ = Nothing
-- The AVS API requires PersonIds sometimes as as mere numbers `AvsPersonId` and sometimes as tagged objects `AvsObjPersonId`
@ -453,7 +453,7 @@ deriveJSON defaultOptions
} ''AvsStatusPerson
makeLenses_ ''AvsStatusPerson
data AvsDataPerson = AvsDataPerson
{ avsPersonFirstName :: Text -- WARNING: name stored as is, but AVS does contain weird whitespaces
@ -551,7 +551,7 @@ _avsInfoDisplayName :: Lens' AvsPersonInfo Text
_avsInfoDisplayName = lens g s
where
g AvsPersonInfo{avsInfoFirstName, avsInfoLastName} = Text.append avsInfoFirstName $ Text.cons ' ' avsInfoLastName
s api dn = let (Text.strip -> fn, Text.strip -> ln) = Text.breakOnEnd " " dn
s api dn = let (Text.strip -> fn, Text.strip -> ln) = Text.breakOnEnd " " dn
in api{avsInfoFirstName = fn, avsInfoLastName = ln}
@ -603,7 +603,7 @@ instance {-# OVERLAPS #-} Canonical (Maybe AvsFirmCommunication) where
makeLenses_ ''AvsFirmCommunication
_avsCommunicationAddress :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmCommunication (Maybe Text)
_avsCommunicationAddress = to mkAddr
where
where
mkAddr AvsFirmCommunication{..} = composeAddress avsCommunicationStreetANDHouseNo avsCommunicationZIPCode avsCommunicationCity avsCommunicationCountry
instance FromJSON AvsFirmCommunication where
@ -645,7 +645,7 @@ _avsFirmPostAddress :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmInfo
_avsFirmPostAddress = to mkPost
where
mkPost afi@AvsFirmInfo{avsFirmFirm} =
let someAddr = afi ^. _avsFirmPostAddressSimple
let someAddr = afi ^. _avsFirmPostAddressSimple
prefAddr = plaintextToStoredMarkup . (avsFirmFirm <>) . Text.cons '\n'
in prefAddr <$> someAddr
@ -657,27 +657,27 @@ _avsFirmPostAddressSimple = to mkPost
mkPost AvsFirmInfo{..} =
let firmAddr = composeAddress avsFirmStreetANDHouseNo avsFirmZIPCode avsFirmCity avsFirmCountry
commAddr = avsFirmCommunication ^. _Just . _avsCommunicationAddress
in asum $ [res | res@(Just addr) <- [commAddr, firmAddr], validPostAddressText addr]
in asum $ [res | res@(Just addr) <- [commAddr, firmAddr], validPostAddressText addr]
_avsFirmPrimaryEmail :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmInfo (Maybe Text)
_avsFirmPrimaryEmail = to mkEmail
where
mkEmail afi =
let candidates = catMaybes
let candidates = catMaybes
[ afi ^. _avsFirmCommunication . _Just . _avsCommunicationEMail
, afi ^. _avsFirmEMail
, afi ^. _avsFirmEMailSuperior -- only set for Fraport departments, hence this is a non-personal department wide email suitable as company email
, afi ^. _avsFirmEMailSuperior -- only set for Fraport departments, hence this is a non-personal department wide email suitable as company email
]
in pickValidEmail candidates -- should we return an invalid email rather than none?
-- | Not sure this is useful, since postal is ignored if there is no post address anyway
_avsFirmPrefersPostal :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmInfo Bool
_avsFirmPrefersPostal = to mkPostPref
where
where
mkPostPref afi = isJust (afi ^. _avsFirmPostAddress) || isNothing (afi ^. _avsFirmPrimaryEmail)
-- Note _avsFirmAddress is never empty; always includes the company name; consider using user _avsFirmPostAddress instead
-- _avsFirmAddress :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmInfo Text
-- _avsFirmAddress :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmInfo Text
-- _avsFirmAddress = to mkAddr
-- where
-- mkAddr AvsFirmInfo{..} =
@ -726,12 +726,12 @@ makeLenses_ ''AvsDataContact
_avsContactPrimaryEmail :: (Profunctor p, Contravariant f) => Optic' p f AvsDataContact (Maybe Text)
_avsContactPrimaryEmail = to mkEmail
where
mkEmail adc =
mkEmail adc =
let candidates = catMaybes
[ 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?
@ -848,15 +848,15 @@ fixAvsQueryPerson AvsQueryPerson{avsPersonQueryVersionNo=Nothing, avsPersonQuery
= AvsQueryPerson
{ avsPersonQueryCardNo = Just acn1
, avsPersonQueryVersionNo = Just avc1
, avsPersonQueryFirstName = canonical avsPersonQueryFirstName
, avsPersonQueryLastName = canonical avsPersonQueryLastName
, avsPersonQueryFirstName = canonical avsPersonQueryFirstName
, avsPersonQueryLastName = canonical avsPersonQueryLastName
, avsPersonQueryInternalPersonalNo = canonical avsPersonQueryInternalPersonalNo
}
fixAvsQueryPerson AvsQueryPerson{..} = AvsQueryPerson
{ avsPersonQueryCardNo = canonical avsPersonQueryCardNo
, avsPersonQueryVersionNo = canonical avsPersonQueryVersionNo
, avsPersonQueryFirstName = canonical avsPersonQueryFirstName
, avsPersonQueryLastName = canonical avsPersonQueryLastName
{ avsPersonQueryCardNo = canonical avsPersonQueryCardNo
, avsPersonQueryVersionNo = canonical avsPersonQueryVersionNo
, avsPersonQueryFirstName = canonical avsPersonQueryFirstName
, avsPersonQueryLastName = canonical avsPersonQueryLastName
, avsPersonQueryInternalPersonalNo = canonical avsPersonQueryInternalPersonalNo
}
@ -878,7 +878,7 @@ deriveJSON defaultOptions ''AvsQueryGetLicences
data AvsQueryGetAllLicences = AvsQueryGetAllLicences -- for convenience, encoding AvsQueryGetLicences (AvsObjPersonId avsPersonIdZero)
deriving (Eq, Ord, Show, Generic)
newtype AvsQuerySetLicences = AvsQuerySetLicences (Set AvsPersonLicence)
deriving (Eq, Ord, Show, Generic)
deriveJSON defaultOptions ''AvsQuerySetLicences

1
src/Utils.hs
View File

@ -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