refactor(memcached): remove ARC cache entirely

NOTE: this was a crude surgery, removing everything ARC related; some dead code artifacts may have remained. Especially check PrewarmCacheConf Reason for removall: adding `memcachedInvalidateClass` was difficult to implement with ARC active; ARC was known to be problematic; removal was easier (see #2 2024-09-23)
chore(memcached): add key classes for easy invalidation
2024-09-23 18:52:26 +02:00 · 2024-09-23 17:09:47 +02:00 · 2024-09-18 18:03:49 +02:00
19 changed files with 245 additions and 637 deletions
--- a/config/settings.yml
+++ b/config/settings.yml
@ -204,9 +204,6 @@ memcached:
  timeout:    "_env:MEMCACHED_TIMEOUT:20"
  expiration: "_env:MEMCACHED_EXPIRATION:300"
 memcache-auth: true
-memcached-local:
-  maximum-ghost: 512
-  maximum-weight: 104857600 # 100MiB

 upload-cache:
  host: "_env:UPLOAD_S3_HOST:" # should be optional, but all file transfers will be empty without an S3 cache
--- a/src/Application.hs
+++ b/src/Application.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -119,9 +119,6 @@ import qualified Data.IntervalMap.Strict as IntervalMap

 import qualified Utils.Pool as Custom

-import Utils.Postgresql
-import Handler.Utils.Memcached (manageMemcachedLocalInvalidations)
-
 import qualified System.Clock as Clock

 import Utils.Avs (mkAvsQuery)
@ -219,10 +216,6 @@ makeFoundation appSettings''@AppSettings{..} = do
    appJobState <- liftIO newEmptyTMVarIO
    appHealthReport <- liftIO $ newTVarIO Set.empty

-    appFileSourceARC <- for appFileSourceARCConf $ \ARCConf{..} -> do
-      ah <- initARCHandle arccMaximumGhost arccMaximumWeight
-      void . Prometheus.register $ arcMetrics ARCFileSource ah
-      return ah
    appFileSourcePrewarm <- for appFileSourcePrewarmConf $ \PrewarmCacheConf{..} -> do
      lh <- initLRUHandle precMaximumWeight
      void . Prometheus.register $ lruMetrics LRUFileSourcePrewarm lh
@ -239,7 +232,7 @@ makeFoundation appSettings''@AppSettings{..} = do
    -- from there, and then create the real foundation.
    let
      mkFoundation :: _ -> (forall m. MonadIO m => Custom.Pool' m DBConnLabel DBConnUseState SqlBackend) -> _
-      mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery = UniWorX{..}
+      mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery = UniWorX{..}
      tempFoundation = mkFoundation
        (error "appSettings' forced in tempFoundation")
        (error "connPool forced in tempFoundation")
@ -252,7 +245,6 @@ makeFoundation appSettings''@AppSettings{..} = do
        (error "JSONWebKeySet forced in tempFoundation")
        (error "ClusterID forced in tempFoundation")
        (error "memcached forced in tempFoundation")
-        (error "memcachedLocal forced in tempFoundation")
        (error "MinioConn forced in tempFoundation")
        (error "VerpSecret forced in tempFoundation")
        (error "AuthKey forced in tempFoundation")
@ -337,12 +329,6 @@ makeFoundation appSettings''@AppSettings{..} = do
          $logWarnS "setup" "Clearing memcached"
          liftIO $ Memcached.flushAll memcachedConn
        return AppMemcached{..}
-      appMemcachedLocal <- for appMemcachedLocalConf $ \ARCConf{..} -> do
-        memcachedLocalARC <- initARCHandle arccMaximumGhost arccMaximumWeight
-        void . Prometheus.register $ arcMetrics ARCMemcachedLocal memcachedLocalARC
-        memcachedLocalInvalidationQueue <- newTVarIO mempty
-        memcachedLocalHandleInvalidations <- allocateLinkedAsync . managePostgresqlChannel appDatabaseConf ChannelMemcachedLocalInvalidation $ manageMemcachedLocalInvalidations memcachedLocalARC memcachedLocalInvalidationQueue
-        return AppMemcachedLocal{..}

      appSessionStore <- mkSessionStore appSettings'' sqlPool `customRunSqlPool` sqlPool

@ -380,7 +366,7 @@ makeFoundation appSettings''@AppSettings{..} = do

      $logDebugS "Runtime configuration" $ tshowCrop appSettings'

-      let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery
+      let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery

      -- Return the foundation
      $logInfoS "setup" "*** DONE ***"
--- a/src/Foundation/Authorization.hs
+++ b/src/Foundation/Authorization.hs
@ -313,7 +313,8 @@ isDryRunDB = fmap unIsDryRun . cached . fmap MkIsDryRun $ orM

      dnf <- throwLeft $ routeAuthTags currentRoute
      let eval :: forall m''. MonadAP m'' => AuthTagsEval m''
-          eval dnf' mAuthId' route' isWrite' = evalAuthTags 'isDryRun (AuthTagActive $ const True) eval (noTokenAuth dnf') mAuthId' route' isWrite'
+          -- eval dnf' mAuthId' route' isWrite' = evalAuthTags 'isDryRun (AuthTagActive $ const True) eval (noTokenAuth dnf') mAuthId' route' isWrite'
+          eval dnf' = evalAuthTags 'isDryRun (AuthTagActive $ const True) eval (noTokenAuth dnf')
       in guardAuthResult <=< evalWriterT $ eval dnf mAuthId currentRoute isWrite

      return False
@ -368,7 +369,8 @@ validateBearer mAuthId' route' isWrite' token' = $runCachedMemoT $ for4 memo val
        noTokenAuth = over _dnfTerms . Set.filter . noneOf (re _nullable . folded) $ (== AuthToken) . plVar

        eval :: forall m'. MonadAP m' => AuthTagsEval m'
-        eval dnf' mAuthId'' route'' isWrite'' = evalAuthTags 'validateBearer (AuthTagActive $ const True) eval (noTokenAuth dnf') mAuthId'' route'' isWrite''
+        -- eval dnf' mAuthId'' route'' isWrite'' = evalAuthTags 'validateBearer (AuthTagActive $ const True) eval (noTokenAuth dnf') mAuthId'' route'' isWrite''
+        eval dnf' = evalAuthTags 'validateBearer (AuthTagActive $ const True) eval (noTokenAuth dnf')

      bearerAuthority' <- hoist apRunDB $ do
        bearerAuthority' <- flip foldMapM bearerAuthority $ \case
--- a/src/Foundation/Type.hs
+++ b/src/Foundation/Type.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -11,8 +11,6 @@ module Foundation.Type
  , _SessionStorageMemcachedSql, _SessionStorageAcid
  , AppMemcached(..)
  , _memcachedKey, _memcachedConn
-  , AppMemcachedLocal(..)
-  , _memcachedLocalARC
  , SMTPPool
  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey, _appVolatileClusterSettingsCache, _appAvsQuery
  , DB, DBRead, Form, MsgRenderer, MailM, DBFile
@ -38,9 +36,6 @@ import qualified Utils.Pool as Custom

 import Utils.Metrics (DBConnUseState)

-import qualified Data.ByteString.Lazy as Lazy
-import Data.Time.Clock.POSIX (POSIXTime)
-import GHC.Fingerprint (Fingerprint)
 import Handler.Sheet.PersonalisedFiles.Types (PersonalisedSheetFilesSeedKey)

 import Utils.Avs (AvsQuery())
@ -62,13 +57,6 @@ data AppMemcached = AppMemcached

 makeLenses_ ''AppMemcached

-data AppMemcachedLocal = AppMemcachedLocal
-  { memcachedLocalARC :: ARCHandle (Fingerprint, Lazy.ByteString) Int (NFDynamic, Maybe POSIXTime)
-  , memcachedLocalHandleInvalidations :: Async ()
-  , memcachedLocalInvalidationQueue :: TVar (Seq (Fingerprint, Lazy.ByteString))
-  } deriving (Generic)
-
-makeLenses_ ''AppMemcachedLocal

 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application
@ -93,11 +81,9 @@ data UniWorX = UniWorX
    , appJSONWebKeySet     :: Jose.JwkSet
    , appHealthReport      :: TVar (Set (UTCTime, HealthReport))
    , appMemcached         :: Maybe AppMemcached
-    , appMemcachedLocal    :: Maybe AppMemcachedLocal
    , appUploadCache       :: Maybe MinioConn
    , appVerpSecret        :: VerpSecret
    , appAuthKey           :: Auth.Key
-    , appFileSourceARC     :: Maybe (ARCHandle (FileContentChunkReference, (Int, Int)) Int ByteString)
    , appFileSourcePrewarm :: Maybe (LRUHandle (FileContentChunkReference, (Int, Int)) UTCTime Int ByteString)
    , appFileInjectInhibit :: TVar (IntervalMap UTCTime (Set FileContentReference))
    , appPersonalisedSheetFilesSeedKey :: PersonalisedSheetFilesSeedKey
--- a/src/Handler/Course/Edit.hs
+++ b/src/Handler/Course/Edit.hs
@ -452,6 +452,7 @@ courseEditHandler miButtonAction mbCourseForm = do
                    sinkInvitationsF lecturerInvitationConfig $ map (\(lEmail, mLty) -> (lEmail, cid, (InvDBDataLecturer mLty, InvTokenDataLecturer))) invites
                    void $ upsertCourseQualifications aid cid $ cfQualis res
                    insert_ $ CourseEdit aid now cid
+                    memcachedFlushClass MemcachedKeyClassTutorialOccurrences
                    memcachedByInvalidate AuthCacheLecturerList $ Proxy @(Set UserId)
                    addMessageI Success $ MsgCourseEditOk tid ssh csh
                    return True
--- a/src/Handler/School/DayTasks.hs
+++ b/src/Handler/School/DayTasks.hs
@ -15,14 +15,15 @@ import Import

 import Handler.Utils
 import Handler.Utils.Company
+import Handler.Utils.Occurrences

-- import qualified Data.Set as Set
+import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.Aeson  as Aeson
 -- import qualified Data.Text as Text

 -- import Database.Persist.Sql (updateWhereCount)
-- import           Database.Esqueleto.Experimental ((:&)(..))
+import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Legacy as EL (on) -- only `on` and `from` are different, needed for dbTable using Esqueleto.Legacy
 import qualified Database.Esqueleto.Experimental as E
 import qualified Database.Esqueleto.Utils as E
@ -51,7 +52,46 @@ occurrenceDayValue d = Aeson.object
  ] ] ]
 -- TODO: ensure that an appropriate GIN index for the jsonb column is set

+{- More efficient DB-only version, but ignores regular schedules
+getDayTutorials :: SchoolId -> Day -> DB [TutorialId]
+getDayTutorials ssh d = E.unValue <<$>> E.select (do
+    (trm :& crs :& tut) <- E.from $ E.table @Term
+      `E.innerJoin` E.table @Course   `E.on` (\(trm :& crs)      -> crs E.^. CourseTerm E.==. trm E.^. TermId)
+      `E.innerJoin` E.table @Tutorial `E.on` (\(_ :& crs :& tut) -> crs E.^. CourseId   E.==. tut E.^. TutorialCourse)
+    E.where_ $ E.between (E.val d) (trm E.^. TermStart, trm E.^. TermEnd)
+        E.&&.  crs E.^. CourseSchool E.==. E.val ssh
+        E.&&. (E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue d))
+    return $ tut E.^. TutorialId
+  )
+-}

