fix(file-jobs): improve log messages

This commit is contained in:
Gregor Kleen 2020-09-17 21:56:41 +02:00
parent e5ae1521a0
commit e099e13816

View File

@ -198,7 +198,7 @@ dispatchJobPruneUnreferencedFiles numIterations epoch iteration = JobHandlerAtom
.| C.mapM deleteChunk
.| C.fold
when (deletedChunks > 0) $
when (deletedChunks > 0 || deletedChunkSize > 0) $
$logInfoS "PruneUnreferencedFiles" [st|Deleted #{tshow deletedChunks} chunks (#{tshow deletedChunkSize} bytes)|]
@ -211,9 +211,12 @@ dispatchJobInjectFiles = JobHandlerException . maybeT (return ()) $ do
extractReference (Minio.ListItemObject oi) = (oi, ) <$> Minio.oiObject oi ^? minioFileReference
extractReference _ = Nothing
injectOrDelete :: (Minio.Object, FileContentReference)
-> Handler (Sum Int64) -- ^ Injected
injectOrDelete (obj, fRef) = do
injectOrDelete :: (Minio.ObjectInfo, FileContentReference)
-> Handler (Sum Natural, Sum Word64)
injectOrDelete (objInfo, fRef) = do
let obj = Minio.oiObject objInfo
sz = fromIntegral $ Minio.oiSize objInfo
fRef' <- runDB . setSerializable $ do
chunkVar <- newEmptyTMVarIO
dbAsync <- allocateLinkedAsync $ do
@ -234,19 +237,18 @@ dispatchJobInjectFiles = JobHandlerException . maybeT (return ()) $ do
maybeT (return ()) . runAppMinio . handleIf minioIsDoesNotExist (const $ return ()) $ Minio.removeObject uploadBucket obj
| otherwise ->
$logErrorS "InjectFiles" [st|Minio object #{obj}'s content does not match it's name (content hash: #{tshow fRef'} /= name hash: #{tshow fRef})|]
return . bool mempty (Sum 1) $ is _Just fRef'
return . bool mempty (Sum 1, Sum sz) $ is _Just fRef'
Sum inj <-
(Sum injectedFiles, Sum injectedSize) <-
runConduit $ transPipe runAppMinio (Minio.listObjects uploadBucket Nothing True)
.| C.mapMaybe extractReference
.| maybe (C.map id) (takeWhileTime . (/ 2)) interval
.| transPipe (lift . runDB . setSerializable) (persistentTokenBucketTakeC' TokenBucketInjectFiles $ views _1 Minio.oiSize)
.| C.map (over _1 Minio.oiObject)
.| transPipe lift (C.mapM injectOrDelete)
.| C.mapM (lift . injectOrDelete)
.| C.fold
when (inj > 0) $
$logInfoS "InjectFiles" [st|Injected #{inj} files from upload cache into database|]
when (injectedFiles > 0 || injectedSize > 0) $
$logInfoS "InjectFiles" [st|Injected #{tshow injectedFiles} files from upload cache into database (#{tshow injectedSize} bytes)|]
data RechunkFileException
@ -281,7 +283,7 @@ dispatchJobRechunkFiles = JobHandlerAtomic . hoist lift $ do
throwM $ RechunkFileExceptionHashMismatch fRef fRef'
return (Sum 1, Sum sz)
(Sum rechunkedEntries, Sum rechunkedSize) <- runConduit $
(Sum rechunkedFiles, Sum rechunkedSize) <- runConduit $
getEntryCandidates
.| C.mapMaybe (\(E.Value fRef, E.Value sz) -> (fRef, ) <$> sz)
.| maybe (C.map id) (takeWhileTime . (/ 2)) interval
@ -289,5 +291,5 @@ dispatchJobRechunkFiles = JobHandlerAtomic . hoist lift $ do
.| C.mapM (uncurry rechunkFile)
.| C.fold
when (rechunkedEntries > 0 || rechunkedSize > 0) $
$logInfoS "RechunkFiles" [st|Rechunked #{tshow rechunkedEntries} files in database (#{tshow rechunkedSize} bytes)|]
when (rechunkedFiles > 0 || rechunkedSize > 0) $
$logInfoS "RechunkFiles" [st|Rechunked #{tshow rechunkedFiles} files in database (#{tshow rechunkedSize} bytes)|]