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

Merge branch 'fradrive/avs-synch' into fradrive/tutorial-overhaul

Browse Source
This commit is contained in:
Steffen Jost 2023-05-22 16:46:31 +00:00
commit 7aa9d964af
10 changed files with 68 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
config/settings.yml
View File

@ -81,8 +81,11 @@ health-check-ldap-admins-timeout: "_env:HEALTHCHECK_LDAP_ADMINS_TIMEOUT:60"
health-check-http-reachable-timeout: "_env:HEALTHCHECK_HTTP_REACHABLE_TIMEOUT:2"
health-check-matching-cluster-config-timeout: "_env:HEALTHCHECK_MATCHING_CLUSTER_CONFIG_TIMEOUT:2"
synchronise-ldap-users-within: "_env:SYNCHRONISE_LDAP_WITHIN:1209600"
synchronise-ldap-users-interval: "_env:SYNCHRONISE_LDAP_INTERVAL:3600"
synchronise-ldap-users-within: "_env:SYNCHRONISE_LDAP_WITHIN:1209600" # 14 Tage in Sekunden
synchronise-ldap-users-interval: "_env:SYNCHRONISE_LDAP_INTERVAL:3600" # jede Stunde
synchronise-avs-users-within: "_env:SYNCHRONISE_AVS_WITHIN:5702400" # alle 66 Tage
synchronise-avs-users-interval: "_env:SYNCHRONISE_AVS_INTERVAL:21600" # alle 6 Stunden
study-features-recache-relevance-within: 172800
study-features-recache-relevance-interval: 293

3
src/Handler/Admin.hs
View File

