From f123f40ad2c71801ef6be5f60f486508a958a955 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 16 May 2023 10:31:35 +0000 Subject: [PATCH] chore(avs): add avs synch background jobs towards #34 --- models/avs.model | 1 + src/Handler/Utils/Avs.hs | 20 ++++++++------ src/Jobs.hs | 1 + src/Jobs/Handler/SynchroniseAvs.hs | 44 ++++++++++++++++++++++++++++++ src/Jobs/Types.hs | 15 ++++++---- test/Database/Fill.hs | 14 +++++----- 6 files changed, 73 insertions(+), 22 deletions(-) create mode 100644 src/Jobs/Handler/SynchroniseAvs.hs diff --git a/models/avs.model b/models/avs.model index 4f495bd25..b9f77cdd7 100644 --- a/models/avs.model +++ b/models/avs.model @@ -17,6 +17,7 @@ UserAvs personId AvsPersonId -- unique identifier for user throughout avs; newtype for Int user UserId noPerson Int default=0 -- only needed for manual communication with personnel from Ausweisverwaltungsstelle + lastSynch UTCTime default=now() UniqueUserAvsUser user UniqueUserAvsId personId deriving Generic Show diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 3a6083fae..550f4edd6 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -409,6 +409,7 @@ upsertAvsUserByCard persNo = do upsertAvsUserById :: AvsPersonId -> Handler (Maybe UserId) upsertAvsUserById api = do mbapd <- lookupAvsUser api + now <- liftIO getCurrentTime mbuid <- runDB $ do mbuid <- getBy (UniqueUserAvsId api) case (mbuid, mbapd) of @@ -417,17 +418,20 @@ upsertAvsUserById api = do $logInfoS "AVS" $ "Creating new user with avsInternalPersonalNo " <> tshow persNo candidates <- selectKeysList [UserCompanyPersonalNumber ==. Just persNo] [] case candidates of - [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo) + [uid] -> $logInfoS "AVS" "Matching user found, linking." >> insertUniqueEntity (UserAvs api uid avsPersonPersonNo now) (_:_) -> throwM $ AvsUserAmbiguous api [] -> do upsRes :: Either SomeException (Entity User) <- try $ ldapLookupAndUpsert persNo $logInfoS "AVS" $ "No matching existing user found. Attempted LDAP upsert returned: " <> tshow upsRes case upsRes of - Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo -- pin/addr are updated in next step anyway + Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid avsPersonPersonNo now -- pin/addr are updated in next step anyway Left err -> do $logWarnS "AVS" $ "AVS user with avsInternalPersonalNo " <> tshow persNo <> " not found in LDAP: " <> tshow err return mbuid -- == Nothing -- user could not be created somehow + (Just Entity{ entityKey = uaid }, _) -> do + update uaid [ UserAvsLastSynch =. now ] -- mark as updated early, to prevent failed users to clog the synch + return mbuid _other -> return mbuid $logInfoS "AVS" $ "upsert prestep result: " <> tshow mbuid <> " --- " <> tshow mbapd case (mbuid, mbapd) of @@ -460,9 +464,8 @@ upsertAvsUserById api = do , audAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personnel number is known } mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe - whenIsJust mbUid $ \uid -> runDB $ do - now <- liftIO getCurrentTime - insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo + whenIsJust mbUid $ \uid -> runDB $ do + insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo now forM_ avsPersonPersonCards $ -- save all cards for later comparisons whether an update occurred -- let cs :: Set AvsDataPersonCard = Set.fromList $ catMaybes [pinCard, addrCard] -- forM_ cs $ -- only save used cards for the postal address update detection @@ -475,15 +478,14 @@ upsertAvsUserById api = do let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards userFirmAddr = plaintextToStoredMarkup <$> mbCoFirmAddr pinCard = Set.lookupMax avsPersonPersonCards - userPin = personCard2pin <$> pinCard - now <- liftIO getCurrentTime - runDB $ do + userPin = personCard2pin <$> pinCard + runDB $ do update uid [ UserFirstName =. avsFirstName -- update in case of name changes via AVS; might be changed again through LDAP , UserSurname =. avsSurname , UserDisplayName =. avsFirstName <> Text.cons ' ' avsSurname , UserMatrikelnummer =. Just (tshow avsPersonPersonNo) -- TODO: Deactivate this update after Q2/2023; this is only needed since UserMatrikelnummer was used for AVSNO later , UserCompanyPersonalNumber =. avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo - ] + ] oldCards <- selectList [UserAvsCardPersonId ==. api] [] let oldAddrs = Set.fromList $ mapMaybe (snd3 . getCompanyAddress . userAvsCardCard . entityVal) oldCards unless (maybe True (`Set.member` oldAddrs) mbCoFirmAddr) $ do -- update postal address, unless the exact address had been seen before diff --git a/src/Jobs.hs b/src/Jobs.hs index 7dcc4d81a..c658668dc 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -72,6 +72,7 @@ import Jobs.Handler.Invitation import Jobs.Handler.SendPasswordReset import Jobs.Handler.TransactionLog import Jobs.Handler.SynchroniseLdap +import Jobs.Handler.SynchroniseAvs import Jobs.Handler.PruneInvitations import Jobs.Handler.ChangeUserDisplayEmail import Jobs.Handler.Files diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs new file mode 100644 index 000000000..3d49b5ce6 --- /dev/null +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -0,0 +1,44 @@ +-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen , Steffen Jost +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +module Jobs.Handler.SynchroniseAvs + ( dispatchJobSynchroniseAvsId + , dispatchJobSynchroniseAvsUser + ) where + +import Import + +import Handler.Utils.Avs + + +{- TODO: general AVS synchronisation +dispatchJobSynchroniseLdap :: Natural -> Natural -> Natural -> JobHandler UniWorX +dispatchJobSynchroniseLdap numIterations epoch iteration + = JobHandlerAtomic . runConduit $ + readUsers .| filterIteration .| sinkDBJobs + where + readUsers :: ConduitT () UserId (YesodJobDB UniWorX) () + readUsers = selectKeys [] [] + + filterIteration :: ConduitT UserId Job (YesodJobDB UniWorX) () + filterIteration = C.mapMaybeM $ \userId -> runMaybeT $ do + let + userIteration, currentIteration :: Integer + userIteration = toInteger (hash epoch `hashWithSalt` userId) `mod` toInteger numIterations + currentIteration = toInteger iteration `mod` toInteger numIterations + $logDebugS "SynchroniseLdap" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|] + guard $ userIteration == currentIteration + + return $ JobSynchroniseLdapUser userId +-} + + +dispatchJobSynchroniseAvsId :: AvsPersonId -> JobHandler UniWorX +dispatchJobSynchroniseAvsId = JobHandlerException . void . upsertAvsUserById -- updates UserAvsLAstSynch + +dispatchJobSynchroniseAvsUser :: UserId -> JobHandler UniWorX +dispatchJobSynchroniseAvsUser jUser = JobHandlerException $ do + runDB (getBy $ UniqueUserAvsUser jUser) >>= \case + Nothing -> return () -- no attempt to associate an AVS user is done here + Just usrAvsEnt -> void $ upsertAvsUserById $ usrAvsEnt ^. _entityVal . _userAvsPersonId -- updates UserAvsLAstSynch diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 85fbaded8..77181b5a7 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -84,12 +84,13 @@ data Job | JobTruncateTransactionLog | JobPruneInvitations | JobDeleteTransactionLogIPs - | JobSynchroniseLdap { jNumIterations - , jEpoch - , jIteration :: Natural - } - | JobSynchroniseLdapUser { jUser :: UserId - } + | JobSynchroniseLdap { jNumIterations + , jEpoch + , jIteration :: Natural + } + | JobSynchroniseLdapUser { jUser :: UserId } + | JobSynchroniseAvsUser { jUser :: UserId } + | JobSynchroniseAvsId { jAvsId:: AvsPersonId } | JobChangeUserDisplayEmail { jUser :: UserId , jDisplayEmail :: UserEmail } @@ -326,6 +327,8 @@ jobNoQueueSame = \case JobPruneInvitations{} -> Just JobNoQueueSame JobDeleteTransactionLogIPs{} -> Just JobNoQueueSame JobSynchroniseLdapUser{} -> Just JobNoQueueSame + JobSynchroniseAvsUser{} -> Just JobNoQueueSame + JobSynchroniseAvsId{} -> Just JobNoQueueSame JobChangeUserDisplayEmail{} -> Just JobNoQueueSame JobPruneSessionFiles{} -> Just JobNoQueueSameTag JobPruneUnreferencedFiles{} -> Just JobNoQueueSameTag diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index c26576ef1..38f6331c2 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -568,7 +568,7 @@ fillDb = do matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int) manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel matUsers <- selectList [UserMatrikelnummer !=. Nothing] [] - insertMany_ [UserAvs (AvsPersonId n) uid n | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers] + insertMany_ [UserAvs (AvsPersonId n) uid n now | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers] let tmin = -1 tmax = 2 @@ -674,12 +674,12 @@ fillDb = do void . insert' $ UserSchool uid mi False for_ [jost] $ \uid -> void . insert' $ UserSchool uid avn False - void . insert' $ UserAvs (AvsPersonId 12345678) jost 87654321 - void . insert' $ UserAvs (AvsPersonId 2) svaupel 2 - void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 - void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 - void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 - void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 + void . insert' $ UserAvs (AvsPersonId 12345678) jost 87654321 (n_day' $ -12) + void . insert' $ UserAvs (AvsPersonId 2) svaupel 2 (n_day' $ -22) + void . insert' $ UserAvs (AvsPersonId 3) gkleen 3 (n_day' $ -32) + void . insert' $ UserAvs (AvsPersonId 4) sbarth 4 now + void . insert' $ UserAvs (AvsPersonId 5) fhamann 5 now + void . insert' $ UserAvs (AvsPersonId 77) tinaTester 77 now insert_ $ UserAvsCard (AvsPersonId 12345678) (AvsFullCardNo (AvsCardNo "1234") "4") (AvsDataPersonCard True Nothing Nothing AvsCardColorGelb (Set.fromList ['F']) Nothing Nothing Nothing Nothing (AvsCardNo "1234") "4") now insert_ $ UserAvsCard (AvsPersonId 2) (AvsFullCardNo (AvsCardNo "3344") "1") (AvsDataPersonCard True Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "3344") "1") now insert_ $ UserAvsCard (AvsPersonId 3) (AvsFullCardNo (AvsCardNo "7788") "1") (AvsDataPersonCard False Nothing Nothing AvsCardColorRot (Set.fromList ['F','R']) Nothing Nothing Nothing Nothing (AvsCardNo "7788") "1") now