From 8ecb460f39f48557b5935b1cd18709ba197d3490 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 10 Feb 2021 22:58:01 +0100 Subject: [PATCH] fix: unbreak arc --- src/Application.hs | 6 +++--- src/Foundation/Type.hs | 4 +--- src/Handler/Utils/Files.hs | 14 ++++++-------- src/Utils/ARC.hs | 2 +- src/Utils/Metrics.hs | 34 ++++------------------------------ 5 files changed, 15 insertions(+), 45 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 1092381eb..4e5cdc8ed 100644 --- a/src/Application.hs +++ b/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 diff --git a/src/Foundation/Type.hs b/src/Foundation/Type.hs index 9ad04c593..19a1f5d65 100644 --- a/src/Foundation/Type.hs +++ b/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 diff --git a/src/Handler/Utils/Files.hs b/src/Handler/Utils/Files.hs index e95e3cf90..8d4e60bf3 100644 --- a/src/Handler/Utils/Files.hs +++ b/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) diff --git a/src/Utils/ARC.hs b/src/Utils/ARC.hs index cd32edde1..4d29e10c2 100644 --- a/src/Utils/ARC.hs +++ b/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 diff --git a/src/Utils/Metrics.hs b/src/Utils/Metrics.hs index aab902ee3..27503acf9 100644 --- a/src/Utils/Metrics.hs +++ b/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