diff --git a/Annex/RepoSize/LiveUpdate.hs b/Annex/RepoSize/LiveUpdate.hs index 5b68f9f81c..5d015b2585 100644 --- a/Annex/RepoSize/LiveUpdate.hs +++ b/Annex/RepoSize/LiveUpdate.hs @@ -64,16 +64,17 @@ prepareLiveUpdate mu k sc = do where {- Wait for checkLiveUpdate to request a start, or for the - LiveUpdate to get garbage collected in the case where - - it is not needed. -} + - it is not needed. + - + - Deferring updating the database until here avoids overhead + - except in cases where preferred content expressions + - need live updates. + -} waitstart startv readyv donev h u = tryNonAsync (takeMVar startv) >>= \case Right () -> do pid <- getCurrentPid cid <- mkSizeChangeId pid - {- Deferring updating the database until - - here avoids overhead except in cases - - where preferred content expressions - - need live updates. -} Db.startingLiveSizeChange h u k sc cid putMVar readyv () waitdone donev h u cid @@ -82,17 +83,18 @@ prepareLiveUpdate mu k sc = do {- Wait for finishedLiveUpdate to be called, or for the LiveUpdate - to get garbage collected in the case where the change didn't - actually happen. Updates the database. -} - waitdone donev finishv h u cid = tryNonAsync (takeMVar donev) >>= \case + waitdone donev h u cid = tryNonAsync (takeMVar donev) >>= \case Right (Just (u', k', sc', finishv)) | u' == u && k' == k && sc' == sc -> do Db.successfullyFinishedLiveSizeChange h u k sc cid putMVar finishv () - -- This can happen when eg, storing to a cluster + -- Not the update we were expecting. This can + -- happen when eg, storing to a cluster -- causes fanout and so this is called with -- other UUIDs. | otherwise -> do putMVar finishv () - waitdone donev finishv h u cid + waitdone donev h u cid Right Nothing -> abandoned h u cid Left _ -> abandoned h u cid abandoned h u cid = Db.removeStaleLiveSizeChange h u k sc cid diff --git a/Database/RepoSize.hs b/Database/RepoSize.hs index 8c6c1b66bc..b8e9608482 100644 --- a/Database/RepoSize.hs +++ b/Database/RepoSize.hs @@ -201,11 +201,6 @@ successfullyFinishedLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid = setSizeChangeFor u (updateRollingTotal rollingtotal sc k) addRecentChange u k sc removeLiveSizeChange u k sc sid - where - updaterollingtotal t = case sc of - AddingKey -> t + ksz - RemovingKey -> t - ksz - ksz = fromMaybe 0 $ fromKey keySize k successfullyFinishedLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop updateRollingTotal :: FileSize -> SizeChange -> Key -> FileSize @@ -288,20 +283,25 @@ getRecentChange u k = do - adding the key is used, in order to err on the side of a larger - RepoSize. - - - Omits live changes that are redundant due to a recent change already - - being recorded for the same change. + - In the case where the same live change is recorded by two different + - processes or threads, the first to complete will record it as a recent + - change. This omits live changes that are redundant due to a recent + - change already being recorded for the same change. - - This is only expensive when there are a lot of live changes happening at - the same time. -} -getLiveRepoSizes :: RepoSizeHandle -> IO (M.Map UUID RepoSize, Maybe Sha) +getLiveRepoSizes :: RepoSizeHandle -> IO (Maybe (M.Map UUID RepoSize, Sha)) getLiveRepoSizes (RepoSizeHandle (Just h)) = H.queryDb h $ do - sizechanges <- getSizeChanges - livechanges <- getLiveSizeChanges - reposizes <- getRepoSizes' - annexbranchsha <- getAnnexBranchCommit - m <- M.fromList <$> forM reposizes (go sizechanges livechanges) - return (m, annexbranchsha) + getAnnexBranchCommit >>= \case + Nothing -> return Nothing + Just annexbranchsha -> do + sizechanges <- getSizeChanges + livechanges <- getLiveSizeChanges + reposizes <- getRepoSizes' + m <- M.fromList <$> forM reposizes + (go sizechanges livechanges) + return (Just (m, annexbranchsha)) where go :: M.Map UUID FileSize @@ -310,8 +310,10 @@ getLiveRepoSizes (RepoSizeHandle (Just h)) = H.queryDb h $ do -> SqlPersistM (UUID, RepoSize) go sizechanges livechanges (u, RepoSize startsize) = do let livechangesbykey = - M.fromListWith (++) $ maybe [] (\v -> [v]) $ - M.lookup u livechanges + M.fromListWith (++) $ + map (\(k, v) -> (k, [v])) $ + fromMaybe [] $ + M.lookup u livechanges livechanges' <- combinelikelivechanges <$> filterM (nonredundantlivechange livechangesbykey u) (fromMaybe [] $ M.lookup u livechanges) @@ -348,4 +350,4 @@ getLiveRepoSizes (RepoSizeHandle (Just h)) = H.queryDb h $ do filter (\(sc', cid') -> cid /= cid' && sc' == AddingKey) (fromMaybe [] $ M.lookup k livechangesbykey) competinglivechanges _ _ AddingKey _ = [] -getLiveRepoSizes (RepoSizeHandle Nothing) = return mempty +getLiveRepoSizes (RepoSizeHandle Nothing) = return Nothing diff --git a/Types/RepoSize.hs b/Types/RepoSize.hs index 8b2ba0aa74..b113924669 100644 --- a/Types/RepoSize.hs +++ b/Types/RepoSize.hs @@ -44,7 +44,7 @@ data LiveUpdate | NoLiveUpdate data SizeChange = AddingKey | RemovingKey - deriving (Show, Eq) + deriving (Show, Eq, Ord) instance PersistField SizeChange where toPersistValue AddingKey = toPersistValue (1 :: Int)