From 4801d22cb360dcd936c57494ff2ff02655431409 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 21 Sep 2020 12:16:47 +0200 Subject: [PATCH] feat(metrics): measure file i/o --- src/Handler/Utils/Files.hs | 13 +++++++---- src/Jobs.hs | 1 + src/Utils/Files.hs | 10 +++++++-- src/Utils/Metrics.hs | 44 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 62 insertions(+), 6 deletions(-) diff --git a/src/Handler/Utils/Files.hs b/src/Handler/Utils/Files.hs index aa0d280bc..8d8ca5dd8 100644 --- a/src/Handler/Utils/Files.hs +++ b/src/Handler/Utils/Files.hs @@ -40,9 +40,11 @@ sourceFileDB fileReference = do return $ E.substring (fileContentChunk E.^. FileContentChunkContent) (E.val start) (E.val dbChunksize) case chunk of Nothing -> throwM SourceFilesContentUnavailable - Just (E.Value c) -> return . Just . (c, ) $ if - | olength c >= dbChunksize -> Just $ start + dbChunksize - | otherwise -> Nothing + Just (E.Value c) -> do + observeSourcedChunk StorageDB $ olength c + return . Just . (c, ) $ if + | olength c >= dbChunksize -> Just $ start + dbChunksize + | otherwise -> Nothing chunkHashes = E.selectSource . E.from $ \fileContentEntry -> do E.where_ $ fileContentEntry E.^. FileContentEntryHash E.==. E.val fileReference E.orderBy [ E.asc $ fileContentEntry E.^. FileContentEntryIx ] @@ -65,7 +67,10 @@ sourceFileMinio fileReference = do mChunk <- atomically $ Right <$> takeTMVar chunkVar <|> Left <$> waitCatchSTM minioAsync case mChunk of - Right chunk -> yield chunk >> go + Right chunk -> do + observeSourcedChunk StorageMinio $ olength chunk + yield chunk + go Left (Right ()) -> return () Left (Left exc) -> throwM exc in go diff --git a/src/Jobs.hs b/src/Jobs.hs index 5703bff62..91e8cf605 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -101,6 +101,7 @@ handleJobs foundation@UniWorX{..} jobShutdown <- liftIO newEmptyTMVarIO jobCurrentCrontab <- liftIO $ newTVarIO Nothing jobHeldLocks <- liftIO $ newTVarIO Set.empty + registerJobHeldLocksCount jobHeldLocks atomically $ putTMVar appJobState JobState { jobContext = JobContext{..} , .. diff --git a/src/Utils/Files.hs b/src/Utils/Files.hs index 3119313da..3b334391c 100644 --- a/src/Utils/Files.hs +++ b/src/Utils/Files.hs @@ -7,6 +7,7 @@ module Utils.Files ) where import Import.NoFoundation +import Utils.Metrics import Foundation.Type import Handler.Utils.Minio import qualified Network.Minio as Minio @@ -46,6 +47,8 @@ sinkFileDB doReplace fileContentContent = do fileChunkLockTime <- liftIO getCurrentTime fileChunkLockInstance <- getsYesod appInstanceID + observeSunkChunk StorageDB $ olength fileContentChunkContent + tellM $ Set.singleton <$> insert FileChunkLock{ fileChunkLockHash = fileContentChunkHash, .. } existsChunk <- lift $ exists [FileContentChunkHash ==. fileContentChunkHash] let setContentBased = updateWhere [FileContentChunkHash ==. fileContentChunkHash] [FileContentChunkContentBased =. fileContentChunkContentBased] @@ -98,8 +101,11 @@ sinkFileMinio fileContentContent = do case nextChunk of Nothing -> putMVar chunk Nothing - Just nextChunk' - -> putMVar chunk (Just nextChunk') >> yield nextChunk' >> putChunks + Just nextChunk' -> do + observeSunkChunk StorageMinio $ olength nextChunk' + putMVar chunk $ Just nextChunk' + yield nextChunk' + putChunks sinkAsync <- lift . allocateLinkedAsync . runConduit $ fileContentContent .| putChunks diff --git a/src/Utils/Metrics.hs b/src/Utils/Metrics.hs index 34265c36a..301d1aae9 100644 --- a/src/Utils/Metrics.hs +++ b/src/Utils/Metrics.hs @@ -3,10 +3,12 @@ module Utils.Metrics , registerGHCMetrics , observeHTTPRequestLatency , registerReadyMetric + , registerJobHeldLocksCount , withJobWorkerStateLbls , observeYesodCacheSize , observeFavouritesQuickActionsDuration , LoginOutcome(..), observeLoginOutcome + , FileChunkStorage(..), observeSourcedChunk, observeSunkChunk ) where import Import.NoModel hiding (Vector, Info) @@ -25,6 +27,8 @@ import qualified Network.HTTP.Types as HTTP import Yesod.Core.Types (HandlerData(..), GHState(..)) +import qualified Data.Set as Set + {-# ANN module ("HLint: ignore Use even" :: String) #-} @@ -110,6 +114,31 @@ loginOutcomes = unsafeRegister . vector ("plugin", "outcome") $ counter info where info = Info "uni2work_login_attempts_total" "Number of login attempts" +data JobHeldLocksCount = MkJobHeldLocksCount + +jobHeldLocksCount :: TVar (Set QueuedJobId) -> Metric JobHeldLocksCount +jobHeldLocksCount heldLocks = Metric $ return (MkJobHeldLocksCount, collectJobHeldLocksCount) + where + collectJobHeldLocksCount = do + nLocks <- Set.size <$> readTVarIO heldLocks + let sample = encodeUtf8 $ tshow nLocks + return [SampleGroup info GaugeType [Sample "uni2work_jobs_held_locks_count" [] sample]] + info = Info "uni2work_jobs_held_locks_count" + "Number of job locks currently held by this Uni2work-instance" + +{-# NOINLINE sourcedFileChunkSizes #-} +sourcedFileChunkSizes :: Vector Label1 Histogram +sourcedFileChunkSizes = unsafeRegister . vector ("storage") $ histogram info buckets + where info = Info "uni2work_sourced_file_chunks_bytes" + "Sizes of files chunks sourced" + buckets = 0 : histogramBuckets 1 20000000 + +{-# NOINLINE sunkFileChunkSizes #-} +sunkFileChunkSizes :: Vector Label1 Histogram +sunkFileChunkSizes = unsafeRegister . vector ("storage") $ histogram info buckets + where info = Info "uni2work_sunk_file_chunks_bytes" + "Sizes of files chunks sunk" + buckets = 0 : histogramBuckets 1 100000000 withHealthReportMetrics :: MonadIO m => m HealthReport -> m HealthReport withHealthReportMetrics act = do @@ -196,3 +225,18 @@ observeLoginOutcome :: MonadHandler m -> m () observeLoginOutcome plugin outcome = liftIO $ withLabel loginOutcomes (plugin, toPathPiece outcome) incCounter + +registerJobHeldLocksCount :: MonadIO m => TVar (Set QueuedJobId) -> m () +registerJobHeldLocksCount = liftIO . void . register . jobHeldLocksCount + +data FileChunkStorage = StorageMinio | StorageDB + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving anyclass (Universe, Finite) +nullaryPathPiece ''FileChunkStorage $ camelToPathPiece' 1 + +observeSunkChunk, observeSourcedChunk :: (Integral n, MonadIO m) => FileChunkStorage -> n -> m () +observeSunkChunk store = liftIO . observeChunkSize sunkFileChunkSizes store . fromIntegral +observeSourcedChunk store = liftIO . observeChunkSize sourcedFileChunkSizes store . fromIntegral + +observeChunkSize :: Vector Label1 Histogram -> FileChunkStorage -> Integer -> IO () +observeChunkSize metric (toPathPiece -> storageLabel) = withLabel metric storageLabel . flip observe . fromInteger