fixed the build

Manually tested getLiveRepoSizes and it is working correctly.
This commit is contained in:
Joey Hess 2024-08-27 09:18:25 -04:00
parent 521e0a7062
commit d7813876a0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 30 additions and 26 deletions

View file

@ -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

View file

@ -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

View file

@ -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)