diff --git a/config/settings.yml b/config/settings.yml index f5714203d..ecc94093d 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -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 diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 983a083d3..a434ace81 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -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 diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index ff3904e6e..3d6fd5b4a 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -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| +

User CryptoId and CryptoFileName +
+
CryptoUUIDUser +
#{usrCryptoUUID} +
CryptoFileNameUser +
#{usrCryptoFileName} + |] + [whamlet|

Formular Demonstration|] wrapForm formWidget FormSettings { formMethod = POST diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 41fa484d3..f12f5b9af 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -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 diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 0a191fd75..d660e3552 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -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 diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 6c438ded8..241af0bc3 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -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 diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs index 119d9ef0a..5fd2807dd 100644 --- a/src/Jobs/Handler/SynchroniseAvs.hs +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -3,18 +3,21 @@ -- SPDX-License-Identifier: AGPL-3.0-or-later module Jobs.Handler.SynchroniseAvs - ( dispatchJobSynchroniseAvsId - , dispatchJobSynchroniseAvsUser + ( dispatchJobSynchroniseAvs + , dispatchJobSynchroniseAvsId + , dispatchJobSynchroniseAvsUser ) where import Import +import qualified Data.Conduit.List as C +import Jobs.Queue + import Handler.Utils.Avs - -{- TODO: general AVS synchronisation -dispatchJobSynchroniseLdap :: Natural -> Natural -> Natural -> JobHandler UniWorX -dispatchJobSynchroniseLdap numIterations epoch iteration +-- TODO: JobSynchroniseAllAvs is not yet scheduled in Crontab +dispatchJobSynchroniseAvs :: Natural -> Natural -> Natural -> Maybe UTCTime -> JobHandler UniWorX +dispatchJobSynchroniseAvs numIterations epoch iteration pause = JobHandlerAtomic . runConduit $ readUsers .| filterIteration .| sinkDBJobs where @@ -27,15 +30,14 @@ dispatchJobSynchroniseLdap numIterations epoch iteration 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}|] + $logDebugS "SynchronisAvs" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|] guard $ userIteration == currentIteration - - return $ JobSynchroniseLdapUser userId --} + + return $ JobSynchroniseAvsUser userId pause -dispatchJobSynchroniseAvs :: Either AvsPersonId UserId -> Maybe UTCTime -> JobHandler UniWorX -dispatchJobSynchroniseAvs eauid pause = JobHandlerException $ do +workJobSynchroniseAvs :: Either AvsPersonId UserId -> Maybe UTCTime -> JobHandler UniWorX +workJobSynchroniseAvs eauid pause = JobHandlerException $ do let uniqKey = either UniqueUserAvsId UniqueUserAvsUser eauid runDB (getBy uniqKey) >>= \case Nothing -> return () -- do not create new newers in this background job, only update existing @@ -44,7 +46,7 @@ dispatchJobSynchroniseAvs eauid pause = JobHandlerException $ do | otherwise -> void $ upsertAvsUserById userAvsPersonId -- updates UserAvsLAstSynch dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe UTCTime -> JobHandler UniWorX -dispatchJobSynchroniseAvsId = dispatchJobSynchroniseAvs . Left +dispatchJobSynchroniseAvsId = workJobSynchroniseAvs . Left dispatchJobSynchroniseAvsUser :: UserId -> Maybe UTCTime -> JobHandler UniWorX -dispatchJobSynchroniseAvsUser = dispatchJobSynchroniseAvs . Right +dispatchJobSynchroniseAvsUser = workJobSynchroniseAvs . Right diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 4a2a9787e..8325d40fc 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -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 } diff --git a/src/Settings.hs b/src/Settings.hs index 9d58ca747..5b6c139cb 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -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" diff --git a/src/Utils/Print/ExpireQualification.hs b/src/Utils/Print/ExpireQualification.hs index a07f50c7e..1d73a3c6a 100644 --- a/src/Utils/Print/ExpireQualification.hs +++ b/src/Utils/Print/ExpireQualification.hs @@ -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 diff --git a/src/Utils/Print/Letters.hs b/src/Utils/Print/Letters.hs index d3cd2ccb4..7fe8b4a68 100644 --- a/src/Utils/Print/Letters.hs +++ b/src/Utils/Print/Letters.hs @@ -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