+-- Datatype to be used for memcaching occurrences
+data OccurrenceCacheKey = OccurrenceCacheKeyTutorials SchoolId (Day,Day)
+  deriving (Eq, Ord, Read, Show, Generic)
+  deriving anyclass (Hashable, Binary)
+
+getDayTutorials :: SchoolId -> (Day,Day) -> DB [TutorialId]
+getDayTutorials ssh dlimit@(dstart, dend )
+  | dstart > dend = return mempty
+  | otherwise = memcachedByClass MemcachedKeyClassTutorialOccurrences (Just . Right $ 9 * diffDay) (OccurrenceCacheKeyTutorials ssh dlimit) $ do
+    candidates <- E.select $ do
+      (trm :& crs :& tut) <- E.from $ E.table @Term
+          `E.innerJoin` E.table @Course   `E.on` (\(trm :& crs)      -> crs E.^. CourseTerm E.==. trm E.^. TermId)
+          `E.innerJoin` E.table @Tutorial `E.on` (\(_ :& crs :& tut) -> crs E.^. CourseId   E.==. tut E.^. TutorialCourse)
+      E.where_ $ crs E.^. CourseSchool E.==. E.val ssh
+          E.&&.  trm E.^. TermStart    E.<=. E.val dend
+          E.&&.  trm E.^. TermEnd      E.>=. E.val dstart
+      return (trm, tut)
+    $logErrorS "memcached" $ "***DEBUG*****CACHE*****" <> tshow (ssh,dlimit) <> "***************" -- DEBUG ONLY
+    return $ mapMaybe checkCandidate candidates
+  where
+    period = Set.fromAscList [dstart..dend]
+
+    checkCandidate (Entity{entityVal=trm}, Entity{entityKey=tutId, entityVal=Tutorial{tutorialTime=JSONB occ}})
+      | not $ Set.null $ Set.intersection period $ occurrencesCompute trm occ
+        = Just tutId
+      | otherwise
+        = Nothing

 type DailyTableExpr =
  (               E.SqlExpr (Entity Course)
@ -100,19 +140,14 @@ instance HasUser DailyTableData where

 mkDailyTable :: Bool -> SchoolId -> Day -> DB (FormResult (DailyTableActionData, Set TutorialId), Widget)
 mkDailyTable isAdmin ssh nd = do
+  tuts <- getDayTutorials ssh (nd,nd)
  let
    dbtSQLQuery :: DailyTableExpr -> DailyTableOutput
    dbtSQLQuery  (crs `E.InnerJoin` tut `E.InnerJoin` tpu `E.InnerJoin` usr) = do
      EL.on $ tut E.^. TutorialCourse E.==. crs E.^. CourseId
      EL.on $ tut E.^. TutorialId     E.==. tpu E.^. TutorialParticipantTutorial
      EL.on $ usr E.^. UserId         E.==. tpu E.^. TutorialParticipantUser
-      E.where_ $ crs E.^. CourseSchool E.==. E.val ssh
-        E.&&. (E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue nd))
-        E.&&. E.exists (do
-          trm <- E.from $ E.table @Term
-          E.where_ $ trm E.^. TermId E.==. crs E.^. CourseTerm
-            E.&&. E.between (E.val nd) (trm E.^. TermStart, trm E.^. TermEnd)
-        )
+      E.where_ $ tut E.^. TutorialId `E.in_` E.valList tuts
      return (crs, tut, tpu, usr, selectCompanyUserPrime usr)
    dbtRowKey = queryTutorial >>> (E.^. TutorialId)
    dbtProj   = dbtProjId
@ -126,7 +161,7 @@ mkDailyTable isAdmin ssh nd = do
          in anchorCell (CTutorialR tid cssh csh tutName TUsersR) $ citext2widget tutName
      , sortable (Just "user-company") (i18nCell MsgTablePrimeCompany) $ \(preview resultCompanyId -> mcid) -> cellMaybe companyIdCell mcid
      , sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantCompany -> mcid) -> cellMaybe companyIdCell mcid
-      , colUserNameModalHdr MsgTableCourseMembers ForProfileDataR
+      , colUserNameModalHdr MsgCourseParticipant ForProfileDataR
      , colUserMatriclenr isAdmin
      ]
    dbtSorting = Map.fromList
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@ -29,7 +29,7 @@ import qualified Control.Monad.State.Class as State
 validateTerm :: (MonadHandler m, HandlerSite m ~ UniWorX)
             => FormValidator TermForm m ()
 validateTerm = do
-  TermForm{..} <- State.get  
+  TermForm{..} <- State.get
  guardValidation MsgTermEndMustBeAfterStart $ tfStart < tfEnd
  guardValidation MsgTermLectureEndMustBeAfterStart $ tfLectureStart < tfLectureEnd
  guardValidation MsgTermStartMustBeBeforeLectureStart $ tfStart <= tfLectureStart
@ -87,7 +87,7 @@ getTermShowR = do
                                    $of Left singleHoliday
                                      ^{formatTimeW SelFormatDate singleHoliday}
                                    $of Right (startD, endD)
-                                      ^{formatTimeRangeW SelFormatDate startD (Just endD)}                                       
+                                      ^{formatTimeRangeW SelFormatDate startD (Just endD)}
                          |]
                  ]
                dbtSorting = Map.fromList
@ -150,11 +150,11 @@ postTermEditR = do
                      Set.unions $ bankHolidaysAreaSet Fraport <$> [getYear tStart..getYear tEnd]
             in mempty
                  { tftName         = Just ntid
-                  , tftStart        = Just tStart 
-                  , tftEnd          = Just tEnd  
+                  , tftStart        = Just tStart
+                  , tftEnd          = Just tEnd
                  , tftLectureStart = Just tLecStart
                  , tftLectureEnd   = Just tLecEnd
-                  , tftHolidays     = Just tHolys 
+                  , tftHolidays     = Just tHolys
                  }
  termEditHandler Nothing template

@ -201,6 +201,7 @@ termEditHandler mtid template = do
                , termActiveFor = tafFor
                }
            lift . audit $ TransactionTermEdit tid
+          memcachedFlushClass MemcachedKeyClassTutorialOccurrences
          addMessageI Success $ MsgTermEdited tid
          redirect TermShowR
      FormMissing      -> return ()
@ -332,7 +333,7 @@ newTermForm mtid template = validateForm validateTerm $ \html -> do
            (fromRes, fromView) <- mpreq utcTimeField ("" & addName (mkUnique "from")) Nothing
            (toRes, toView) <- mopt utcTimeField ("" & addName (mkUnique "to")) Nothing
            (forRes, forView) <- mopt (checkMap (first $ const MsgTermFormActiveUserNotFound) Right $ userField False Nothing) ("" & addName (mkUnique "for") & addPlaceholder (mr MsgTermActiveForPlaceholder)) Nothing
-            
+
            let res = TermActiveForm <$> fromRes <*> toRes <*> forRes
                res' = res <&> \newDat oldDat -> if
                  | newDat `elem` oldDat
--- a/src/Handler/Tutorial/Edit.hs
+++ b/src/Handler/Tutorial/Edit.hs
@ -88,6 +88,7 @@ postTEditR tid ssh csh tutn = do
    case insertRes of
      Just _  -> addMessageI Error $ MsgTutorialNameTaken tfName
      Nothing -> do
+        memcachedFlushClass MemcachedKeyClassTutorialOccurrences
        addMessageI Success $ MsgTutorialEdited tfName
        redirect $ CourseR tid ssh csh CTutorialListR

--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2023 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2023-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -26,7 +26,7 @@ import Handler.Utils.I18n       as Handler.Utils
 import Handler.Utils.Widgets    as Handler.Utils
 import Handler.Utils.Database   as Handler.Utils
 import Handler.Utils.Occurrences as Handler.Utils
-import Handler.Utils.Memcached  as Handler.Utils hiding (manageMemcachedLocalInvalidations)
+import Handler.Utils.Memcached  as Handler.Utils
 import Handler.Utils.Files      as Handler.Utils
 import Handler.Utils.Download   as Handler.Utils
 import Handler.Utils.AuthorshipStatement as Handler.Utils
--- a/src/Handler/Utils/Avs.hs
+++ b/src/Handler/Utils/Avs.hs
@ -222,7 +222,7 @@ avsQueryNoCacheDefault qry = do
    qfun <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ preview (_appAvsQuery . _Just . to pickQuery)
    throwLeftM $ qfun qry

