feat(logging): additional logging for inject-files

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