From cbf41b2ea061aa276f455dde1e31464d106cd3d7 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Mon, 21 Sep 2020 13:59:57 +0200
Subject: [PATCH] feat(logging): additional logging for inject-files

---
 src/Jobs/Handler/Files.hs | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/src/Jobs/Handler/Files.hs b/src/Jobs/Handler/Files.hs
index c3e24551d..c3559482e 100644
--- a/src/Jobs/Handler/Files.hs
+++ b/src/Jobs/Handler/Files.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
 module Jobs.Handler.Files
   ( dispatchJobPruneSessionFiles
   , dispatchJobPruneUnreferencedFiles
@@ -32,6 +34,8 @@ import System.IO.Unsafe
 
 import Handler.Utils.Files (sourceFileDB)
 
+import Control.Monad.Logger (askLoggerIO, runLoggingT)
+
 
 dispatchJobPruneSessionFiles :: JobHandler UniWorX
 dispatchJobPruneSessionFiles = JobHandlerAtomicWithFinalizer act fin
@@ -229,9 +233,24 @@ dispatchJobInjectFiles = JobHandlerException . maybeT (return ()) $ do
           atomically $ isEmptyTMVar chunkVar >>= guard . not
           sinkFileDB False $ C.unfoldM (\x -> fmap (, x) <$> atomically (takeTMVar chunkVar)) ()
 
+        logger <- askLoggerIO
         didSend <- maybeT (return False) . hoistMaybeM . runAppMinio . runMaybeT $ do
           objRes <- catchIfMaybeT minioIsDoesNotExist $ Minio.getObject uploadBucket obj Minio.defaultGetObjectOptions
-          lift . runConduit $ Minio.gorObjectStream objRes .| C.mapM_ (atomically . putTMVar chunkVar . Just)
+          let sendChunks = go 0 0
+                where
+                  go :: forall m. MonadIO m => Natural -> Int64 -> ConduitT ByteString Void m ()
+                  go c accsz = do
+                    chunk' <- await
+                    whenIsJust chunk' $ \chunk -> do
+                      let csz = fromIntegral $ olength chunk
+                          !sz' = accsz + csz
+                          p :: Centi
+                          p = realToFrac $ (toInteger sz' % toInteger sz) * 100
+                          !c' = succ c
+                      runLoggingT ?? logger $ $logInfoS "InjectFiles" [st|Sinking chunk ##{tshow c} (#{tshow csz}): #{tshow sz'}/#{tshow sz} (#{tshow p}%)...|]
+                      atomically . putTMVar chunkVar $ Just chunk
+                      go c' sz'
+          lift . runConduit $ Minio.gorObjectStream objRes .| sendChunks
           return True
         if
           | not didSend -> Nothing <$ cancel dbAsync