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

refactor(avs): safe old card-no to perform pdf pin pass updates

Browse Source
This commit is contained in:
Steffen Jost 2024-04-16 12:56:03 +02:00
parent 3b7762f451
commit a373abad26
4 changed files with 54 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
models/avs.model
View File

@ -21,6 +21,7 @@ UserAvs
lastSynchError Text Maybe lastSynchError Text Maybe
lastPersonInfo AvsPersonInfo Maybe -- just to discern field changes lastPersonInfo AvsPersonInfo Maybe -- just to discern field changes
lastFirmInfo AvsFirmInfo Maybe -- just to discern field changes lastFirmInfo AvsFirmInfo Maybe -- just to discern field changes
lastCardNo AvsFullCardNo Maybe -- just to discern changes
UniqueUserAvsUser user UniqueUserAvsUser user
UniqueUserAvsId personId UniqueUserAvsId personId
deriving Generic Show deriving Generic Show

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

@ -201,14 +201,14 @@ upsertAvsUserById api = do
$logInfoS "AVS" $ "Creating new user with avsInternalPersonalNo " <> tshow persNo $logInfoS "AVS" $ "Creating new user with avsInternalPersonalNo " <> tshow persNo
candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] [] candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] []
case candidates of case candidates of
[uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo now Nothing Nothing Nothing) -- TODO info [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo now Nothing Nothing Nothing Nothing) -- TODO info
(_:_) -> throwM $ AvsUserAmbiguous api (_:_) -> throwM $ AvsUserAmbiguous api
[] -> do [] -> do
upsRes :: Either SomeException (Entity User) upsRes :: Either SomeException (Entity User)
<- try $ ldapLookupAndUpsert persNo <- try $ ldapLookupAndUpsert persNo
$logInfoS "AVS" $ "No matching existing user found. Attempted LDAP upsert returned: " <> tshow upsRes $logInfoS "AVS" $ "No matching existing user found. Attempted LDAP upsert returned: " <> tshow upsRes
case upsRes of case upsRes of
Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo now Nothing Nothing Nothing -- pin/addr are updated in next step anyway -- TODO info Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo now Nothing Nothing Nothing Nothing -- pin/addr are updated in next step anyway -- TODO info
Left err -> do Left err -> do
$logWarnS "AVS" $ "AVS user with avsInternalPersonalNo " <> tshow persNo <> " not found in LDAP: " <> tshow err $logWarnS "AVS" $ "AVS user with avsInternalPersonalNo " <> tshow persNo <> " not found in LDAP: " <> tshow err
return mbuid -- == Nothing -- user could not be created somehow return mbuid -- == Nothing -- user could not be created somehow
@ -248,7 +248,7 @@ upsertAvsUserById api = do
} }
mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe
whenIsJust mbUid $ \uid -> runDB $ do whenIsJust mbUid $ \uid -> runDB $ do
insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo now Nothing Nothing Nothing -- TODO info insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo now Nothing Nothing Nothing Nothing -- TODO info
forM_ avsPersonPersonCards $ -- save all cards for later comparisons whether an update occurred forM_ avsPersonPersonCards $ -- save all cards for later comparisons whether an update occurred
-- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard] -- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard]
-- forM_ cs $ -- only save used cards for the postal address update detection -- forM_ cs $ -- only save used cards for the postal address update detection
@ -435,6 +435,9 @@ queryAvsPrimaryCard api = runMaybeT $ do
pstatus <- hoistMaybe $ Set.lookupMax $ Set.filter ((api ==) . avsStatusPersonID) res pstatus <- hoistMaybe $ Set.lookupMax $ Set.filter ((api ==) . avsStatusPersonID) res
hoistMaybe $ Set.lookupMax $ avsStatusPersonCardStatus pstatus hoistMaybe $ Set.lookupMax $ avsStatusPersonCardStatus pstatus
queryAvsFullCardNo :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m) => AvsPersonId -> m (Maybe AvsFullCardNo)
queryAvsFullCardNo = fmap (fmap getFullCardNo) . queryAvsPrimaryCard
-- | Queries AVS to retrieve pin generated from primary card no -- | Queries AVS to retrieve pin generated from primary card no
queryAvsPin :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m) => AvsPersonId -> m (Maybe Text) queryAvsPin :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m) => AvsPersonId -> m (Maybe Text)
queryAvsPin = fmap (fmap personCard2pin) . queryAvsPrimaryCard queryAvsPin = fmap (fmap personCard2pin) . queryAvsPrimaryCard
@ -530,35 +533,40 @@ updateAvsUserByIds apids0 = do
where where
procResp (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = fmap maybeMonoid . runMaybeT $ do procResp (AvsDataContact apid newAvsPersonInfo newAvsFirmInfo) = fmap maybeMonoid . runMaybeT $ do
(Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid (Entity uaId usravs) <- MaybeT $ getBy $ UniqueUserAvsId apid
let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- We must not abort entire synch when receiving `Nothing` here, hence no hoistMaybe here
let oldAvsFirmInfo = userAvsLastFirmInfo usravs -- We must not abort entire synch when receiving `Nothing` here, hence no hoistMaybe here
let usrId = userAvsUser usravs let usrId = userAvsUser usravs
usr <- MaybeT $ get usrId usr <- MaybeT $ get usrId
now <- liftIO getCurrentTime
let per_ups = mapMaybe (mkUpdate usr newAvsPersonInfo oldAvsPersonInfo) -- NOTE: Updates erfolgen nur, wenn der Alt-Wert identisch zu Aktuellem-Wert sind! Bei mehreren Update-Möglichkeiten für ein Feld kann nur eines zutreffen.
[ CheckAvsUpdate UserFirstName _avsInfoFirstName
, CheckAvsUpdate UserSurname _avsInfoLastName
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName
, CheckAvsUpdate UserBirthday _avsInfoDateOfBirth
, CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
, CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
]
em_p_up = mkUpdate usr newAvsPersonInfo oldAvsPersonInfo $
CheckAvsUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe im AvsInfo, aber nicht im User
em_f_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
CheckAvsUpdate UserDisplayEmail $ _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
eml_up = em_p_up <|> em_f_up -- ensure that only one email update is produced; there is no Eq instance for the Update type
frm_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
CheckAvsUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
usr_up1 = eml_up `mcons` (frm_up `mcons` per_ups)
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
[ UserAvsLastSynch =. now
, UserAvsLastSynchError =. Nothing
, UserAvsLastPersonInfo =. Just newAvsPersonInfo
, UserAvsLastFirmInfo =. Just newAvsFirmInfo
]
lift $ do -- maybeT no longer needed from here onwards lift $ do -- maybeT no longer needed from here onwards
newAvsCardNo <- queryAvsFullCardNo apid -- We must not abort entire synch when receiving `Nothing` here, hence no MaybeT here
now <- liftIO getCurrentTime
let oldAvsPersonInfo = userAvsLastPersonInfo usravs -- We must not abort entire synch when receiving `Nothing` here, hence no hoistMaybe here
oldAvsFirmInfo = userAvsLastFirmInfo usravs -- We must not abort entire synch when receiving `Nothing` here, hence no hoistMaybe here
oldAvsCardNo = userAvsLastCardNo usravs -- We must not abort entire synch when receiving `Nothing` here, hence no hoistMaybe here
per_ups = mapMaybe (mkUpdate usr newAvsPersonInfo oldAvsPersonInfo) -- NOTE: Updates erfolgen nur, wenn der Alt-Wert identisch zu Aktuellem-Wert sind! Bei mehreren Update-Möglichkeiten für ein Feld kann nur eines zutreffen.
[ CheckAvsUpdate UserFirstName _avsInfoFirstName
, CheckAvsUpdate UserSurname _avsInfoLastName
, CheckAvsUpdate UserDisplayName _avsInfoDisplayName
, CheckAvsUpdate UserBirthday _avsInfoDateOfBirth
, CheckAvsUpdate UserMobile _avsInfoPersonMobilePhoneNo
, CheckAvsUpdate UserMatrikelnummer $ _avsInfoPersonNo . re _Just -- Maybe im User, aber nicht im AvsInfo; also: `re _Just` work like `to Just`
, CheckAvsUpdate UserCompanyPersonalNumber $ _avsInfoInternalPersonalNo . _Just . _avsInternalPersonalNo . re _Just -- Maybe im User und im AvsInfo
]
em_p_up = mkUpdate usr newAvsPersonInfo oldAvsPersonInfo $
CheckAvsUpdate UserDisplayEmail $ _avsInfoPersonEMail . to (fromMaybe mempty) . from _CI -- Maybe im AvsInfo, aber nicht im User
em_f_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ -- Email updates erfolgen nur, wenn identisch. Für Firmen-Email leer lassen.
CheckAvsUpdate UserDisplayEmail $ _avsFirmPrimaryEmail . to (fromMaybe mempty) . from _CI
eml_up = em_p_up <|> em_f_up -- ensure that only one email update is produced; there is no Eq instance for the Update type
frm_up = mkUpdate usr newAvsFirmInfo oldAvsFirmInfo $ -- Legacy, if company postal is stored in user; should no longer be true for new users,
CheckAvsUpdate UserPostAddress _avsFirmPostAddress -- since company address should now be referenced with UserCompany instead
pin_up = mkUpdate usr newAvsCardNo (Just oldAvsCardNo) $ -- Maybe update PDF pin to latest card
CheckAvsUpdate UserPinPassword $ to $ fmap avsFullCardNo2pin -- _Just . to avsFullCardNo2pin . re _Just
usr_up1 = eml_up `mcons` (frm_up `mcons` (pin_up `mcons` per_ups))
avs_ups = ((UserAvsNoPerson =.) <$> readMay (avsInfoPersonNo newAvsPersonInfo)) `mcons`
[ UserAvsLastSynch =. now
, UserAvsLastSynchError =. Nothing
, UserAvsLastPersonInfo =. Just newAvsPersonInfo
, UserAvsLastFirmInfo =. Just newAvsFirmInfo
, UserAvsLastCardNo =. newAvsCardNo
]
-- update company association & supervision -- update company association & supervision
Entity{entityKey=newCompanyId, entityVal=newCompany} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo Entity{entityKey=newCompanyId, entityVal=newCompany} <- upsertAvsCompany newAvsFirmInfo oldAvsFirmInfo
oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo oldCompanyEnt <- getAvsCompany `traverseJoin` oldAvsFirmInfo

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

@ -413,12 +413,16 @@ derivePersistFieldJSON ''AvsDataPersonCard
getFullCardNo :: AvsDataPersonCard -> AvsFullCardNo getFullCardNo :: AvsDataPersonCard -> AvsFullCardNo
getFullCardNo AvsDataPersonCard{avsDataCardNo, avsDataVersionNo} = AvsFullCardNo avsDataCardNo avsDataVersionNo getFullCardNo AvsDataPersonCard{avsDataCardNo, avsDataVersionNo} = AvsFullCardNo avsDataCardNo avsDataVersionNo
avsFullCardNo2pin :: AvsFullCardNo -> Text
avsFullCardNo2pin = Text.dropWhile ('0'==) . tshowAvsFullCardNo
-- | like `tshowAvsFullCardNo` but without leading zeroes for use as pdf pin -- | like `tshowAvsFullCardNo` but without leading zeroes for use as pdf pin
personCard2pin :: AvsDataPersonCard -> Text personCard2pin :: AvsDataPersonCard -> Text
personCard2pin = Text.dropWhile ('0'==) . tshowAvsFullCardNo . getFullCardNo personCard2pin = avsFullCardNo2pin . getFullCardNo
personCards2pin :: Set AvsDataPersonCard -> Maybe Text -- DEPRECATED, use Handler.Utils.Avs.queryAvsPin instead
personCards2pin = fmap personCard2pin . Set.lookupMax -- personCards2pin :: Set AvsDataPersonCard -> Maybe Text
-- personCards2pin = fmap personCard2pin . Set.lookupMax
data AvsStatusPerson = AvsStatusPerson data AvsStatusPerson = AvsStatusPerson
{ avsStatusPersonID :: AvsPersonId { avsStatusPersonID :: AvsPersonId

14
test/Database/Fill.hs
View File

@ -595,7 +595,7 @@ fillDb = do
let matrikel = tshow <$> [baseMatrikel..] List.\\ [6969, 669966, 996699] let matrikel = tshow <$> [baseMatrikel..] List.\\ [6969, 669966, 996699]
manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
matUsers <- selectList [UserMatrikelnummer !=. Nothing] [] matUsers <- selectList [UserMatrikelnummer !=. Nothing] []
insertMany_ [UserAvs (AvsPersonId n) uid n now Nothing Nothing Nothing | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers] insertMany_ [UserAvs (AvsPersonId n) uid n now Nothing Nothing Nothing Nothing | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers]
let tmin = -1 let tmin = -1
tmax = 2 tmax = 2
@ -723,12 +723,12 @@ fillDb = do
void . insert' $ UserSchool uid mi False void . insert' $ UserSchool uid mi False
for_ [jost] $ \uid -> for_ [jost] $ \uid ->
void . insert' $ UserSchool uid avn False void . insert' $ UserSchool uid avn False
void . insert' $ UserAvs (AvsPersonId 12345678) jost 87654321 (n_day' $ -12) (Just "Some Message here") Nothing Nothing void . insert' $ UserAvs (AvsPersonId 12345678) jost 87654321 (n_day' $ -12) (Just "Some Message here") Nothing Nothing Nothing
void . insert' $ UserAvs (AvsPersonId 2) svaupel 2 (n_day' $ -22) Nothing Nothing Nothing void . insert' $ UserAvs (AvsPersonId 2) svaupel 2 (n_day' $ -22) Nothing Nothing Nothing Nothing
void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 (n_day' $ -32) Nothing Nothing Nothing void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 (n_day' $ -32) Nothing Nothing Nothing Nothing
void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 now Nothing Nothing Nothing void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 now Nothing Nothing Nothing Nothing
void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 now (Just "another message from avs synch") Nothing Nothing void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 now (Just "another message from avs synch") Nothing Nothing Nothing
void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 now Nothing Nothing Nothing void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 now Nothing Nothing Nothing Nothing
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|] let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]