fixed the build
Manually tested getLiveRepoSizes and it is working correctly.
This commit is contained in:
parent
521e0a7062
commit
d7813876a0
3 changed files with 30 additions and 26 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue