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

chore(avs): add avs synch background jobs towards #34

Browse Source
This commit is contained in:
Steffen Jost 2023-05-16 10:31:35 +00:00
parent 73fa46e583
commit f123f40ad2
6 changed files with 73 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
models/avs.model
View File

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

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

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

1
src/Jobs.hs
View File

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

44
src/Jobs/Handler/SynchroniseAvs.hs Normal file
View File

@ -0,0 +1,44 @@
-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
--
-- 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

15
src/Jobs/Types.hs
View File

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

14
test/Database/Fill.hs
View File

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