fix(file-jobs): improve log messages
This commit is contained in:
parent
e5ae1521a0
commit
e099e13816
@ -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)|]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user