From 59d73fd82c729a7edf8d865f40ded0175ceb2e10 Mon Sep 17 00:00:00 2001 From: Michal Kozakiewicz Date: Fri, 31 Jul 2026 07:50:33 +0000 Subject: [PATCH 1/4] Report size and speed of remote cache transfers Closes the "report speed, size etc." TODO in RemoteCache. There was no way to tell how long restoring or saving a cache actually took, or how fast, which made it impossible to reason about remote cache performance. Adds Utils.timed and Utils.transferSummary (on top of the existing bytesfmt), and a countBytes conduit that tallies bytes passing through without buffering, then instruments both directions: Downloaded and unpacked 190.74 MiB in 0.33s (579.28 MiB/s) Packed and uploaded 190.74 MiB in 1.39s (137.08 MiB/s), compressed from 190.74 MiB Both are debug level, so they always land in the per-task log but stay out of normal output - and out of the golden files, since the numbers are not reproducible. The rates cover the whole pipeline rather than just the network: download plus zstd plus tar one way, tar plus zstd plus upload the other. That is the number that matters for wall clock, and the comments say so explicitly so it is not mistaken for link speed. Tested against a local MinIO with the same env CI uses: all 63 tests pass, no golden files change. Co-Authored-By: Claude Opus 5 (1M context) --- src/RemoteCache.hs | 38 ++++++++++++++++++++++++++++++++------ src/Utils.hs | 25 +++++++++++++++++++++++++ 2 files changed, 57 insertions(+), 6 deletions(-) diff --git a/src/RemoteCache.hs b/src/RemoteCache.hs index 48fa670..19d6d4c 100644 --- a/src/RemoteCache.hs +++ b/src/RemoteCache.hs @@ -26,7 +26,7 @@ import Network.URI (parseURI, URI (..), URIAuth(..)) import System.Directory (makeAbsolute, canonicalizePath) import System.FilePath (makeRelative) import qualified System.FilePath as FP -import Utils (bail, logDebug, logFileName, logInfo, withStderrPipe) +import Utils (bail, bytesfmt, logDebug, logFileName, logInfo, timed, transferSummary, withStderrPipe) import qualified Amazonka as AWS import Control.Exception.Lens (handling) import System.Exit (ExitCode(..)) @@ -114,7 +114,6 @@ parseEndpoint s = do . (\svc -> svc { s3AddressingStyle = S3AddressingStylePath }) -- TODO: --- - report speed, size etc. -- - integrate amazonka logging -- - handle errors saveCache @@ -145,13 +144,18 @@ saveCache appState settings relativeCacheRoot files archiveName = do logDebug appState $ "Uploading to s3://" <> bucket <> "/" <> objectKey - withStderrPipe appState \stderrHandle -> + packedBytes <- newIORef 0 + uploadedBytes <- newIORef 0 + + (_, elapsed) <- timed $ withStderrPipe appState \stderrHandle -> runConduitRes do let multipartUpload = (newCreateMultipartUpload (BucketName bucket) (ObjectKey objectKey) :: CreateMultipartUpload) { storageClass = Just StorageClass_REDUCED_REDUNDANCY } result <- packTar appState stderrHandle cacheRoot filesRelativeToCacheRoot + .| countBytes packedBytes .| Zstd.compress 3 + .| countBytes uploadedBytes .| streamUpload env Nothing multipartUpload case result of Left (_, err) -> @@ -160,6 +164,19 @@ saveCache appState settings relativeCacheRoot files archiveName = do liftIO $ logDebug appState "Upload success" pure () + packed <- readIORef packedBytes + uploaded <- readIORef uploadedBytes + -- Note the rate covers the whole pipeline (tar, zstd and the upload), not + -- just the network part. + logDebug appState $ "Packed and uploaded " <> transferSummary uploaded elapsed + <> ", compressed from " <> toText (bytesfmt "%.2f" packed) + +-- | Pass data through unchanged, accumulating the total number of bytes seen. +countBytes :: MonadIO m => IORef Int -> ConduitT BS.ByteString BS.ByteString m () +countBytes ref = C.awaitForever \chunk -> do + modifyIORef' ref (+ BS.length chunk) + C.yield chunk + data LogMode = NoLog | Log deriving (Eq, Show) restoreCache @@ -181,14 +198,23 @@ restoreCache appState settings cacheRoot archiveName logMode = do logDebug appState $ "Remote cache archive not found s3://" <> bucket <> "/" <> objectKey pure False - handling _NoSuchKey onNoSuchKey $ withStderrPipe appState \stderrHandle -> - runConduitRes do + handling _NoSuchKey onNoSuchKey $ withStderrPipe appState \stderrHandle -> do + downloadedBytes <- newIORef 0 + + (_, elapsed) <- timed $ runConduitRes do response <- AWS.send env $ newGetObject (BucketName bucket) (ObjectKey objectKey) when (logMode == Log) do liftIO $ logInfo appState $ "Found remote cache " <> archiveName <> ", restoring" response.body.body + .| countBytes downloadedBytes .| unpackTar appState stderrHandle cacheRoot - pure True + + downloaded <- readIORef downloadedBytes + -- The size is that of the compressed archive, and the rate covers the whole + -- pipeline (the download, zstd and tar), not just the network part. + logDebug appState $ "Downloaded and unpacked " <> transferSummary downloaded elapsed + + pure True getLatestBuildHash :: AppState diff --git a/src/Utils.hs b/src/Utils.hs index 30a67eb..ecf9828 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -17,6 +17,7 @@ import GHC.IO.Handle (hIsClosed) import System.FilePath (()) import Control.Concurrent.Async (async, wait) import System.Timeout (timeout) +import GHC.Clock (getMonotonicTime) outputLine :: AppState -> Handle -> ByteString -> ByteString -> IO () outputLine appState toplevelOutput streamName line = do @@ -90,6 +91,30 @@ bytesfmt formatter bs = printf (formatter <> " %s") bytesSuffixes = ["B", "KiB", "MiB", "GiB", "TiB", "PiB", "EiB", "ZiB", "YiB"] bytesSuffix = bytesSuffixes !! i +-- | Run an action, also returning how long it took, in seconds. +timed :: MonadIO m => m a -> m (a, Double) +timed action = do + start <- liftIO getMonotonicTime + result <- action + end <- liftIO getMonotonicTime + pure (result, end - start) + +-- | Describe a transfer of @bytes@ bytes taking @seconds@ seconds. +-- +-- >>> transferSummary 12345678 1.5 +-- "11.77 MiB in 1.50s (7.85 MiB/s)" +transferSummary :: Int -> Double -> Text +transferSummary bytes seconds = + toText (bytesfmt "%.2f" bytes) <> " in " <> toText (printf "%.2fs" seconds :: String) <> rate + where + rate + -- Below that the rate is mostly measurement noise, and dividing by a very + -- small elapsed time gives an absurd number. + | seconds >= 0.01 = + " (" <> toText (bytesfmt "%.2f" (round (fromIntegral bytes / seconds) :: Int)) <> "/s)" + | otherwise = + "" + -- | Create a per-subprocess stderr pipe that prefixes output with the job name. -- The pipe is fully drained before returning. withStderrPipe :: AppState -> (Handle -> IO a) -> IO a From aea608cc66c646f0a3883e7db4a2b5862c438d8c Mon Sep 17 00:00:00 2001 From: Michal Kozakiewicz Date: Sun, 2 Aug 2026 08:15:21 +0000 Subject: [PATCH 2/4] Split remote cache timing into transfer vs pack/unpack The single duration could not answer the question it most often raises: when restoring a cache is slow, is it the network or the unpacking? For a cache full of small files - .stack-work and friends - it is almost always the unpacking, but there was no way to see that from CI logs. measureTransfer sits in the pipeline and records how long it waits for upstream to produce data versus for downstream to consume it. Conduit runs those strictly alternately, so it is an exact attribution of the pipeline's wall clock rather than a sample, and it costs two clock reads per chunk. Downloaded and unpacked 378.87 MiB in 2.25s (168.73 MiB/s) - downloading 0.24s, unpacking 1.97s Packed and uploaded 378.87 MiB in 6.51s (58.17 MiB/s), compressed from 1.26 GiB - packing and compressing 4.22s, uploading 2.27s Verified it discriminates rather than always blaming one side. Restoring 20160 small files totalling 1.26 GiB: 0.24s downloading, 1.97s unpacking. Restoring a single 190 MiB file over the same link: 0.16s downloading, 0.20s unpacking. Note it measures waiting, and downstream applies backpressure, so a slow consumer cannot inflate the producing side - time lands there only when no data was available yet. All 63 tests pass against a local MinIO; no golden files change. Co-Authored-By: Claude Opus 5 (1M context) --- src/RemoteCache.hs | 76 +++++++++++++++++++++++++++++++++++++++------- src/Utils.hs | 6 +++- 2 files changed, 70 insertions(+), 12 deletions(-) diff --git a/src/RemoteCache.hs b/src/RemoteCache.hs index 19d6d4c..1325031 100644 --- a/src/RemoteCache.hs +++ b/src/RemoteCache.hs @@ -26,7 +26,7 @@ import Network.URI (parseURI, URI (..), URIAuth(..)) import System.Directory (makeAbsolute, canonicalizePath) import System.FilePath (makeRelative) import qualified System.FilePath as FP -import Utils (bail, bytesfmt, logDebug, logFileName, logInfo, timed, transferSummary, withStderrPipe) +import Utils (bail, bytesfmt, formatSeconds, logDebug, logFileName, logInfo, timed, transferSummary, withStderrPipe) import qualified Amazonka as AWS import Control.Exception.Lens (handling) import System.Exit (ExitCode(..)) @@ -35,6 +35,7 @@ import qualified Data.Conduit.Text as CT import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB import Amazonka.S3.PutObject (newPutObject, PutObject(..)) +import GHC.Clock (getMonotonicTime) packTar :: MonadResource m => AppState -> Handle -> FilePath -> [FilePath] -> ConduitT () BS.ByteString m () @@ -145,7 +146,7 @@ saveCache appState settings relativeCacheRoot files archiveName = do logDebug appState $ "Uploading to s3://" <> bucket <> "/" <> objectKey packedBytes <- newIORef 0 - uploadedBytes <- newIORef 0 + uploadStatsRef <- newIORef emptyTransferStats (_, elapsed) <- timed $ withStderrPipe appState \stderrHandle -> runConduitRes do @@ -155,7 +156,7 @@ saveCache appState settings relativeCacheRoot files archiveName = do packTar appState stderrHandle cacheRoot filesRelativeToCacheRoot .| countBytes packedBytes .| Zstd.compress 3 - .| countBytes uploadedBytes + .| measureTransfer uploadStatsRef .| streamUpload env Nothing multipartUpload case result of Left (_, err) -> @@ -165,11 +166,13 @@ saveCache appState settings relativeCacheRoot files archiveName = do pure () packed <- readIORef packedBytes - uploaded <- readIORef uploadedBytes + uploadStats <- readIORef uploadStatsRef -- Note the rate covers the whole pipeline (tar, zstd and the upload), not - -- just the network part. - logDebug appState $ "Packed and uploaded " <> transferSummary uploaded elapsed + -- just the network part - hence the split, which says which to blame. + logDebug appState $ "Packed and uploaded " <> transferSummary uploadStats.bytes elapsed <> ", compressed from " <> toText (bytesfmt "%.2f" packed) + <> " - packing and compressing " <> formatSeconds uploadStats.producingSeconds + <> ", uploading " <> formatSeconds uploadStats.consumingSeconds -- | Pass data through unchanged, accumulating the total number of bytes seen. countBytes :: MonadIO m => IORef Int -> ConduitT BS.ByteString BS.ByteString m () @@ -177,6 +180,53 @@ countBytes ref = C.awaitForever \chunk -> do modifyIORef' ref (+ BS.length chunk) C.yield chunk +-- | Bytes seen, and how the wall clock divided between producing them and +-- consuming them. +data TransferStats = TransferStats + { bytes :: !Int + , producingSeconds :: !Double + , consumingSeconds :: !Double + } + +emptyTransferStats :: TransferStats +emptyTransferStats = TransferStats + { bytes = 0 + , producingSeconds = 0 + , consumingSeconds = 0 + } + +-- | Pass data through unchanged, recording how much of the time went into +-- waiting for upstream to produce data versus waiting for downstream to consume +-- it. +-- +-- Conduit runs the two strictly alternately - 'C.await' returns once upstream +-- has a chunk, and 'C.yield' returns once downstream wants the next one - so +-- this is an exact attribution of this pipeline's wall clock, not a sample. +-- +-- Note it measures *waiting*. Downstream applies backpressure, so a slow +-- consumer does not inflate the producing side: time is only counted there when +-- no data was available yet. +measureTransfer :: MonadIO m => IORef TransferStats -> ConduitT BS.ByteString BS.ByteString m () +measureTransfer ref = loop + where + loop = do + beforeAwait <- liftIO getMonotonicTime + m_chunk <- C.await + afterAwait <- liftIO getMonotonicTime + case m_chunk of + Nothing -> + liftIO $ modifyIORef' ref \stats -> stats + { producingSeconds = stats.producingSeconds + (afterAwait - beforeAwait) } + Just chunk -> do + C.yield chunk + afterYield <- liftIO getMonotonicTime + liftIO $ modifyIORef' ref \stats -> stats + { bytes = stats.bytes + BS.length chunk + , producingSeconds = stats.producingSeconds + (afterAwait - beforeAwait) + , consumingSeconds = stats.consumingSeconds + (afterYield - afterAwait) + } + loop + data LogMode = NoLog | Log deriving (Eq, Show) restoreCache @@ -199,20 +249,24 @@ restoreCache appState settings cacheRoot archiveName logMode = do pure False handling _NoSuchKey onNoSuchKey $ withStderrPipe appState \stderrHandle -> do - downloadedBytes <- newIORef 0 + statsRef <- newIORef emptyTransferStats (_, elapsed) <- timed $ runConduitRes do response <- AWS.send env $ newGetObject (BucketName bucket) (ObjectKey objectKey) when (logMode == Log) do liftIO $ logInfo appState $ "Found remote cache " <> archiveName <> ", restoring" response.body.body - .| countBytes downloadedBytes + .| measureTransfer statsRef .| unpackTar appState stderrHandle cacheRoot - downloaded <- readIORef downloadedBytes + stats <- readIORef statsRef -- The size is that of the compressed archive, and the rate covers the whole - -- pipeline (the download, zstd and tar), not just the network part. - logDebug appState $ "Downloaded and unpacked " <> transferSummary downloaded elapsed + -- pipeline (the download, zstd and tar), not just the network part - hence + -- the split, which says which of the two to blame. Note the download side + -- excludes connection setup, which happened above in AWS.send. + logDebug appState $ "Downloaded and unpacked " <> transferSummary stats.bytes elapsed + <> " - downloading " <> formatSeconds stats.producingSeconds + <> ", unpacking " <> formatSeconds stats.consumingSeconds pure True diff --git a/src/Utils.hs b/src/Utils.hs index ecf9828..c8ef005 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -99,13 +99,17 @@ timed action = do end <- liftIO getMonotonicTime pure (result, end - start) +-- | Format a duration in seconds, e.g. @"1.50s"@. +formatSeconds :: Double -> Text +formatSeconds seconds = toText (printf "%.2fs" seconds :: String) + -- | Describe a transfer of @bytes@ bytes taking @seconds@ seconds. -- -- >>> transferSummary 12345678 1.5 -- "11.77 MiB in 1.50s (7.85 MiB/s)" transferSummary :: Int -> Double -> Text transferSummary bytes seconds = - toText (bytesfmt "%.2f" bytes) <> " in " <> toText (printf "%.2fs" seconds :: String) <> rate + toText (bytesfmt "%.2f" bytes) <> " in " <> formatSeconds seconds <> rate where rate -- Below that the rate is mostly measurement noise, and dividing by a very From f12535e9275ea6e41fbea1f024ed06589a1ae211 Mon Sep 17 00:00:00 2001 From: Michal Kozakiewicz Date: Sun, 2 Aug 2026 08:26:13 +0000 Subject: [PATCH 3/4] v0.18.0.11 --- package.yaml | 2 +- taskrunner.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/package.yaml b/package.yaml index 9c0f0f2..16e2d82 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: taskrunner -version: 0.18.0.10 +version: 0.18.0.11 github: "githubuser/taskrunner" license: BSD-3-Clause author: "Author name here" diff --git a/taskrunner.cabal b/taskrunner.cabal index 710f969..0a74fc6 100644 --- a/taskrunner.cabal +++ b/taskrunner.cabal @@ -5,7 +5,7 @@ cabal-version: 2.2 -- see: https://github.com/sol/hpack name: taskrunner -version: 0.18.0.10 +version: 0.18.0.11 description: Please see the README on GitHub at homepage: https://github.com/githubuser/taskrunner#readme bug-reports: https://github.com/githubuser/taskrunner/issues From 81d1b02c0e68c50767a3458c9f81b5822b8a8d8c Mon Sep 17 00:00:00 2001 From: Michal Kozakiewicz Date: Sun, 2 Aug 2026 17:42:18 +0000 Subject: [PATCH 4/4] Address review: three-way attribution, and say what the numbers mean Three points from @zyla: - Attribute the third component. Tapping either side of zstd separates reading the files from compressing them from the upload. The taps nest rather than partition - when zstd wants input it pulls through the upstream tap - so compression is the difference between the two, and the three figures now add up to the elapsed time. - Do not report stall time as time spent transferring. A socket write returns once the data is in the kernel send buffer and the kernel transmits it while the next chunk is compressed, so transfer overlaps the rest of the pipeline and is undercounted; reads are the mirror image. These numbers identify the bottleneck, they are not a breakdown of where the bytes' time went, and the wording now says so. - countBytes is gone rather than converted to iterM: the new upstream tap already counts the uncompressed bytes. Only a two-way split is available on restore, where zstd runs inside tar and decompression cannot be separated from the file writes. Verified against three workloads over the same link, blame landing somewhere different each time and summing to the elapsed time: 8000 tiny files, 7.82 MiB reading 0.11s compression 0.01s upload 0.00s (0.13s) one 381 MiB compressible reading 0.12s compression 0.06s upload 0.00s (0.19s) one 286 MiB incompressible reading 0.09s compression 0.18s upload 1.72s (2.02s) The middle row is the point about undercounting: 381 MiB was read and compressed, but only 36 KiB reached the wire. Co-Authored-By: Claude Opus 5 (1M context) --- src/RemoteCache.hs | 66 +++++++++++++++++++++++++++------------------- 1 file changed, 39 insertions(+), 27 deletions(-) diff --git a/src/RemoteCache.hs b/src/RemoteCache.hs index 1325031..bf5c16d 100644 --- a/src/RemoteCache.hs +++ b/src/RemoteCache.hs @@ -145,7 +145,9 @@ saveCache appState settings relativeCacheRoot files archiveName = do logDebug appState $ "Uploading to s3://" <> bucket <> "/" <> objectKey - packedBytes <- newIORef 0 + -- Taps either side of zstd, so a slow save can be pinned on reading the + -- files, on compressing them, or on the network. + packStatsRef <- newIORef emptyTransferStats uploadStatsRef <- newIORef emptyTransferStats (_, elapsed) <- timed $ withStderrPipe appState \stderrHandle -> @@ -154,7 +156,7 @@ saveCache appState settings relativeCacheRoot files archiveName = do { storageClass = Just StorageClass_REDUCED_REDUNDANCY } result <- packTar appState stderrHandle cacheRoot filesRelativeToCacheRoot - .| countBytes packedBytes + .| measureTransfer packStatsRef .| Zstd.compress 3 .| measureTransfer uploadStatsRef .| streamUpload env Nothing multipartUpload @@ -165,20 +167,22 @@ saveCache appState settings relativeCacheRoot files archiveName = do liftIO $ logDebug appState "Upload success" pure () - packed <- readIORef packedBytes + packStats <- readIORef packStatsRef uploadStats <- readIORef uploadStatsRef - -- Note the rate covers the whole pipeline (tar, zstd and the upload), not - -- just the network part - hence the split, which says which to blame. + -- The two taps nest rather than partition: when zstd wants input it pulls + -- through the upstream tap, so the time the upload tap spent waiting for + -- zstd already contains the time spent waiting for tar. Subtracting leaves + -- compression on its own, and the three then add up to the elapsed time. + let readingSeconds = packStats.producingSeconds + compressionSeconds = max 0 (uploadStats.producingSeconds - packStats.producingSeconds) + uploadSeconds = uploadStats.consumingSeconds + -- Largest figure is the bottleneck. See 'measureTransfer' for why the + -- network one is a lower bound. logDebug appState $ "Packed and uploaded " <> transferSummary uploadStats.bytes elapsed - <> ", compressed from " <> toText (bytesfmt "%.2f" packed) - <> " - packing and compressing " <> formatSeconds uploadStats.producingSeconds - <> ", uploading " <> formatSeconds uploadStats.consumingSeconds - --- | Pass data through unchanged, accumulating the total number of bytes seen. -countBytes :: MonadIO m => IORef Int -> ConduitT BS.ByteString BS.ByteString m () -countBytes ref = C.awaitForever \chunk -> do - modifyIORef' ref (+ BS.length chunk) - C.yield chunk + <> ", compressed from " <> toText (bytesfmt "%.2f" packStats.bytes) + <> " - blocked on reading files " <> formatSeconds readingSeconds + <> ", on compression " <> formatSeconds compressionSeconds + <> ", on upload " <> formatSeconds uploadSeconds -- | Bytes seen, and how the wall clock divided between producing them and -- consuming them. @@ -195,17 +199,24 @@ emptyTransferStats = TransferStats , consumingSeconds = 0 } --- | Pass data through unchanged, recording how much of the time went into --- waiting for upstream to produce data versus waiting for downstream to consume --- it. +-- | Pass data through unchanged, recording how long the pipeline sat blocked +-- waiting for upstream to hand over a chunk versus blocked waiting for +-- downstream to accept one. -- -- Conduit runs the two strictly alternately - 'C.await' returns once upstream -- has a chunk, and 'C.yield' returns once downstream wants the next one - so --- this is an exact attribution of this pipeline's wall clock, not a sample. +-- together these account for the pipeline's whole wall clock. +-- +-- These are *stall* times, not time spent doing the work, and for I/O the two +-- differ. A @write@ to a socket returns as soon as the data is copied into the +-- kernel's send buffer; the kernel then transmits it while the next chunk is +-- being compressed. So the transfer overlaps the rest of the pipeline and is +-- undercounted here - if the pipeline is CPU-bound the writes cost almost +-- nothing. Reads are the mirror image: data accumulates in the receive buffer +-- while we are busy, so an 'await' that finds it already there costs nothing. -- --- Note it measures *waiting*. Downstream applies backpressure, so a slow --- consumer does not inflate the producing side: time is only counted there when --- no data was available yet. +-- Read these numbers as "where did the pipeline stall", which is what identifies +-- the bottleneck. Do not read them as "how long the bytes spent in transit". measureTransfer :: MonadIO m => IORef TransferStats -> ConduitT BS.ByteString BS.ByteString m () measureTransfer ref = loop where @@ -260,13 +271,14 @@ restoreCache appState settings cacheRoot archiveName logMode = do .| unpackTar appState stderrHandle cacheRoot stats <- readIORef statsRef - -- The size is that of the compressed archive, and the rate covers the whole - -- pipeline (the download, zstd and tar), not just the network part - hence - -- the split, which says which of the two to blame. Note the download side - -- excludes connection setup, which happened above in AWS.send. + -- The size is that of the compressed archive. Only a two-way split is + -- available here: zstd runs inside tar, so decompression cannot be + -- distinguished from the file writes. Note the download side excludes + -- connection setup, which happened above in AWS.send, and see + -- 'measureTransfer' for why it is a lower bound. logDebug appState $ "Downloaded and unpacked " <> transferSummary stats.bytes elapsed - <> " - downloading " <> formatSeconds stats.producingSeconds - <> ", unpacking " <> formatSeconds stats.consumingSeconds + <> " - blocked on download " <> formatSeconds stats.producingSeconds + <> ", on decompression and unpacking " <> formatSeconds stats.consumingSeconds pure True