fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(avs): priority for picking primary email demote superior

Browse Source
This commit is contained in:
Steffen Jost 2024-06-25 15:54:55 +02:00
parent f8c36636ff
commit e4fa1ddd68
4 changed files with 50 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Handler/Users.hs
View File

@ -494,7 +494,7 @@ nullaryPathPiece ''UserAssimilateButton $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''UserAssimilateButton id
data ThisUserAction = ThisUserLdapSync | ThisUserAvsSync
data ThisUserAction = ThisUserLdapSync | ThisUserAvsSync -- ThisUserHijack would make sense, but this 'btn' should not always be visible
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
deriving anyclass (Universe, Finite)
@ -521,6 +521,8 @@ postAdminUserR uuid = do
n <- runDB $ queueAvsUpdateByUID (Set.singleton uid) Nothing
addMessageI Success $ MsgSynchroniseAvsUserQueued $ fromIntegral n
redirectKeepGetParams $ AdminUserR uuid
-- ThisUserHijack -> do
-- redirect $ AdminHijackUserR uuid
let thisUserActWgt = wrapForm thisUserActWgt' def
{ formSubmit = FormNoSubmit
, formAction = Just $ SomeRoute $ AdminUserR uuid

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

@ -323,14 +323,17 @@ updateAvsUserByIds' apids = do
updateAvsUserByADC :: AvsDataContact -> DB (Maybe (AvsPersonId, UserId))
updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMaybeT $ do
updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMaybeT $ do
(Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
let usrId = userAvsUser usravs
usr <- MaybeT $ get usrId
lift $ do -- maybeT no longer needed from here onwards
let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- Nothing is ok here
oldAvsFirmInfo = userAvsLastFirmInfo usravs -- Nothing is ok here
oldAvsCardNo = userAvsLastCardNo usravs & fmap Just
let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- Nothing is ok here
oldAvsFirmInfo = userAvsLastFirmInfo usravs -- Nothing is ok here
oldAvsCardNo = userAvsLastCardNo usravs & fmap Just
oldAvsDataContact = case (oldAvsPersonInfo, oldAvsFirmInfo) of
(Just oapi, Just oafi) -> Just $ AvsDataContact apid oapi oafi
_ -> Nothing
newAvsCardNo <- queryAvsFullCardNo apid -- Nothing os ok here, does not throw
now <- liftIO getCurrentTime
mbLdapExpire <- getsYesod $ views appSettings appSynchroniseLdapUsersExpire
@ -362,9 +365,7 @@ updateAvsUserByADC (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = runMa
, CU_API_UserMatrikelnummer
-- , CU_API_UserCompanyPersonalNumber -- needs special treatment, see ldap_ups above
]
eml_up = let em_p_up = mkUpdate usr newAvsPersonInfo oldAvsPersonInfo $ mkCheckUpdate CU_API_UserDisplayEmail
em_f_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ mkCheckUpdate CU_AFI_UserDisplayEmail
in em_f_up <|> em_p_up -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
eml_up = mkUpdate usr newAvsDataContact oldAvsDataContact $ mkCheckUpdate CU_ADC_UserDisplayEmail -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
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

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

@ -58,7 +58,7 @@ data CU_AvsPersonInfo_User
| CU_API_UserMatrikelnummer
| CU_API_UserCompanyPersonalNumber
| CU_API_UserLdapPrimaryKey
| CU_API_UserDisplayEmail
-- | CU_API_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead
deriving (Show, Eq)
instance MkCheckUpdate CU_AvsPersonInfo_User where
@ -72,25 +72,35 @@ instance MkCheckUpdate CU_AvsPersonInfo_User where
mkCheckUpdate CU_API_UserMatrikelnummer = CheckUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
mkCheckUpdate CU_API_UserCompanyPersonalNumber = CheckUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
mkCheckUpdate CU_API_UserLdapPrimaryKey = CheckUpdate UserLdapPrimaryKey $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
mkCheckUpdate CU_API_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _avsInfoPersonEMail . _Just . from _CI -- Maybe im AvsInfo, aber nicht im User, daher Opt
-- mkCheckUpdate CU_API_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _avsInfoPersonEMail . _Just . from _CI -- Maybe im AvsInfo, aber nicht im User, daher Opt
data CU_AvsDataContcat_User
= CU_ADC_UserPostAddress
| CU_ADC_UserDisplayEmail
deriving (Show, Eq)
instance MkCheckUpdate CU_AvsDataContcat_User where
type MCU_Rec CU_AvsDataContcat_User = User
type MCU_Raw CU_AvsDataContcat_User = AvsDataContact
mkCheckUpdate CU_ADC_UserPostAddress = CheckUpdate UserPostAddress _avsContactPrimaryPostAddress
mkCheckUpdate CU_ADC_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _avsContactPrimaryEmail . _Just . from _CI
data CU_AvsFirmInfo_User
= CU_AFI_UserPostAddress
| CU_AFI_UserDisplayEmail
-- | CU_AFI_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead
deriving (Show, Eq)
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_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!
data CU_UserAvs_User
= CU_UA_UserPinPassword
| CU_UA_UserPostAddress
-- | CU_UA_UserPostAddress -- use _avsContactPrimaryPostAddress instead
| CU_UA_UserFirstName
| CU_UA_UserSurname
| CU_UA_UserDisplayName
@ -99,14 +109,14 @@ data CU_UserAvs_User
| CU_UA_UserMatrikelnummer
| CU_UA_UserCompanyPersonalNumber
| CU_UA_UserLdapPrimaryKey
| CU_UA_UserDisplayEmail
-- | CU_UA_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead
deriving (Show, Eq)
instance MkCheckUpdate CU_UserAvs_User where
type MCU_Rec CU_UserAvs_User = User
type MCU_Raw CU_UserAvs_User = UserAvs
mkCheckUpdate CU_UA_UserPinPassword = CheckUpdateOpt UserPinPassword $ _userAvsLastCardNo . _Just . to avsFullCardNo2pin . re _Just
mkCheckUpdate CU_UA_UserPostAddress = CheckUpdateOpt UserPostAddress $ _userAvsLastFirmInfo . _Just . _avsFirmPostAddress
-- mkCheckUpdate CU_UA_UserPostAddress = CheckUpdateOpt UserPostAddress $ _userAvsLastFirmInfo . _Just . _avsFirmPostAddress
mkCheckUpdate CU_UA_UserFirstName = CheckUpdateOpt UserFirstName $ _userAvsLastPersonInfo . _Just . _avsInfoFirstName
mkCheckUpdate CU_UA_UserSurname = CheckUpdateOpt UserSurname $ _userAvsLastPersonInfo . _Just . _avsInfoLastName
mkCheckUpdate CU_UA_UserDisplayName = CheckUpdateOpt UserDisplayName $ _userAvsLastPersonInfo . _Just . _avsInfoDisplayName
@ -115,4 +125,4 @@ instance MkCheckUpdate CU_UserAvs_User where
mkCheckUpdate CU_UA_UserMatrikelnummer = CheckUpdateOpt UserMatrikelnummer $ _userAvsLastPersonInfo . _Just . _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just
mkCheckUpdate CU_UA_UserCompanyPersonalNumber = CheckUpdateOpt UserCompanyPersonalNumber $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo; needs special treatment, see ldap_ups abov
mkCheckUpdate CU_UA_UserLdapPrimaryKey = CheckUpdateOpt UserLdapPrimaryKey $ _userAvsLastPersonInfo . _Just . _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just
mkCheckUpdate CU_UA_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _userAvsLastPersonInfo . _Just . _avsInfoPersonEMail . _Just . from _CI
-- mkCheckUpdate CU_UA_UserDisplayEmail = CheckUpdateOpt UserDisplayEmail $ _userAvsLastPersonInfo . _Just . _avsInfoPersonEMail . _Just . from _CI

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

@ -641,6 +641,7 @@ makeLenses_ ''AvsFirmInfo
-- additional convenience lenses:
_avsFirmPostAddress :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmInfo (Maybe StoredMarkup)
-- _avsFirmPostAddress :: Getter AvsFirmInfo (Maybe StoredMarkup)
_avsFirmPostAddress = to mkPost
where
mkPost afi@AvsFirmInfo{avsFirmFirm} =
@ -650,6 +651,7 @@ _avsFirmPostAddress = to mkPost
-- | company post address without company name, better suited for comparisons
_avsFirmPostAddressSimple :: (Profunctor p, Contravariant f) => Optic' p f AvsFirmInfo (Maybe Text)
-- _avsFirmPostAddressSimple :: Getter AvsFirmInfo (Maybe Text)
_avsFirmPostAddressSimple = to mkPost
where
mkPost AvsFirmInfo{..} =
@ -663,8 +665,8 @@ _avsFirmPrimaryEmail = to mkEmail
mkEmail afi =
let candidates = catMaybes
[ afi ^. _avsFirmCommunication . _Just . _avsCommunicationEMail
, afi ^. _avsFirmEMailSuperior -- only set for Fraport departments, hence this is a non-personal department wide email suitable as company email
, afi ^. _avsFirmEMail
, 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?
@ -721,6 +723,24 @@ data AvsDataContact = AvsDataContact
makeLenses_ ''AvsDataContact
_avsContactPrimaryEmail :: (Profunctor p, Contravariant f) => Optic' p f AvsDataContact (Maybe Text)
_avsContactPrimaryEmail = to mkEmail
where
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
]
in pickValidEmail candidates -- should we return an invalid email rather than none?
-- _avsContactPrimaryPostAddress :: (Profunctor p, Contravariant f) => Optic' p f AvsDataContact (Maybe StoredMarkup)
-- _avsContactPrimaryPostAddress :: (Functor f, Contravariant f) => (Maybe StoredMarkup -> f (Maybe StoredMarkup)) -> AvsDataContact -> f AvsDataContact
_avsContactPrimaryPostAddress :: Getter AvsDataContact (Maybe StoredMarkup)
_avsContactPrimaryPostAddress = _avsContactFirmInfo . _avsFirmPostAddress
-- instance Canonical AvsDataContact where
-- canonical = over _avsContactPersonInfo canonical
-- . over _avsContactFirmInfo canonical