refactor(lms): use runDBRead and caching for FilterColumnHandler used in LMS Orphans

This commit is contained in:
Steffen Jost 2025-02-04 15:05:30 +01:00 committed by Sarah Vaupel
parent d5bbec9fa3
commit 490b89e174
3 changed files with 33 additions and 29 deletions

View File

@ -186,22 +186,24 @@ getLmsLearnersR sid qsh = do
lmsTable
selectOrphans :: QualificationId -> UTCTime -> DB [(LmsOrphanId, LmsIdent)]
-- selectOrphans :: QualificationId -> UTCTime -> DB [(LmsOrphanId, LmsIdent)]
selectOrphans :: (MonadHandler m, HasAppSettings (HandlerSite m), BackendCompatible SqlBackend backend, PersistQueryRead backend, PersistUniqueRead backend)
=> Key Qualification -> UTCTime -> ReaderT backend m [(LmsOrphanId, LmsIdent)]
selectOrphans qid now = do
lmsConf <- getsYesod $ view _appLmsConf
let cutoff_seen_first = addLocalDays (negate $ lmsConf ^. _lmsOrphanDeletionDays) now
cutoff_deleted_last = addHours (negate $ lmsConf ^. _lmsOrphanRepeatHours) now
cutoff_seen_last = cutoff_deleted_last
orphan_max_batch = lmsConf ^. _lmsOrphanDeletionBatch
$(E.unValueN 2) <<$>> ( Ex.select $ do
$(E.unValueN 2) <<$>> (Ex.select $ do
orv <- Ex.from $ Ex.table @LmsOrphan
Ex.where_ $ Ex.val qid Ex.==. orv Ex.^. LmsOrphanQualification
Ex.&&. Ex.val cutoff_seen_first Ex.>=. orv Ex.^. LmsOrphanSeenFirst -- has been seen for while
Ex.&&. Ex.val cutoff_seen_last Ex.<=. orv Ex.^. LmsOrphanSeenLast -- was still seen recently
Ex.&&. Ex.val cutoff_deleted_last E.>~. orv Ex.^. LmsOrphanDeletedLast -- not already recently deleted
Ex.where_ $ Ex.val qid E.==. orv Ex.^. LmsOrphanQualification
Ex.&&. Ex.val cutoff_seen_first E.>=. orv Ex.^. LmsOrphanSeenFirst -- has been seen for while
Ex.&&. Ex.val cutoff_seen_last E.<=. orv Ex.^. LmsOrphanSeenLast -- was still seen recently
Ex.&&. Ex.val cutoff_deleted_last E.>~. orv Ex.^. LmsOrphanDeletedLast -- not already recently deleted
Ex.&&. Ex.notExists (do -- not currently used anywhere (LmsIdent share the namespace)
lusr <- Ex.from $ Ex.table @LmsUser
Ex.where_ $ lusr Ex.^. LmsUserIdent Ex.==. orv Ex.^.LmsOrphanIdent
Ex.where_ $ lusr Ex.^. LmsUserIdent E.==. orv Ex.^.LmsOrphanIdent
)
Ex.orderBy [Ex.desc $ orv Ex.^. LmsOrphanDeletedLast, Ex.asc $ orv Ex.^. LmsOrphanSeenLast] -- Note for PostgreSQL: DESC == DESC NULLS FIRST
Ex.limit orphan_max_batch
@ -291,27 +293,29 @@ getLmsOrphansR sid qsh = do
, ("deleted-last" , SortColumn (E.^. LmsOrphanDeletedLast))
, ("reason" , SortColumn (E.^. LmsOrphanReason))
]
cachedNextOrphans = $(memcachedByHere) (Just $ Right $ 1 * diffMinute) ("cache-next-orphans" <> tshow qid) $ do
now <- liftIO getCurrentTime
next_orphans <- runDBRead $ selectOrphans qid now -- only query next orphans when really needed; not sure how to formulate a proper sub-query here
-- addMessageI Info $ MsgLmsOrphanNr $ length next_orphans -- debug
return $ map fst next_orphans
dbtFilter = Map.fromList
[ ("preview" , FilterColumnHandler $ \case
[ ("ident" , FilterColumn $ E.mkContainsFilterWithCommaPlus LmsIdent (E.^. LmsOrphanIdent))
, ("preview" , FilterColumnHandler $ \case
(x:_)
| x == tshow True -> do
now <- liftIO getCurrentTime
next_orphans <- runDB $ selectOrphans qid now -- only query next orphans when really needed; not sure how to formulate a proper sub-query here
-- addMessageI Info $ MsgLmsOrphanNr $ length next_orphans -- debug
return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.in_` E.valList (map fst next_orphans)
next_orphans <- cachedNextOrphans
return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.in_` E.valList next_orphans
| x == tshow False -> do
now <- liftIO getCurrentTime
next_orphans <- runDB $ selectOrphans qid now
return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.notIn` E.valList (map fst next_orphans)
next_orphans <- cachedNextOrphans
return $ \row -> (queryOrphan row E.^. LmsOrphanId) `E.notIn` E.valList next_orphans
_ -> return (const E.true)
)
, ("ident" , FilterColumn $ E.mkContainsFilterWithCommaPlus LmsIdent (E.^. LmsOrphanIdent))
]
-- checkBoxTextField = convertField show (\case { t | t == show True -> True; _ -> False }) checkBoxField -- UNNECESSARY hack to use FilterColumnHandler, which only works on [Text] criteria
dbtFilterUI mPrev = mconcat
[ prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt textField (fslI MsgTableLmsIdent & setTooltip MsgTableFilterCommaPlus)
-- , prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgLmsOrphanPreviewFltr) -- NOTE: anticipated checkBoxTextField-hack not needed here
, prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgLmsOrphanPreviewFltr)
[ -- prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgLmsOrphanPreviewFltr) -- NOTE: anticipated checkBoxTextField-hack not needed here
prismAForm (singletonFilter "preview" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgLmsOrphanPreviewFltr)
, prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt textField (fslI MsgTableLmsIdent & setTooltip MsgTableFilterCommaPlus)
]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtParams = def

View File

@ -6,7 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<p>
Gezeigt werden ELearning Logins, welche für diese Qualifikation an FRADrive zurückgemeldet wurden #
Gezeigt werden ELearning Logins, welche für Qualifikation #{qsh} an FRADrive zurückgemeldet wurden #
und von FRADrive nicht mehr zugeordnet werden können. #
Normalerweise löscht das LMS beendete ELearning Logins selbstständig. #
@ -18,11 +18,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
Verwaiste Logins werden beim nächsten Abruf der ELearning Logins von FRADrive zur Löschung durch das LMS gemeldet. #
Die Auswahl, ob ein ELearning Login zur Löschung gemeldet wird, hängt von folgenden Kriterien ab: #
<ul>
<li>"_{MsgLmsOrphanSeenFirst}" liegt mindestens #{lmsOrphanDeletionDays} Tage zurück
<li>"_{MsgLmsOrphanSeenLast}" liegt höchstens #{lmsOrphanRepeatHours} Stunden zurück
<li>"_{MsgLmsOrphanSeenFirst}" liegt mindestens #{lmsOrphanDeletionDays} Tage zurück.
<li>"_{MsgLmsOrphanSeenLast}" liegt höchstens #{lmsOrphanRepeatHours} Stunden zurück.
<li>"_{MsgLmsOrphanDeletedLast}", d.h. der letzte Löschantrag für diesen Login ist älter als #{lmsOrphanRepeatHours} Stunden #
oder wurde noch gar nicht gestellt
<li>Der ELearning Login ist auch unter keiner anderen Qualifikation in FRADrive bekannt
oder wurde noch gar nicht gestellt.
<li>Der ELearning Login ist auch unter keiner anderen Qualifikation in FRADrive bekannt.
<p>
Es werden jedoch pro Abruf nur #{lmsOrphanDeletionBatch} ELearning Logins zur Löschung an das LMS gemeldet. #
Dabei werden Logins bevorzugt welche noch gar nicht oder vor der längsten Zeit gemeldet wurden ("_{MsgLmsOrphanDeletedLast}"), #

View File

@ -6,7 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<p>
Displayed are elearning logins that have been reported back to FRADrive for this qualification, #
Displayed are elearning logins that have been reported back to FRADrive for qualification #{qsh}, #
but which are unknown to FRADrive. #
Normally, the LMS automatically deletes completed elearning logins. #
@ -18,11 +18,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
Orphaned logins will be reported for deletion by FRADrive to the LMS during the next retrieval of elearning logins. #
The decision whether an elearning login is reported for deletion depends on the following criteria: #
<ul>
<li>"_{MsgLmsOrphanSeenFirst}" is at least #{lmsOrphanDeletionDays} days ago
<li>"_{MsgLmsOrphanSeenLast}" is at most #{lmsOrphanRepeatHours} hours ago
<li>"_{MsgLmsOrphanSeenFirst}" is at least #{lmsOrphanDeletionDays} days ago.
<li>"_{MsgLmsOrphanSeenLast}" is at most #{lmsOrphanRepeatHours} hours ago.
<li>"_{MsgLmsOrphanDeletedLast}", i.e., the last deletion request for this login is older than #{lmsOrphanRepeatHours} hours #
or has not been made yet
<li>The elearning login is not associated with any other qualification within FRADrive
or has not been made yet.
<li>The elearning login is not associated with any other qualification within FRADrive.
<p>
However, only #{lmsOrphanDeletionBatch} elearning logins are reported for deletion to the LMS per request. #
Logins that have not yet been reported for deletion at all or were reported the longest time ago ("_{MsgLmsOrphanDeletedLast}") are preferred, #