-avsQueryCached :: (SomeAvsQuery q, Binary q, Binary (SomeAvsResponse q), Typeable (SomeAvsResponse q), NFData (SomeAvsResponse q)
+avsQueryCached :: (SomeAvsQuery q, Binary q, Binary (SomeAvsResponse q), Typeable (SomeAvsResponse q)
                  ,   MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) => q -> m (SomeAvsResponse q)
 avsQueryCached qry =
  getsYesod (preview $ _appAvsConf . _Just . _avsCacheExpiry) >>= \case
--- a/src/Handler/Utils/Delete.hs
+++ b/src/Handler/Utils/Delete.hs
@ -21,6 +21,7 @@ module Handler.Utils.Delete

 import Import
 import Handler.Utils.Form
+import Handler.Utils.Memcached

 import qualified Data.Text as Text
 import qualified Data.Set as Set
@ -113,6 +114,7 @@ deleteR' DeleteRoute{..} = do
    True -> do
      runDBJobs $ do
        forM_ drRecords $ \k -> drDelete k $ delete k
+        memcachedFlushClass MemcachedKeyClassTutorialOccurrences
        addMessageI Success drSuccessMessage
      redirect drSuccess
    False ->
--- a/src/Handler/Utils/Files.hs
+++ b/src/Handler/Utils/Files.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -18,8 +18,6 @@ import Foundation.Type
 import Foundation.DB
 import Utils.Metrics

-import Data.Monoid (First(..))
-
 import qualified Data.Conduit.Combinators as C
 import qualified Data.Conduit.List as C (unfoldM)

@ -32,7 +30,6 @@ import qualified Database.Esqueleto.Utils as E
 import System.FilePath (normalise, makeValid)
 import Data.List (dropWhileEnd)

-import qualified Data.ByteString as ByteString


 data SourceFilesException
@ -44,58 +41,36 @@ data SourceFilesException
 makePrisms ''SourceFilesException


-fileChunkARC :: ( MonadHandler m
+fileChunk :: ( MonadHandler m
                , HandlerSite m ~ UniWorX
                )
-             => Maybe Int
-             -> (FileContentChunkReference, (Int, Int))
+             => (FileContentChunkReference, (Int, Int))
             -> m (Maybe (ByteString, Maybe FileChunkStorage))
             -> m (Maybe ByteString)
-fileChunkARC altSize k@(ref, (s, l)) getChunkDB' = do
+fileChunk k getChunkDB' = do
  prewarm <- getsYesod appFileSourcePrewarm
-  let getChunkDB = case prewarm of
+  -- NOTE: crude surgery happened here to remove ARC caching; useless artifacts may have remained
+  case prewarm of
+    Nothing -> do
+      chunk' <- getChunkDB'
+      for chunk' $ \(chunk, mStorage) -> chunk <$ do
+        $logDebugS "fileChunkARC" "No prewarm"
+        for_ mStorage $ \storage ->
+          let w = length chunk
+            in liftIO $ observeSourcedChunk storage w
+    Just lh -> do
+      chunkRes <- lookupLRUHandle lh k
+      case chunkRes of
+        Just (chunk, w) -> Just chunk <$ do
+          $logDebugS "fileChunkARC" "Prewarm hit"
+          liftIO $ observeSourcedChunk StoragePrewarm w
        Nothing -> do
          chunk' <- getChunkDB'
          for chunk' $ \(chunk, mStorage) -> chunk <$ do
-            $logDebugS "fileChunkARC" "No prewarm"
+            $logDebugS "fileChunkARC" "Prewarm miss"
            for_ mStorage $ \storage ->
              let w = length chunk
-               in liftIO $ observeSourcedChunk storage w
-        Just lh -> do
-          chunkRes <- lookupLRUHandle lh k
-          case chunkRes of
-            Just (chunk, w) -> Just chunk <$ do
-              $logDebugS "fileChunkARC" "Prewarm hit"
-              liftIO $ observeSourcedChunk StoragePrewarm w
-            Nothing -> do
-              chunk' <- getChunkDB'
-              for chunk' $ \(chunk, mStorage) -> chunk <$ do
-                $logDebugS "fileChunkARC" "Prewarm miss"
-                for_ mStorage $ \storage ->
-                  let w = length chunk
-                   in liftIO $ observeSourcedChunk storage w
-
-  arc <- getsYesod appFileSourceARC
-  case arc of
-    Nothing -> getChunkDB
-    Just ah -> do
-      cachedARC' ah k $ \case
-        Nothing -> do
-          chunk' <- case assertM (> l) altSize of
-            -- This optimization works for the somewhat common case that cdc chunks are smaller than db chunks and start of the requested range is aligned with a db chunk boundary
-            Just altSize'
-              -> fmap getFirst . execWriterT . cachedARC' ah (ref, (s, altSize')) $ \x -> x <$ case x of
-                   Nothing -> tellM $ First <$> getChunkDB
-                   Just (v, _) -> tell . First . Just $ ByteString.take l v
-            Nothing -> getChunkDB
-          for chunk' $ \chunk -> do
-            let w = length chunk
-            $logDebugS "fileChunkARC" "ARC miss"
-            return (chunk, w)
-        Just x@(_, w) -> do
-          $logDebugS "fileChunkARC" "ARC hit"
-          liftIO $ Just x <$ observeSourcedChunk StorageARC w
-
+                in liftIO $ observeSourcedChunk storage w


 sourceFileDB :: forall m.
