fix: unbreak arc

src/Application.hs

@@ -183,10 +183,10 @@ makeFoundation appSettings''@AppSettings{..} = do
     appJobState <- liftIO newEmptyTMVarIO
     appHealthReport <- liftIO $ newTVarIO Set.empty
 
-    appFileSourceARC <- for appFileSourceARCConf $ \c@ARCConf{..} -> do
+    appFileSourceARC <- for appFileSourceARCConf $ \ARCConf{..} -> do
       ah <- initARCHandle arccMaximumGhost arccMaximumWeight
-      m <- Prometheus.register $ arcMetrics ARCFileSource c ah
-      return (ah, m)
+      void . Prometheus.register $ arcMetrics ARCFileSource ah
+      return ah
 
     -- We need a log function to create a connection pool. We need a connection
     -- pool to create our foundation. And we need our foundation to get a

src/Foundation/Type.hs

@@ -25,8 +25,6 @@ import qualified Jose.Jwk as Jose
 import qualified Database.Memcached.Binary.IO as Memcached
 import Network.Minio (MinioConn)
 
-import Utils.Metrics (ARCMetrics)
-
 
 type SMTPPool = Pool SMTPConnection
 
@@ -62,7 +60,7 @@ data UniWorX = UniWorX
     , appUploadCache      :: Maybe MinioConn
     , appVerpSecret       :: VerpSecret
     , appAuthKey          :: Auth.Key
-    , appFileSourceARC    :: Maybe (ARCHandle (FileContentChunkReference, (Int, Int)) Int ByteString, ARCMetrics)
+    , appFileSourceARC    :: Maybe (ARCHandle (FileContentChunkReference, (Int, Int)) Int ByteString)
     }
 
 makeLenses_ ''UniWorX

src/Handler/Utils/Files.hs

@@ -41,20 +41,18 @@ fileChunkARC k getChunkDB = do
   arc <- getsYesod appFileSourceARC
   case arc of
     Nothing -> getChunkDB
-    Just (ah, m) -> do
+    Just ah -> do
       cachedARC' ah k $ \case
         Nothing -> do
           chunk' <- getChunkDB
           for chunk' $ \chunk -> do
             let w = length chunk
-            liftIO $ do
-              observeARCOutcome m False w
-              observeSourcedChunk StorageDB w
+            $logDebugS "fileChunkARC" "ARC miss"
+            liftIO $ observeSourcedChunk StorageDB w
             return (chunk, w)
-        Just x@(_, w) -> liftIO $ do
-          observeARCOutcome m True w
-          observeSourcedChunk StorageARC w
-          return $ Just x
+        Just x@(_, w) -> do
+          $logDebugS "fileChunkARC" "ARC hit"
+          liftIO $ Just x <$ observeSourcedChunk StorageARC w
 
 
 sourceFileDB :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX)

src/Utils/ARC.hs

@@ -172,7 +172,7 @@ arcAlterF k f oldARC@ARC{..} now
           { arcGhostRecent = OrdPSQ.insert k now () $ evictGhostToCount arcMaximumGhost arcGhostRecent
           }
         Just x@(_, w)
-          -> let (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent (arcMaximumWeight |- arcFrequentWeight) |- w) arcRecent arcRecentWeight arcGhostRecent'
+          -> let (arcRecent', arcRecentWeight', arcGhostRecent') = evictToSize (max arcTargetRecent (arcMaximumWeight |- arcFrequentWeight) |- w) arcRecent arcRecentWeight arcGhostRecent
               in oldARC
                    { arcRecent = OrdPSQ.insert k now x arcRecent'
                    , arcRecentWeight = arcRecentWeight' + w

src/Utils/Metrics.hs

@@ -16,7 +16,7 @@ module Utils.Metrics
   , registerJobWorkerQueueDepth
   , observeMissingFiles
   , ARCMetrics, ARCLabel(..)
-  , arcMetrics, observeARCOutcome
+  , arcMetrics
   ) where
 
 import Import.NoModel hiding (Vector, Info)
@@ -24,8 +24,6 @@ import Model
 import Prometheus
 import Prometheus.Metric.GHC
 
-import Settings (ARCConf(..))
-
 import qualified Data.List as List
 
 import System.Clock
@@ -233,8 +231,6 @@ missingFiles = unsafeRegister . vector "ref" $ gauge info
                     "Number of files referenced from within database that are missing"
 
 data ARCMetrics = ARCMetrics
-  { arcmMiss, arcmHit :: Histogram
-  }
 
 data ARCLabel = ARCFileSource
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
@@ -244,24 +240,17 @@ nullaryPathPiece ''ARCLabel $ camelToPathPiece' 1
 
 arcMetrics :: Integral w
            => ARCLabel
-           -> ARCConf w
            -> ARCHandle k w v
            -> Metric ARCMetrics
-arcMetrics lbl ARCConf{..} ah = Metric $ do
-  (arcmMiss, collectMiss) <- constructMissHit
-  (arcmHit, collectHit) <- constructMissHit
-  let
+arcMetrics lbl ah = Metric $ return (ARCMetrics, collectARCMetrics)
+  where
     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
-    labelOutcome = relabel "outcome"
     labelArc = relabel "arc"
 
     collectARCMetrics = map (labelArc $ toPathPiece lbl) <$> do
-      misses <- concatMap ((\(SampleGroup _ _ misses) -> misses) . labelOutcome "miss") <$> collectMiss
-      hits <- concatMap ((\(SampleGroup _ _ hits) -> hits) . labelOutcome "hit") <$> collectHit
       (arc, _) <- readARCHandle ah
       return
-        [ SampleGroup missHitInfo HistogramType $ hits ++ misses
-        , SampleGroup sizeInfo GaugeType
+        [ 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
@@ -272,26 +261,11 @@ arcMetrics lbl ARCConf{..} ah = Metric $ do
           , Sample "arc_weight" [("lru", "frequent")] . encodeUtf8 . tshow . toInteger $ getARCFrequentWeight arc
           ]
         ]
-  return (ARCMetrics{..}, collectARCMetrics)
-  where
-    Metric constructMissHit = histogram missHitInfo . histogramBuckets 1000 $ fromIntegral arccMaximumWeight
-
-    missHitInfo = Info "arc_query_outcome_count"
-                       "Number of hits/misses in the 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"
 
-observeARCOutcome :: ( MonadMonitor m
-                     , Integral w
-                     )
-                  => ARCMetrics
-                  -> Bool -- ^ Hit?
-                  -> w -- ^ Weight
-                  -> m ()
-observeARCOutcome ARCMetrics{..} isHit = observe (bool arcmMiss arcmHit isHit) . fromIntegral
-
 withHealthReportMetrics :: MonadIO m => m HealthReport -> m HealthReport
 withHealthReportMetrics act = do
   before <- liftIO getPOSIXTime