@ -56,7 +56,8 @@ getAdminProblemsR = do
(Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
(Right AvsLicenceDifferences{..}) -> do
let problemIds = avsLicenceDiffRevokeAll <> avsLicenceDiffGrantVorfeld <> avsLicenceDiffRevokeRollfeld <> avsLicenceDiffGrantRollfeld
mapM_ (queueJob' . flip JobSynchroniseAvsId cutOffAvsSynch) problemIds
-- mapM_ (queueJob' . flip JobSynchroniseAvsId cutOffAvsSynch) problemIds
runDBJobs . forM_ problemIds $ queueDBJob . flip JobSynchroniseAvsId cutOffAvsSynch
return $ Right
( Set.size avsLicenceDiffRevokeAll
, Set.size avsLicenceDiffGrantVorfeld

19
src/Handler/Admin/Test.hs
View File

@ -215,12 +215,29 @@ postAdminTestR = do
Button-Modal
|]
mkCryptoFilnameUser :: UserId -> Handler CryptoFileNameUser
mkCryptoFilnameUser = encrypt
mkCryptoUUIDUser :: UserId -> Handler CryptoUUIDUser
mkCryptoUUIDUser = encrypt
usrCryptoFileName <- maybeM (return "no-user_id") (fmap toPathPiece . mkCryptoFilnameUser) maybeAuthId
usrCryptoUUID <- maybeM (return "no-user_id") (fmap toPathPiece . mkCryptoUUIDUser) maybeAuthId
let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
siteLayout locallyDefinedPageHeading $ do
-- defaultLayout $ do
setTitle "Uni2work Admin Testpage"
setTitle "Uni2work Admin Testpage"
$(i18nWidgetFile "admin-test")
[whamlet|
<h2>User CryptoId and CryptoFileName
<dl>
<dt>CryptoUUIDUser
<dd>#{usrCryptoUUID}
<dt>CryptoFileNameUser
<dd>#{usrCryptoFileName}
|]
[whamlet|<h2>Formular Demonstration|]
wrapForm formWidget FormSettings
{ formMethod = POST

3
src/Handler/PrintCenter.hs
View File

@ -91,10 +91,11 @@ lrqf2letter LRQF{..}
| lrqfLetter == "e" || lrqfLetter == "E" = do
rcvr <- mapM getUser lrqfSuper
usr <- getUser lrqfUser
usrShrt <- encrypt $ entityKey usr
usrUuid <- encrypt $ entityKey usr
urender <- liftHandler getUrlRender
let letter = LetterExpireQualificationF
{ leqfHolderUUID = usrUuid
{ leqfHolderCFN = usrShrt
, leqfHolderID = usr ^. _entityKey
, leqfHolderDN = usr ^. _userDisplayName
, leqfHolderSN = usr ^. _userSurname

24
src/Jobs/Crontab.hs
View File

@ -332,6 +332,30 @@ determineCrontab = execWriterT $ do
| otherwise
-> return ()
if
| is _Just appAvsConf
, Just syncWithin <- appSynchroniseAvsUsersWithin
, Just cInterval <- appJobCronInterval
-> do
nextIntervals <- getNextIntervals syncWithin appSynchroniseAvsUsersInterval cInterval
forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do
tell $ HashMap.singleton
(JobCtlQueue JobSynchroniseAvs
{ jEpoch = fromInteger nextEpoch
, jNumIterations = fromInteger numIntervals
, jIteration = fromInteger nextInterval
, jSynchAfter = Nothing
})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ nextIntervalTime
, cronRepeat = CronRepeatNever
, cronRateLimit = appSynchroniseLdapUsersInterval
, cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appSynchroniseAvsUsersInterval nextIntervalTime
}
| otherwise
-> return ()
whenIsJust ((,) <$> appPruneUnreferencedFilesWithin <*> appJobCronInterval) $ \(within, cInterval) -> do
nextIntervals <- getNextIntervals within appPruneUnreferencedFilesInterval cInterval
forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do

3
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -45,6 +45,7 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user
dispatchNotificationQualificationExpired :: QualificationId -> UserId -> Handler ()
dispatchNotificationQualificationExpired nQualification jRecipient = do
encRecipient :: CryptoUUIDUser <- encrypt jRecipient
encRecShort <- encrypt jRecipient
dbRes <- runDB $ (,,)
<$> get jRecipient
<*> get nQualification
@ -57,7 +58,7 @@ dispatchNotificationQualificationExpired nQualification jRecipient = do
qname = CI.original qualificationName
qshort = CI.original qualificationShorthand
letter = LetterExpireQualificationF
{ leqfHolderUUID = encRecipient
{ leqfHolderCFN = encRecShort
, leqfHolderID = jRecipient
, leqfHolderDN = userDisplayName
, leqfHolderSN = userSurname

5
src/Jobs/Types.hs
View File

@ -89,6 +89,11 @@ data Job
, jIteration :: Natural
}
| JobSynchroniseLdapUser { jUser :: UserId }
| JobSynchroniseAvs { jNumIterations
, jEpoch
, jIteration :: Natural
, jSynchAfter :: Maybe UTCTime
}
| JobSynchroniseAvsUser { jUser :: UserId
, jSynchAfter :: Maybe UTCTime
}

8
src/Settings.hs
View File

@ -165,6 +165,9 @@ data AppSettings = AppSettings
, appSynchroniseLdapUsersWithin :: Maybe NominalDiffTime
, appSynchroniseLdapUsersInterval :: NominalDiffTime
, appSynchroniseAvsUsersWithin :: Maybe NominalDiffTime
, appSynchroniseAvsUsersInterval :: NominalDiffTime
, appLdapReTestFailover :: DiffTime
, appSessionFilesExpire :: NominalDiffTime
@ -690,9 +693,12 @@ instance FromJSON AppSettings where
appSessionTimeout <- o .: "session-timeout"
appSynchroniseLdapUsersWithin <- o .:? "synchronise-ldap-users-within"
appSynchroniseLdapUsersWithin <- o .:? "synchronise-ldap-users-within"
appSynchroniseLdapUsersInterval <- o .: "synchronise-ldap-users-interval"
appSynchroniseAvsUsersWithin <- o .:? "synchronise-avs-users-within"
appSynchroniseAvsUsersInterval <- o .: "synchronise-avs-users-interval"
appLdapReTestFailover <- o .: "ldap-re-test-failover"
appSessionFilesExpire <- o .: "session-files-expire"

4
src/Utils/Print/ExpireQualification.hs
View File

@ -20,7 +20,7 @@ import Handler.Utils.Widgets (nameHtml) -- , nameHtml')
data LetterExpireQualificationF = LetterExpireQualificationF
{ leqfHolderUUID:: CryptoUUIDUser
{ leqfHolderCFN :: CryptoFileNameUser
, leqfHolderID :: UserId
, leqfHolderDN :: UserDisplayName
, leqfHolderSN :: UserSurname
@ -78,7 +78,7 @@ instance MDLetter LetterExpireQualificationF where
getPJId LetterExpireQualificationF{..} =
PrintJobIdentification
{ pjiName = "Expiry"
, pjiApcAcknowledge = "exp-" <> tshow (ciphertext leqfHolderUUID)
, pjiApcAcknowledge = "ex-" <> toPathPiece leqfHolderCFN
, pjiRecipient = Nothing -- to be filled later
, pjiSender = Nothing
, pjiCourse = Nothing

2
src/Utils/Print/Letters.hs
View File

@ -182,7 +182,7 @@ mkApcIdent uuid envelope lk tnow apcAck = Text.filter apcAcceptedChars $ Text.in
[ ensureLength 38 $ tshow (ciphertext uuid) <> Text.cons '-' (Text.singleton envelope)
, ensureLength 5 $ paperKind lk
, ensureLength 9 tnow
, apcAck -- length of last part may be arbitrary, thus far was always 12
, Text.take 32 apcAck -- length of last part may be arbitrary, but more than 32 symbols do not fit into the line
]
where
ensureLength :: Int -> Text -> Text