@ -124,7 +99,7 @@ sourceFileChunks cont chunkHash = transPipe (withReaderT $ projectBackend @SqlRe
                      return $ E.substring (fileContentChunk E.^. FileContentChunkContent) (E.val start) (E.val dbChunksize)
                    getChunkMinio = fmap (, StorageMinio) . catchIfMaybeT (is _SourceFilesContentUnavailable) . runConduit $ sourceMinio (Left chunkHash) (Just $ ByteRangeFromTo (fromIntegral $ pred start) (fromIntegral . pred $ pred start + dbChunksize)) .| C.fold
                 in getChunkDB' <|> getChunkMinio
-          chunk <- fileChunkARC Nothing (chunkHash, (start, dbChunksize)) getChunkDB
+          chunk <- fileChunk (chunkHash, (start, dbChunksize)) getChunkDB
          case chunk of
            Just c | olength c <= 0 -> return Nothing
            Just c -> do
@ -256,7 +231,7 @@ respondFileConditional representationLastModified cType FileReference{..} = do
                                   let getChunkDB = fmap (fmap $ (, Just StorageDB) . E.unValue) . E.selectOne . E.from $ \fileContentChunk -> do
                                         E.where_ $ fileContentChunk E.^. FileContentChunkHash E.==. E.val chunkHash
                                         return $ E.substring (fileContentChunk E.^. FileContentChunkContent) (E.val start) (E.val $ min cLength' dbChunksize)
-                                   chunk <- fileChunkARC (Just $ fromIntegral dbChunksize) (chunkHash, (fromIntegral start, fromIntegral $ min cLength' dbChunksize)) getChunkDB
+                                   chunk <- fileChunk (chunkHash, (fromIntegral start, fromIntegral $ min cLength' dbChunksize)) getChunkDB
                                   case chunk of
                                     Nothing -> throwM SourceFilesContentUnavailable
                                     Just c -> do
--- a/src/Handler/Utils/Memcached.hs
+++ b/src/Handler/Utils/Memcached.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -7,10 +7,10 @@
 module Handler.Utils.Memcached
  ( memcachedAvailable
  , memcached, memcachedBy
+  , memcachedByClass, memcachedFlushClass, MemcachedKeyClass(..)
  , memcachedHere, memcachedByHere
  , memcachedSet, memcachedGet
-  , memcachedInvalidate, memcachedByInvalidate
-  , manageMemcachedLocalInvalidations
+  , memcachedInvalidate, memcachedByInvalidate, memcachedFlushAll
  , memcachedByGet, memcachedBySet
  , memcachedTimeout, memcachedTimeoutBy
  , memcachedTimeoutHere, memcachedTimeoutByHere
@ -40,13 +40,13 @@ import qualified Data.Binary.Get as Binary

 import Crypto.Hash.Algorithms (SHAKE256)

-import qualified Data.ByteArray as BA
+import qualified Data.Set as Set

-import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteArray as BA

 import Language.Haskell.TH hiding (Type)

-import Data.Typeable (typeRep, typeRepFingerprint)
+import Data.Typeable (typeRep)
 import Type.Reflection (typeOf, TypeRep)
 import qualified Type.Reflection as Refl (typeRep)
 import Data.Type.Equality (TestEquality(..))
@ -69,10 +69,6 @@ import qualified Data.ByteString.Lazy as Lazy (ByteString)

 import GHC.Fingerprint

-import Utils.Postgresql
-
-import UnliftIO.Concurrent (threadDelay)
-

 type Expiry = Either UTCTime DiffTime

@ -166,72 +162,62 @@ memcachedAAD cKey mExpiry = toStrict . Binary.runPut $ do

 memcachedByGet :: forall a k m.
                  ( MonadHandler m, HandlerSite m ~ UniWorX
-                  , Typeable a, Binary a, NFData a
+                  , Typeable a, Binary a
                  , Binary k
                  )
               => k -> m (Maybe a)
-memcachedByGet (Binary.encode -> k) = runMaybeT $ arc <|> memcache
-  where
-    arc = do
-      AppMemcachedLocal{..} <- MaybeT $ getsYesod appMemcachedLocal
-      res <- hoistMaybe . preview (_1 . _NFDynamic) <=< hoistMaybe <=< cachedARC' memcachedLocalARC (typeRepFingerprint . typeRep $ Proxy @a, k) $ \mPrev -> do
-        prev@((_, prevExpiry), _) <- hoistMaybe mPrev
-        $logDebugS "memcached" "Cache hit (local ARC)"
-        lift . runMaybeT $ do -- To delete from ARC upon expiry
-          for_ prevExpiry $ \expiry -> do
+memcachedByGet (Binary.encode -> k) = runMaybeT $ do
+    AppMemcached{..} <- MaybeT $ getsYesod appMemcached
+    let cKey = toMemcachedKey memcachedKey (Proxy @a) k
+    encVal <- fmap toStrict . hoist liftIO . catchMaybeT (Proxy @Memcached.MemcachedException) $ Memcached.get_ cKey memcachedConn
+    --  $logDebugS "memcached" "Cache hit"
+
+    let withExp doExp = do
+          MemcachedValue{..} <- hoistMaybe . flip runGetMaybe encVal $ bool getMemcachedValueNoExpiry getMemcachedValue doExp
+          $logDebugS "memcached" "Decode valid"
+          for_ mExpiry $ \expiry -> do
            now <- liftIO getPOSIXTime
-            guard $ expiry > now
-          return prev
-      $logDebugS "memcached" "All valid (local ARC)"
-      return res
-    memcache = do
-      AppMemcached{..} <- MaybeT $ getsYesod appMemcached
-      localARC <- getsYesod appMemcachedLocal
-      let cKey = toMemcachedKey memcachedKey (Proxy @a) k
+            guard $ expiry > now + clockLeniency
+          $logDebugS "memcached" $ "Expiry valid: " <> tshow mExpiry
+          let aad = memcachedAAD cKey mExpiry
+          decrypted <- hoistMaybe $ AEAD.aeadOpen memcachedKey mNonce mCiphertext aad

-      encVal <- fmap toStrict . hoist liftIO . catchMaybeT (Proxy @Memcached.MemcachedException) $ Memcached.get_ cKey memcachedConn
+          $logDebugS "memcached" $ "Decryption valid " <> bool "without" "with" doExp <> " expiration"

-      $logDebugS "memcached" "Cache hit"
+          {-
+          let withCache = fmap (view _1) . ($ Nothing)
+          res <- hoistMaybe . preview (_1 . _NFDynamic) <=< withCache $ \case
+            Nothing -> fmap ((, length decrypted) . (, mExpiry) . review (_NFDynamic @a)) . hoistMaybe $ runGetMaybe Binary.get decrypted
+            Just p -> return p
+          -}
+          hoistMaybe $ runGetMaybe Binary.get decrypted

-      let withExp doExp = do
-            MemcachedValue{..} <- hoistMaybe . flip runGetMaybe encVal $ bool getMemcachedValueNoExpiry getMemcachedValue doExp
-            $logDebugS "memcached" "Decode valid"
-            for_ mExpiry $ \expiry -> do
-              now <- liftIO getPOSIXTime
-              guard $ expiry > now + clockLeniency
-            $logDebugS "memcached" $ "Expiry valid: " <> tshow mExpiry
-            let aad = memcachedAAD cKey mExpiry
-            decrypted <- hoistMaybe $ AEAD.aeadOpen memcachedKey mNonce mCiphertext aad
+    withExp True <|> withExp False
+  where
+    runGetMaybe p (fromStrict -> bs) = case Binary.runGetOrFail p bs of
+      Right (bs', _, x) | null bs' -> Just x
+      _other -> Nothing

-            $logDebugS "memcached" $ "Decryption valid " <> bool "without" "with" doExp <> " expiration"
-      
-            let withCache = case localARC of
-                  Just AppMemcachedLocal{..} -> cachedARC memcachedLocalARC (typeRepFingerprint . typeRep $ Proxy @a, k)
-                  Nothing -> fmap (view _1) . ($ Nothing)
-            res <- hoistMaybe . preview (_1 . _NFDynamic) <=< withCache $ \case
-              Nothing -> fmap ((, length decrypted) . (, mExpiry) . review (_NFDynamic @a)) . hoistMaybe $ runGetMaybe Binary.get decrypted
-              Just p -> return p
-
-            $logDebugS "memcached" "All valid"
-
-            return res
-
-      withExp True <|> withExp False
-      where
-        runGetMaybe p (fromStrict -> bs) = case Binary.runGetOrFail p bs of
-          Right (bs', _, x) | null bs' -> Just x
-          _other -> Nothing
-        clockLeniency :: NominalDiffTime
-        clockLeniency = 2
+    clockLeniency :: NominalDiffTime
+    clockLeniency = 2

 memcachedBySet :: forall a k m.
                  ( MonadHandler m, HandlerSite m ~ UniWorX
                  , MonadThrow m
-                  , Typeable a, Binary a, NFData a
+                  , Typeable a, Binary a
                  , Binary k
                  )
               => Maybe Expiry -> k -> a -> m ()
-memcachedBySet mExp (Binary.encode -> k) v = do
+memcachedBySet = ((void .) .) . memcachedBySet'
+
+memcachedBySet' :: forall a k m.
+                  ( MonadHandler m, HandlerSite m ~ UniWorX
+                  , MonadThrow m
+                  , Typeable a, Binary a
+                  , Binary k
+                  )
+               => Maybe Expiry -> k -> a -> m (Maybe ByteString)
+memcachedBySet' mExp (Binary.encode -> k) v = do
  mExp' <- for mExp $ \exp -> maybe (throwM $ MemcachedInvalidExpiry exp) return $ exp ^? _MemcachedExpiry

  let decrypted = toStrict $ Binary.encode v
@ -240,23 +226,14 @@ memcachedBySet mExp (Binary.encode -> k) v = do
    Right diff -> liftIO $ (+ realToFrac diff) <$> getPOSIXTime

  mConn <- getsYesod appMemcached
-  for_ mConn $ \AppMemcached{..} -> do
+  for mConn $ \AppMemcached{..} -> do
    mNonce <- liftIO AEAD.newNonce
    let cKey = toMemcachedKey memcachedKey (Proxy @a) k
        aad = memcachedAAD cKey mExpiry
        mCiphertext = AEAD.aead memcachedKey mNonce decrypted aad
    liftIO . handle (\(_ :: Memcached.MemcachedException) -> return ()) $ Memcached.set zeroBits (fromMaybe zeroBits mExp') cKey (Binary.runPut $ putMemcachedValue MemcachedValue{..}) memcachedConn
    $logDebugS "memcached" $ "Cache store: " <> tshow mExpiry
-
-  mLocal <- getsYesod appMemcachedLocal
-  for_ mLocal $ \AppMemcachedLocal{..} -> do
-    void . cachedARC memcachedLocalARC (typeRepFingerprint . typeRep $ Proxy @a, k) . const $ return ((_NFDynamic # v, mExpiry), length decrypted)
-    $logDebugS "memcached" $ "Cache store: " <> tshow mExpiry <> " (local ARC)"
-    -- DEBUG
-    let inv = Base64.encode . toStrict $ Binary.encode MemcachedLocalInvalidateMsg{..}
-          where mLocalInvalidateType = typeRepFingerprint . typeRep $ Proxy @a
-                mLocalInvalidateKey = k
-    $logDebugS "memcached" $ "To invalidate remotely: " <> tshow inv
+    return cKey

 memcachedByInvalidate :: forall a k m p.
                         ( MonadHandler m, HandlerSite m ~ UniWorX
@ -264,19 +241,11 @@ memcachedByInvalidate :: forall a k m p.
                         , Binary k
                         )
                      => k -> p a -> m ()
-memcachedByInvalidate (Binary.encode -> k) _ = arc >> memcache
-  where
-    memcache = maybeT_ $ do
-      AppMemcached{..} <- MaybeT $ getsYesod appMemcached
-      let cKey = toMemcachedKey memcachedKey (Proxy @a) k
-      hoist liftIO . catchIfMaybeT Memcached.isKeyNotFound $ Memcached.delete cKey memcachedConn
-      $logDebugS "memcached" "Cache invalidation"
-    arc = maybeT_ $ do
-      AppMemcachedLocal{..} <- MaybeT $ getsYesod appMemcachedLocal
-      let arcKey = (typeRepFingerprint . typeRep $ Proxy @a, k)
-      atomically $ modifyTVar' memcachedLocalInvalidationQueue (:> arcKey)
-      void . cachedARC' memcachedLocalARC arcKey . const $ return Nothing
-      $logDebugS "memcached" "Cache invalidation (local ARC)"
+memcachedByInvalidate (Binary.encode -> k) _ = maybeT_ $ do
+  AppMemcached{..} <- MaybeT $ getsYesod appMemcached
+  let cKey = toMemcachedKey memcachedKey (Proxy @a) k
+  hoist liftIO . catchIfMaybeT Memcached.isKeyNotFound $ Memcached.delete cKey memcachedConn
+  $logDebugS "memcached" "Cache invalidation"

 data MemcachedLocalInvalidateMsg = MemcachedLocalInvalidateMsg
  { mLocalInvalidateType :: Fingerprint
@ -293,7 +262,8 @@ instance Binary MemcachedLocalInvalidateMsg where
    Binary.putWord64le w1
    Binary.putWord64le w2
    Binary.putLazyByteString mLocalInvalidateKey
-  
+
+{-
 manageMemcachedLocalInvalidations :: ( MonadUnliftIO m
                                     , MonadLogger m
                                     )
@ -316,22 +286,22 @@ manageMemcachedLocalInvalidations localARC iQueue = PostgresqlChannelManager
      let (mLocalInvalidateType, mLocalInvalidateKey) = i
      return . Base64.encode . toStrict $ Binary.encode MemcachedLocalInvalidateMsg{..}
  }
+-}

-
-newtype MemcachedUnkeyed a = MemcachedUnkeyed { unMemcachedUnkeyed :: a }  
+newtype MemcachedUnkeyed a = MemcachedUnkeyed { unMemcachedUnkeyed :: a }
  deriving newtype (Eq, Ord, Show, Binary)
 instance NFData a => NFData (MemcachedUnkeyed a) where
  rnf = rnf . unMemcachedUnkeyed

 memcachedGet :: ( MonadHandler m, HandlerSite m ~ UniWorX
-                , Typeable a, Binary a, NFData a
+                , Typeable a, Binary a
                )
             => m (Maybe a)
 memcachedGet = fmap unMemcachedUnkeyed <$> memcachedByGet ()

 memcachedSet :: ( MonadHandler m, HandlerSite m ~ UniWorX
                , MonadThrow m
-                , Typeable a, Binary a, NFData a
+                , Typeable a, Binary a
                )
             => Maybe Expiry -> a -> m ()
 memcachedSet mExp = memcachedBySet mExp () . MemcachedUnkeyed
@ -343,18 +313,16 @@ memcachedInvalidate :: forall (a :: Type) m p.
                    => p a -> m ()
 memcachedInvalidate _ = memcachedByInvalidate () $ Proxy @(MemcachedUnkeyed a)

+memcachedFlushAll :: (MonadHandler m, HandlerSite m ~ UniWorX) => m ()
+memcachedFlushAll = getsYesod appMemcached >>= flip whenIsJust (liftIO . Memcached.flushAll . memcachedConn)

 memcachedWith :: Monad m
              => (m (Maybe b), a -> m b) -> m a -> m b
-memcachedWith (doGet, doSet) act = do
-  pRes <- doGet
-  maybe id (const . return) pRes $ do
-    res <- act
-    doSet res
+memcachedWith (doGet, doSet) act = maybeM (act >>= doSet) pure doGet

 memcached :: ( MonadHandler m, HandlerSite m ~ UniWorX
             , MonadThrow m
-             , Typeable a, Binary a, NFData a
+             , Typeable a, Binary a
             )
          => Maybe Expiry -> m a -> m a
 memcached mExp = memcachedWith (memcachedGet, \x -> x <$ memcachedSet mExp x)
@ -362,14 +330,49 @@ memcached mExp = memcachedWith (memcachedGet, \x -> x <$ memcachedSet mExp x)
 memcachedBy :: forall a m k.
               ( MonadHandler m, HandlerSite m ~ UniWorX
               , MonadThrow m
-               , Typeable a, Binary a, NFData a
+               , Typeable a, Binary a
               , Binary k
               )
            => Maybe Expiry -> k -> m a -> m a
 memcachedBy mExp k = memcachedWith (memcachedByGet k, \x -> x <$ memcachedBySet mExp k x)


-newtype MemcachedUnkeyedLoc a = MemcachedUnkeyedLoc { unMemcachedUnkeyedLoc :: a }  
+data MemcachedKeyClass
+    = MemcachedKeyClassTutorialOccurrences
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, NFData)
+  deriving anyclass (Hashable, Binary, Universe, Finite)
+
+newtype MemcachedKeyClassStore = MemcachedKeyClassStore{ unMemcachedKeyClassStore :: Set ByteString }
+  deriving newtype (Eq, Ord, Semigroup, Monoid, Show, Binary, NFData)
+-- instance NFData MemcachedKeyClassStore where
+--   rnf MemcachedKeyClassStore{..} = rnf unMemcachedKeyClassStore
+
+memcachedByClass :: forall a m k.
+               ( MonadHandler m, HandlerSite m ~ UniWorX
+               , MonadThrow m
+               , Typeable a, Binary a
+               , Binary k
+               )
+            => MemcachedKeyClass -> Maybe Expiry -> k -> m a -> m a
+memcachedByClass mkc mExp k = memcachedWith (memcachedByGet k, setAndAddClass)
+  where
+    setAndAddClass v = do
+      mbKey <- memcachedBySet' mExp k v
+      whenIsJust mbKey $ \vKey -> do
+        cl <- maybeMonoid <$> memcachedByGet mkc
+        memcachedBySet Nothing mkc $ MemcachedKeyClassStore $ Set.insert vKey $ unMemcachedKeyClassStore cl
+        -- memcachedBySet Nothing mkc $ cl <> MemcachedKeyClassStore $ Set.singleton vKey
+      return v
+
+memcachedFlushClass :: (MonadHandler m, HandlerSite m ~ UniWorX) => MemcachedKeyClass -> m ()
+memcachedFlushClass mkc = maybeT_ $ do
+  AppMemcached{..} <- MaybeT $ getsYesod appMemcached
+  cl <- MaybeT $ memcachedByGet mkc
+  hoist liftIO $ forM_ (unMemcachedKeyClassStore cl) $
+    catchIfMaybeT Memcached.isKeyNotFound . flip Memcached.delete memcachedConn
+  lift $ memcachedByInvalidate mkc (Proxy @MemcachedKeyClassStore)
+
+newtype MemcachedUnkeyedLoc a = MemcachedUnkeyedLoc { unMemcachedUnkeyedLoc :: a }
  deriving newtype (Eq, Ord, Show, Binary)
 instance NFData a => NFData (MemcachedUnkeyedLoc a) where
  rnf MemcachedUnkeyedLoc{..} = rnf unMemcachedUnkeyedLoc
@ -379,7 +382,7 @@ memcachedHere = do
  loc <- location
  [e| \mExp -> fmap unMemcachedUnkeyedLoc . memcachedBy mExp loc . fmap MemcachedUnkeyedLoc |]

-newtype MemcachedKeyedLoc a = MemcachedKeyedLoc { unMemcachedKeyedLoc :: a }  
+newtype MemcachedKeyedLoc a = MemcachedKeyedLoc { unMemcachedKeyedLoc :: a }
  deriving newtype (Eq, Ord, Show, Binary)
 instance NFData a => NFData (MemcachedKeyedLoc a) where
  rnf MemcachedKeyedLoc{..} = rnf unMemcachedKeyedLoc
@ -453,7 +456,7 @@ memcachedLimitedWith (doGet, doSet) liftAct (hashableDynamic -> lK) burst rate t
 memcachedLimited :: forall a m.
                    ( MonadHandler m, HandlerSite m ~ UniWorX
                    , MonadThrow m
-                    , Typeable a, Binary a, NFData a
+                    , Typeable a, Binary a
                    )
                 => Word64 -- ^ burst-size (tokens)
                 -> Word64 -- ^ avg. inverse rate (usec/token)
@ -466,7 +469,7 @@ memcachedLimited burst rate tokens mExp = memcachedLimitedWith (memcachedGet, me
 memcachedLimitedKey :: forall a k' m.
                       ( MonadHandler m, HandlerSite m ~ UniWorX
                       , MonadThrow m
-                       , Typeable a, Binary a, NFData a
+                       , Typeable a, Binary a
                       , Typeable k', Hashable k', Eq k'
                       )
                    => k'
@ -481,7 +484,7 @@ memcachedLimitedKey lK burst rate tokens mExp = memcachedLimitedWith (memcachedG
 memcachedLimitedBy :: forall a k m.
                     ( MonadHandler m, HandlerSite m ~ UniWorX
                      , MonadThrow m
-                      , Typeable a, Binary a, NFData a
+                      , Typeable a, Binary a
                      , Binary k
                      )
                   => Word64 -- ^ burst-size (tokens)
@ -496,7 +499,7 @@ memcachedLimitedBy burst rate tokens mExp k = memcachedLimitedWith (memcachedByG
 memcachedLimitedKeyBy :: forall a k' k m.
                         ( MonadHandler m, HandlerSite m ~ UniWorX
                         , MonadThrow m
-                         , Typeable a, Binary a, NFData a
+                         , Typeable a, Binary a
                         , Typeable k', Hashable k', Eq k'
                         , Binary k
                         )
@ -534,7 +537,7 @@ memcachedLimitedKeyByHere = do
 memcacheAuth :: forall m k a.
                ( MonadHandler m, HandlerSite m ~ UniWorX
                , MonadThrow m
-                , Typeable a, Binary a, NFData a
+                , Typeable a, Binary a
                , Binary k
                )
             => k
@ -555,7 +558,7 @@ memcacheAuth k mx = cachedByBinary k $ do
 memcacheAuth' :: forall a m k.
                 ( MonadHandler m, HandlerSite m ~ UniWorX
                 , MonadThrow m
-                 , Typeable a, Binary a, NFData a
+                 , Typeable a, Binary a
                 , Binary k
                 )
              => Expiry
@ -563,11 +566,11 @@ memcacheAuth' :: forall a m k.
              -> m a
              -> m a
 memcacheAuth' exp k = memcacheAuth k . (<* tell (Just $ Min exp)) . lift
-  
+
 memcacheAuthMax :: forall m k a.
                   ( MonadHandler m, HandlerSite m ~ UniWorX
                   , MonadThrow m
-                   , Typeable a, Binary a, NFData a
+                   , Typeable a, Binary a
                   , Binary k
                   )
                => Expiry
@ -585,7 +588,7 @@ memcacheAuthHere' :: Q Exp
 memcacheAuthHere' = do
  loc <- location
  [e| \exp k -> withMemcachedKeyedLoc (memcacheAuth' exp (loc, k)) |]
-  
+
 memcacheAuthHereMax :: Q Exp
 memcacheAuthHereMax = do
  loc <- location
@ -681,7 +684,7 @@ memcachedTimeout :: ( MonadHandler m, HandlerSite m ~ UniWorX
                    , MonadThrow m
                    , MonadUnliftIO m
                    , Typeable k'', Hashable k'', Eq k''
-                    , Typeable a, Binary a, NFData a
+                    , Typeable a, Binary a
                    )
                 => Maybe Expiry -> DiffTime -> k'' -> m a -> m (Maybe a)
 memcachedTimeout mExp = memcachedTimeoutWith (memcachedGet, memcachedSet mExp)
@ -690,7 +693,7 @@ memcachedTimeoutBy :: ( MonadHandler m, HandlerSite m ~ UniWorX
                      , MonadThrow m
                      , MonadUnliftIO m
                      , Typeable k'', Hashable k'', Eq k''
-                      , Typeable a, Binary a, NFData a
+                      , Typeable a, Binary a
                      , Binary k
                      )
                   => Maybe Expiry -> DiffTime -> k'' -> k -> m a -> m (Maybe a)
@ -711,7 +714,7 @@ memcachedLimitedTimeout :: forall a k'' m.
                           , MonadThrow m
                           , MonadUnliftIO m
                           , Typeable k'', Hashable k'', Eq k''
-                           , Typeable a, Binary a, NFData a
+                           , Typeable a, Binary a
                           )
                        => Word64 -- ^ burst-size (tokens)
                        -> Word64 -- ^ avg. inverse rate (usec/token)
@ -728,7 +731,7 @@ memcachedLimitedKeyTimeout :: forall a k' k'' m.
                              , MonadThrow m
                              , MonadUnliftIO m
                              , Typeable k'', Hashable k'', Eq k''
-                              , Typeable a, Binary a, NFData a
+                              , Typeable a, Binary a
                              , Typeable k', Hashable k', Eq k'
                              )
                           => k'
@ -747,7 +750,7 @@ memcachedLimitedTimeoutBy :: forall a k'' k m.
                             , MonadThrow m
                             , MonadUnliftIO m
                             , Typeable k'', Hashable k'', Eq k''
-                             , Typeable a, Binary a, NFData a
+                             , Typeable a, Binary a
                             , Binary k
                             )
                          => Word64 -- ^ burst-size (tokens)
@ -766,7 +769,7 @@ memcachedLimitedKeyTimeoutBy :: forall a k' k'' k m.
                                , MonadThrow m
                                , MonadUnliftIO m
                                , Typeable k'', Hashable k'', Eq k''
-                                , Typeable a, Binary a, NFData a
+                                , Typeable a, Binary a
                                , Typeable k', Hashable k', Eq k'
                                , Binary k
                                )
--- a/src/Handler/Utils/Occurrences.hs
+++ b/src/Handler/Utils/Occurrences.hs
@ -4,6 +4,7 @@

 module Handler.Utils.Occurrences
  ( occurrencesWidget
+  , occurrencesCompute
  , occurrencesBounds
  , occurrencesAddBusinessDays
  ) where
@ -35,12 +36,10 @@ occurrencesWidget (normalizeOccurrences . unJSONB -> Occurrences{..}) = do
          $(widgetFile "widgets/occurrence/cell/except-no-occur")
  $(widgetFile "widgets/occurrence/cell")

-- | Get bounds for an Occurrences
-occurrencesBounds :: Term -> Occurrences -> (Maybe Day, Maybe Day)
-occurrencesBounds Term{..} Occurrences{..} = (Set.lookupMin occDays, Set.lookupMax occDays)
+-- | Get all occurrences during a term, excluding term holidays from the regular schedule, but not from exceptins
+occurrencesCompute :: Term -> Occurrences -> Set Day
+occurrencesCompute Term{..} Occurrences{..} = ((scdDays \\ Set.fromList termHolidays) <> plsDays) \\ excDays
  where
-    occDays = (scdDays <> plsDays) \\ excDays -- (excDays <> termHolidays term) -- TODO: should holidays be exluded here? Probably not, as they can be added as exceptions already
-
    scdDays = Set.foldr getOccDays mempty occurrencesScheduled
    (plsDays,excDays) = Set.foldr getExcDays mempty occurrencesExceptions

@ -51,6 +50,10 @@ occurrencesBounds Term{..} Occurrences{..} = (Set.lookupMin occDays, Set.lookupM
    getOccDays :: OccurrenceSchedule -> Set Day -> Set Day
    getOccDays ScheduleWeekly{scheduleDayOfWeek=wday} = Set.union $ daysOfWeekBetween (termLectureStart,termLectureEnd) wday

+-- | Get bounds for an Occurrences
+occurrencesBounds :: Term -> Occurrences -> (Maybe Day, Maybe Day)
+occurrencesBounds = (liftM2 (,) Set.lookupMin Set.lookupMax .) . occurrencesCompute
+
 occurrencesAddBusinessDays :: Term -> (Day,Day) -> Occurrences -> Occurrences
 occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrences newSchedule newExceptions
  where
--- a/src/Settings.hs
+++ b/src/Settings.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -207,7 +207,6 @@ data AppSettings = AppSettings

    , appMemcachedConf          :: Maybe MemcachedConf
    , appMemcacheAuth           :: Bool
-    , appMemcachedLocalConf     :: Maybe (ARCConf Int)

    , appUploadCacheConf        :: Maybe Minio.ConnectInfo
    , appUploadCacheBucket, appUploadTmpBucket :: Minio.Bucket
@ -688,7 +687,6 @@ instance FromJSON AppSettings where

        appMemcachedConf          <- assertM validMemcachedConf <$> o .:? "memcached"
        appMemcacheAuth           <- o .:? "memcache-auth" .!= False
-        appMemcachedLocalConf     <- assertM isValidARCConf <$> o .:? "memcached-local"

        appMailFrom               <- o .: "mail-from"
        appMailEnvelopeFrom       <- o .:? "mail-envelope-from" .!= addressEmail appMailFrom
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -44,7 +44,6 @@ import Utils.I18n as Utils
 import Utils.NTop as Utils
 import Utils.HttpConditional as Utils
 import Utils.Persist as Utils
-import Utils.ARC as Utils
 import Utils.LRU as Utils
 import Utils.Set as Utils

@ -655,7 +654,7 @@ guardMonoid True  x = x
 assertMonoid :: Monoid m => (m -> Bool) -> m -> m
 assertMonoid f x = guardMonoid (f x) x

-- fold would also do, but is more risky if the Folable isn't Maybe
+-- fold would also do, but is more risky if the Foldable isn't Maybe
 maybeMonoid :: Monoid m => Maybe m -> m
 -- ^ Identify `Nothing` with `mempty`
 maybeMonoid = fromMaybe mempty
--- a/src/Utils/ARC.hs
+++ b/src/Utils/ARC.hs
@ -1,344 +0,0 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
-
-{-# LANGUAGE BangPatterns #-}
-
-module Utils.ARC
-  ( ARCTick
-  , ARC, initARC
-  , arcAlterF, lookupARC, insertARC
-  , ARCHandle, initARCHandle, cachedARC, cachedARC'
-  , lookupARCHandle
-  , readARCHandle
-  , arcRecentSize, arcFrequentSize, arcGhostRecentSize, arcGhostFrequentSize
-  , getARCRecentWeight, getARCFrequentWeight
-  , describeARC
-  , NFDynamic(..), _NFDynamic, DynARC, DynARCHandle
-  ) where
-
-import ClassyPrelude
-
-import Data.HashPSQ (HashPSQ)
-import qualified Data.HashPSQ as HashPSQ
-
-import Control.Lens
-
-import Type.Reflection
-import Text.Show (showString, shows)
-
-import Data.Hashable (Hashed, hashed)
-
-- https://web.archive.org/web/20210115184012/https://dbs.uni-leipzig.de/file/ARC.pdf
-- https://jaspervdj.be/posts/2015-02-24-lru-cache.html
-
-
-data NFDynamic where
-  NFDynamic :: forall a. NFData a => TypeRep a -> a -> NFDynamic
-
-_NFDynamic :: forall a. (Typeable a, NFData a) => Prism' NFDynamic a
-_NFDynamic = prism' toNFDyn fromNFDynamic
-  where
-    toNFDyn v = NFDynamic typeRep v
-    fromNFDynamic (NFDynamic t v)
-      | Just HRefl <- t `eqTypeRep` rep = Just v
-      | otherwise                       = Nothing
-      where rep = typeRep :: TypeRep a
-
-instance NFData NFDynamic where
-  rnf (NFDynamic t v) = rnfTypeRep t `seq` rnf v
-
-instance Show NFDynamic where
-  showsPrec _ (NFDynamic t _) = showString "<<" . shows t . showString ">>"
-
-
-newtype ARCTick = ARCTick { _getARCTick :: Word64 }
-  deriving (Eq, Ord, Show)
-  deriving newtype (NFData)
-
-makeLenses ''ARCTick
-
-data ARC k w v = ARC
-  { arcRecent, arcFrequent :: !(HashPSQ (Hashed k) ARCTick (v, w))
-  , arcGhostRecent, arcGhostFrequent :: !(HashPSQ (Hashed k) ARCTick ())
-  , arcRecentWeight, arcFrequentWeight :: !w
-  , arcTargetRecent, arcMaximumWeight :: !w
-  , arcMaximumGhost :: !Int
-  }
-
-type DynARC k w = ARC (SomeTypeRep, k) w NFDynamic
-
-instance (NFData k, NFData w, NFData v) => NFData (ARC k w v) where
-  rnf ARC{..} = rnf arcRecent
-          `seq` rnf arcFrequent
-          `seq` rnf arcGhostRecent
-          `seq` rnf arcGhostFrequent
-          `seq` rnf arcRecentWeight
-          `seq` rnf arcFrequentWeight
-          `seq` rnf arcTargetRecent
-          `seq` rnf arcMaximumWeight
-          `seq` rnf arcMaximumGhost
-
-describeARC :: Show w
-            => ARC k w v
-            -> String
-describeARC ARC{..} = intercalate ", "
-  [ "arcRecent: "         <> show (HashPSQ.size arcRecent)
-  , "arcFrequent: "       <> show (HashPSQ.size arcFrequent)
-  , "arcGhostRecent: "    <> show (HashPSQ.size arcGhostRecent)
-  , "arcGhostFrequent: "  <> show (HashPSQ.size arcGhostFrequent)
-  , "arcRecentWeight: "   <> show arcRecentWeight
-  , "arcFrequentWeight: " <> show arcFrequentWeight
-  , "arcTargetRecent: "   <> show arcTargetRecent
-  , "arcMaximumWeight: "  <> show arcMaximumWeight
-  , "arcMaximumGhost: "   <> show arcMaximumGhost
-  ]
-
-arcRecentSize, arcFrequentSize, arcGhostRecentSize, arcGhostFrequentSize :: ARC k w v -> Int
-arcRecentSize = HashPSQ.size . arcRecent
-arcFrequentSize = HashPSQ.size . arcFrequent
-arcGhostRecentSize = HashPSQ.size . arcGhostRecent
-arcGhostFrequentSize = HashPSQ.size . arcGhostFrequent
-
-getARCRecentWeight, getARCFrequentWeight :: ARC k w v -> w
-getARCRecentWeight = arcRecentWeight
-getARCFrequentWeight = arcFrequentWeight
-
-initialARCTick :: ARCTick
-initialARCTick = ARCTick 0
-
-initARC :: forall k w v.
-           Integral w
-        => Int -- ^ @arcMaximumGhost@
-        -> w -- ^ @arcMaximumWeight@
-        -> (ARC k w v, ARCTick)
-initARC arcMaximumGhost arcMaximumWeight
-  | arcMaximumWeight < 0 = error "initARC given negative maximum weight"
-  | arcMaximumGhost < 0 = error "initARC given negative maximum ghost size"
-  | otherwise = (, initialARCTick) ARC
-    { arcRecent = HashPSQ.empty
-    , arcFrequent = HashPSQ.empty
-    , arcGhostRecent = HashPSQ.empty
-    , arcGhostFrequent = HashPSQ.empty
-    , arcRecentWeight = 0
-    , arcFrequentWeight = 0
-    , arcMaximumWeight
-    , arcTargetRecent = 0
-    , arcMaximumGhost
-    }
-
-
-infixl 6 |-
-(|-) :: (Num a, Ord a) => a -> a -> a
-(|-) m s
-  | s >= m = 0
-  | otherwise = m - s
-
-  
-arcAlterF :: forall f k w v.
-             ( Ord k, Hashable k
-             , Functor f
-             , Integral w
-             , NFData k, NFData w, NFData v
-             )
-          => k
-          -> (Maybe (v, w) -> f (Maybe (v, w)))
-          -> ARC k w v
-          -> ARCTick -> f (ARC k w v, ARCTick)
-- | Unchecked precondition: item weights are always less than `arcMaximumWeight`
-arcAlterF !(force -> unhashedK@(hashed -> k)) f oldARC@ARC{..} now
-  | later <= initialARCTick = uncurry (arcAlterF unhashedK f) $ initARC arcMaximumGhost arcMaximumWeight
-  | otherwise = (, later) <$> if
-    | Just (_p, x@(_, w), arcFrequent') <- HashPSQ.deleteView k arcFrequent
-      -> f (Just x) <&> \case
-           Nothing -> oldARC
-             { arcFrequent = arcFrequent'
-             , arcGhostFrequent = HashPSQ.insert k now () arcGhostFrequent
-             , arcFrequentWeight = arcFrequentWeight - w
-             }
-           Just !(force -> x'@(_, w'))
-             -> let (arcFrequent'', arcFrequentWeight'', arcGhostFrequent') = evictToSize (arcMaximumWeight |- arcTargetRecent |- w') arcFrequent' (arcFrequentWeight - w) arcGhostFrequent
-                 in oldARC
-                      { arcFrequent = HashPSQ.insert k now x' arcFrequent''
-                      , arcFrequentWeight = arcFrequentWeight'' + w'
-                      , arcGhostFrequent = arcGhostFrequent'
-                      }
-    | Just (_p, x@(_, w), arcRecent') <- HashPSQ.deleteView k arcRecent
-      -> f (Just x) <&> \case
-           Nothing -> oldARC
-             { arcRecent = arcRecent'
-             , arcGhostRecent = HashPSQ.insert k now () $ evictGhostToCount arcGhostRecent
-             , arcRecentWeight = arcRecentWeight - w
-             }
-           Just !(force -> x'@(_, w'))
-             -> let (arcFrequent', arcFrequentWeight', arcGhostFrequent') = evictToSize (arcMaximumWeight |- arcTargetRecent |- w') arcFrequent arcFrequentWeight arcGhostFrequent
-                 in oldARC
-                      { arcRecent = arcRecent'
-                      , arcRecentWeight = arcRecentWeight - w
-                      , arcFrequent = HashPSQ.insert k now x' arcFrequent'
-                      , arcFrequentWeight = arcFrequentWeight' + w'
-                      , arcGhostFrequent = arcGhostFrequent'
-                      }
-    | Just (_p, (), arcGhostRecent') <- HashPSQ.deleteView k arcGhostRecent
-      -> f Nothing <&> \case
-           Nothing -> oldARC
-             { arcGhostRecent = HashPSQ.insert k now () arcGhostRecent'
-             }
-           Just !(force -> x@(_, w))
-             -> let arcTargetRecent' = min arcMaximumWeight $ arcTargetRecent + max avgWeight (round $ toRational (HashPSQ.size arcGhostFrequent) / toRational (HashPSQ.size arcGhostRecent) * toRational avgWeight)
-                    (arcFrequent', arcFrequentWeight', arcGhostFrequent') = evictToSize (arcMaximumWeight |- arcTargetRecent' |- w) arcFrequent arcFrequentWeight arcGhostFrequent
-                    (arcRecent', arcRecentWeight', arcGhostRecent'') = evictToSize (max arcTargetRecent' $ arcMaximumWeight |- arcFrequentWeight' |- w) arcRecent arcRecentWeight arcGhostRecent'
-                 in oldARC
-                      { arcRecent = arcRecent'
-                      , arcFrequent = HashPSQ.insert k now x arcFrequent'
-                      , arcGhostRecent = arcGhostRecent''
-                      , arcGhostFrequent = arcGhostFrequent'
-                      , arcRecentWeight = arcRecentWeight'
-                      , arcFrequentWeight = arcFrequentWeight' + w
-                      , arcTargetRecent = arcTargetRecent'
-                      }
-    | Just (_p, (), arcGhostFrequent') <- HashPSQ.deleteView k arcGhostFrequent
-      -> f Nothing <&> \case
-           Nothing -> oldARC
-             { arcGhostFrequent = HashPSQ.insert k now () arcGhostFrequent'
-             }
-           Just !(force -> x@(_, w))
-             -> let arcTargetRecent' = arcTargetRecent |- max avgWeight (round $ toRational (HashPSQ.size arcGhostRecent) / toRational (HashPSQ.size arcGhostFrequent) * toRational avgWeight)
-                    (arcFrequent', arcFrequentWeight', arcGhostFrequent'') = evictToSize (arcMaximumWeight |- arcTargetRecent' |- w) arcFrequent arcFrequentWeight arcGhostFrequent'
-                    (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent' $ arcMaximumWeight |- arcFrequentWeight' |- w) arcRecent arcRecentWeight arcGhostRecent
-                 in oldARC
-                      { arcRecent = arcRecent'
-                      , arcFrequent = HashPSQ.insert k now x arcFrequent'
-                      , arcGhostRecent = arcGhostRecent'
-                      , arcGhostFrequent = arcGhostFrequent''
-                      , arcRecentWeight = arcRecentWeight'
-                      , arcFrequentWeight = arcFrequentWeight' + w
-                      , arcTargetRecent = arcTargetRecent'
-                      }
-    | otherwise -> f Nothing <&> \case
-        Nothing -> oldARC
-          { arcGhostRecent = HashPSQ.insert k now () $ evictGhostToCount arcGhostRecent
-          }
-        Just !(force -> x@(_, w))
-          -> let (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent (arcMaximumWeight |- arcFrequentWeight) |- w) arcRecent arcRecentWeight arcGhostRecent
-              in oldARC
-                   { arcRecent = HashPSQ.insert k now x arcRecent'
-                   , arcRecentWeight = arcRecentWeight' + w
-                   , arcGhostRecent = arcGhostRecent'
-                   }
-  where
-    avgWeight = round $ toRational (arcRecentWeight + arcFrequentWeight) / toRational (HashPSQ.size arcFrequent + HashPSQ.size arcRecent)
-    
-    later :: ARCTick
-    later = over getARCTick succ now
-    
-    evictToSize :: w -> HashPSQ (Hashed k) ARCTick (v, w) -> w -> HashPSQ (Hashed k) ARCTick () -> (HashPSQ (Hashed k) ARCTick (v, w), w, HashPSQ (Hashed k) ARCTick ())
-    evictToSize tSize c cSize ghostC
-      | cSize <= tSize = (c, cSize, ghostC)
-      | Just (k', p', (_, w'), c') <- HashPSQ.minView c = evictToSize tSize c' (cSize - w') . evictGhostToCount $ HashPSQ.insert k' p' () ghostC
-      | otherwise = error "evictToSize: cannot reach required size through eviction"
-
-    evictGhostToCount :: HashPSQ (Hashed k) ARCTick () -> HashPSQ (Hashed k) ARCTick ()
-    evictGhostToCount c
-      | HashPSQ.size c <= arcMaximumGhost = c
-      | Just (_, _, _, c') <- HashPSQ.minView c = evictGhostToCount c'
-      | otherwise = error "evictGhostToCount: cannot reach required count through eviction"
-
-lookupARC :: forall k w v.
-             ( Ord k, Hashable k
-             , Integral w
-             , NFData k, NFData w, NFData v
-             )
-          => k
-          -> (ARC k w v, ARCTick)
-          -> Maybe (v, w)
-lookupARC k = getConst . uncurry (arcAlterF k Const)
-
-insertARC :: forall k w v.
-             ( Ord k, Hashable k
-             , Integral w
-             , NFData k, NFData w, NFData v
-             )
-          => k
-          -> Maybe (v, w)
-          -> ARC k w v
-          -> ARCTick -> (ARC k w v, ARCTick)
-insertARC k newVal = (runIdentity .) . arcAlterF k (const $ pure newVal)
-
-
-newtype ARCHandle k w v = ARCHandle { _getARCHandle :: IORef (ARC k w v, ARCTick) }
-  deriving (Eq)
-
-type DynARCHandle k w = ARCHandle (SomeTypeRep, k) w NFDynamic
-
-initARCHandle :: forall k w v m.
-                 ( MonadIO m
-                 , Integral w
-                 )
-              => Int -- ^ @arcMaximumGhost@
-              -> w -- ^ @arcMaximumWeight@
-              -> m (ARCHandle k w v)
-initARCHandle maxGhost maxWeight = fmap ARCHandle . newIORef $ initARC maxGhost maxWeight
-
-cachedARC' :: forall k w v m.
-              ( MonadIO m
-              , Ord k, Hashable k
-              , Integral w
-              , NFData k, NFData w, NFData v
-              )
-           => ARCHandle k w v
-           -> k
-           -> (Maybe (v, w) -> m (Maybe (v, w)))
-           -> m (Maybe v)
-cachedARC' (ARCHandle arcVar) k f = do
-  oldVal <- lookupARC k <$> readIORef arcVar
-  newVal <- f oldVal
-  atomicModifyIORef' arcVar $ (, ()) . uncurry (insertARC k newVal)
-  -- Using `modifyIORef'` instead of `atomicModifyIORef'` might very
-  -- well drop newer values computed during the update.
-  --
-  -- This was deemed unacceptable due to the risk of cache
-  -- invalidations being silently dropped
-  --
-  -- Another alternative would be to use "optimistic locking",
-  -- i.e. read the current value of `arcVar`, compute an updated
-  -- version, and write it back atomically iff the `ARCTick` hasn't
-  -- changed.
-  --
-  -- This was not implemented in the hopes that atomicModifyIORef'
-  -- already offers sufficient performance.
-  --
-  -- If optimistic locking is implemented there is a risk of
-  -- performance issues due to the overhead and contention likely
-  -- associated with the atomic transaction required for the "compare
-  -- and swap"
-  return $ view _1 <$> newVal
-
-cachedARC :: forall k w v m.
-             ( MonadIO m
-             , Ord k, Hashable k
-             , Integral w
-             , NFData k, NFData w, NFData v
-             )
-          => ARCHandle k w v
-          -> k
-          -> (Maybe (v, w) -> m (v, w))
-          -> m v
-cachedARC h k f = fromMaybe (error "cachedARC: cachedARC' returned Nothing") <$> cachedARC' h k (fmap Just . f)
-  
-lookupARCHandle :: forall k w v m.
-                   ( MonadIO m
-                   , Ord k, Hashable k
-                   , Integral w
-                   , NFData k, NFData w, NFData v
-                   )
-                => ARCHandle k w v
-                -> k
-                -> m (Maybe (v, w))
-lookupARCHandle (ARCHandle arcVar) k = lookupARC k <$> readIORef arcVar
-
-
-readARCHandle :: MonadIO m
-              => ARCHandle k w v
-              -> m (ARC k w v, ARCTick)
-readARCHandle (ARCHandle arcVar) = readIORef arcVar
--- a/src/Utils/LRU.hs
+++ b/src/Utils/LRU.hs
@ -66,11 +66,11 @@ initLRU :: forall k t w v.
        -> (LRU k t w v, LRUTick)
 initLRU lruMaximumWeight
  | lruMaximumWeight < 0 = error "initLRU given negative maximum weight"
-  | otherwise = (, initialLRUTick) LRU
-    { lruStore = OrdPSQ.empty
-    , lruWeight = 0
-    , lruMaximumWeight
-    }
+  | otherwise = (lru, initialLRUTick)
+    where lru = LRU { lruStore = OrdPSQ.empty
+                    , lruWeight = 0
+                    , lruMaximumWeight
+                    }

 insertLRU :: forall k t w v.
             ( Ord k, Ord t
@ -84,18 +84,18 @@ insertLRU :: forall k t w v.
 insertLRU k t newVal oldLRU@LRU{..} now
  | later <= initialLRUTick = uncurry (insertLRU k t newVal) $ initLRU lruMaximumWeight
  | Just (_, w) <- newVal, w > lruMaximumWeight = (oldLRU, now)
-  | Just (_, w) <- newVal = (, later) $ 
+  | Just (_, w) <- newVal = (, later) $
      let (lruStore', lruWeight') = evictToSize (lruMaximumWeight - w) lruStore lruWeight
          (fromMaybe 0 . preview (_Just . _2 . _2) -> oldWeight, lruStore'')
            = OrdPSQ.alter (, ((t, now), ) <$> newVal) k lruStore'
-       in oldLRU
-            { lruStore = lruStore''
-            , lruWeight = lruWeight' - oldWeight + w
-            }
-  | Just (_, (_, w), lruStore') <- OrdPSQ.deleteView k lruStore = (, now) oldLRU
-      { lruStore = lruStore'
-      , lruWeight = lruWeight - w
-      }
+      in oldLRU { lruStore = lruStore''
+                , lruWeight = lruWeight' - oldWeight + w
+                }
+  | Just (_, (_, w), lruStore') <- OrdPSQ.deleteView k lruStore =
+      let lru = oldLRU { lruStore = lruStore'
+                       , lruWeight = lruWeight - w
+                       }
+      in (lru, now)
  | otherwise = (oldLRU, now)
  where
    later :: LRUTick
@ -127,9 +127,9 @@ touchLRU k t oldLRU@LRU{..} now
  , later <= initialLRUTick = (, Just v) . uncurry (insertLRU k t $ Just v) $ initLRU lruMaximumWeight
  | (Just (_, v), lruStore') <- altered = ((oldLRU{ lruStore = lruStore' }, later), Just v)
  | otherwise = ((oldLRU, now), Nothing)
-  where 
+  where
    altered = OrdPSQ.alter (\oldVal -> (oldVal, over _1 (max (t, later)) <$> oldVal)) k lruStore
-    
+
    later :: LRUTick
    later = over getLRUTick succ now

--- a/src/Utils/Metrics.hs
+++ b/src/Utils/Metrics.hs
@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later

@ -19,8 +19,6 @@ module Utils.Metrics
  , observeDeletedUnreferencedFiles, observeDeletedUnreferencedChunks, observeInjectedFiles, observeRechunkedFiles
  , registerJobWorkerQueueDepth
  , observeMissingFiles
-  , ARCMetrics, ARCLabel(..)
-  , arcMetrics
  , LRUMetrics, LRULabel(..)
  , lruMetrics
  , InjectInhibitMetrics, injectInhibitMetrics
@ -215,7 +213,7 @@ injectedFilesBytes :: Counter
 injectedFilesBytes = unsafeRegister $ counter info
  where info = Info "uni2work_injected_files_bytes"
                    "Size of files injected from upload cache into database"
-  
+
 {-# NOINLINE rechunkedFiles #-}
 rechunkedFiles :: Counter
 rechunkedFiles = unsafeRegister $ counter info
@ -269,46 +267,11 @@ favouritesSkippedDueToDBLoad :: Counter
 favouritesSkippedDueToDBLoad = unsafeRegister $ counter info
  where info = Info "uni2work_favourites_skipped_due_to_db_load_count"
                    "Number of times this Uni2work-instance skipped generating FavouriteQuickActions due to database pressure"
-  
+
 relabel :: Text -> Text
        -> SampleGroup -> SampleGroup
 relabel l s (SampleGroup i t ss) = SampleGroup i t . flip map ss $ \(Sample k lbls v) -> Sample k ((l, s) : filter (views _1 $ (/=) l) lbls) v

-data ARCMetrics = ARCMetrics
-
-data ARCLabel = ARCFileSource | ARCMemcachedLocal
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
-  deriving anyclass (Universe, Finite)
-
-nullaryPathPiece ''ARCLabel $ camelToPathPiece' 1
-
-arcMetrics :: Integral w
-           => ARCLabel
-           -> ARCHandle k w v
-           -> Metric ARCMetrics
-arcMetrics lbl ah = Metric $ return (ARCMetrics, collectARCMetrics)
-  where
-    labelArc = relabel "arc"
-
-    collectARCMetrics = map (labelArc $ toPathPiece lbl) <$> do
-      (arc, _) <- readARCHandle ah
-      return
-        [ SampleGroup sizeInfo GaugeType
-          [ Sample "arc_size" [("lru", "ghost-recent")] . encodeUtf8 . tshow $ arcGhostRecentSize arc
-          , Sample "arc_size" [("lru", "recent")] . encodeUtf8 . tshow $ arcRecentSize arc
-          , Sample "arc_size" [("lru", "frequent")] . encodeUtf8 . tshow $ arcFrequentSize arc
-          , Sample "arc_size" [("lru", "ghost-frequent")] . encodeUtf8 . tshow $ arcGhostFrequentSize arc
-          ]
-        , SampleGroup weightInfo GaugeType
-          [ Sample "arc_weight" [("lru", "recent")] . encodeUtf8 . tshow . toInteger $ getARCRecentWeight arc
-          , Sample "arc_weight" [("lru", "frequent")] . encodeUtf8 . tshow . toInteger $ getARCFrequentWeight arc
-          ]
-        ]
-    sizeInfo = Info "arc_size"
-                    "Number of entries in the ARC LRUs"
-    weightInfo = Info "arc_weight"
-                      "Sum of weights of entries in the ARC LRUs"
-
 data LRUMetrics = LRUMetrics

 data LRULabel = LRUFileSourcePrewarm
@ -356,9 +319,9 @@ injectInhibitMetrics tvar = Metric $ return (InjectInhibitMetrics, collectInject
          [ Sample "uni2work_inject_inhibited_hashes_count" [] . encodeUtf8 . tshow . Set.size $ F.fold inhibits
          ]
        ]
-    intervalsInfo = Info "uni2work_inject_inhibited_intervals_count" 
+    intervalsInfo = Info "uni2work_inject_inhibited_intervals_count"
                         "Number of distinct time intervals in which we don't transfer some files from upload cache to db"
-    hashesInfo = Info "uni2work_inject_inhibited_hashes_count" 
+    hashesInfo = Info "uni2work_inject_inhibited_hashes_count"
                      "Number of files which we don't transfer from upload cache to db during some interval"

 data PoolMetrics = PoolMetrics
@ -392,12 +355,12 @@ poolMetrics lbl pool = Metric $ return (PoolMetrics, collectPoolMetrics)
          [ Sample "uni2work_pool_uses_count" [] . encodeUtf8 $ tshow usesCount
          ]
        ]
-  
-    availableInfo = Info "uni2work_pool_available_count" 
+
+    availableInfo = Info "uni2work_pool_available_count"
                         "Number of open resources available for taking"
-    inUseInfo = Info "uni2work_pool_in_use_count" 
+    inUseInfo = Info "uni2work_pool_in_use_count"
                     "Number of resources currently in use"
-    usesInfo = Info "uni2work_pool_uses_count" 
+    usesInfo = Info "uni2work_pool_uses_count"
                    "Number of takes executed against the pool"

 {-# NOINLINE databaseConnDuration #-}
@ -407,7 +370,7 @@ databaseConnDuration = unsafeRegister . vector "label" $ histogram info buckets
    info = Info "uni2work_database_conn_duration_seconds"
                "Duration of use of a database connection from the pool"
    buckets = histogramBuckets 50e-6 5000
-  
+
 data DBConnUseState = DBConnUseState
  { dbConnUseStart :: !TimeSpec
  , dbConnUseLabel :: !CallStack
@ -441,7 +404,7 @@ authTagEvaluationDuration = unsafeRegister . vector ("tag", "outcome", "handler"
    info = Info "uni2work_auth_tag_evaluation_duration_seconds"
                "Duration of auth tag evaluations"
    buckets = histogramBuckets 5e-6 1
-    
+

 withHealthReportMetrics :: MonadIO m => m HealthReport -> m HealthReport
 withHealthReportMetrics act = do
@ -599,7 +562,7 @@ observeAuthTagEvaluation aTag handler act = do
  let outcome = case res of
        Right (_, outcome') -> outcome'
        Left _ -> OutcomeException
-  
+
  liftIO . withLabel authTagEvaluationDuration (toPathPiece aTag, toPathPiece outcome, pack handler) . flip observe . realToFrac $ end - start

  either throwIO (views _1 return) res