started work on getLiveRepoSizes

Doesn't quite compile
This commit is contained in:
Joey Hess 2024-08-26 14:50:09 -04:00
parent db89e39df6
commit 21608716bd
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 186 additions and 36 deletions

View file

@ -25,11 +25,10 @@ module Database.RepoSize (
closeDb,
getRepoSizes,
setRepoSizes,
getLiveSizeChanges,
getLiveRepoSizes,
startingLiveSizeChange,
successfullyFinishedLiveSizeChange,
staleLiveSizeChange,
getSizeChanges,
removeStaleLiveSizeChange,
) where
import Annex.Common
@ -46,7 +45,8 @@ import qualified Utility.RawFilePath as R
import Database.Persist.Sql hiding (Key)
import Database.Persist.TH
import qualified System.FilePath.ByteString as P
import qualified Data.Map as M
import qualified Data.Map.Strict as M
import qualified Data.Set as S
share [mkPersist sqlSettings, mkMigrate "migrateRepoSizes"] [persistLowerCase|
-- Corresponds to location log information from the git-annex branch.
@ -73,6 +73,13 @@ SizeChanges
repo UUID
rollingtotal FileSize
UniqueRepoRollingTotal repo
-- The most recent size changes that were removed from LiveSizeChanges
-- upon successful completion.
RecentChanges
repo UUID
key Key
change SizeChange
UniqueRecentChange repo key
|]
{- Gets a handle to the database. It's cached in Annex state. -}
@ -115,19 +122,21 @@ closeDb :: RepoSizeHandle -> Annex ()
closeDb (RepoSizeHandle (Just h)) = liftIO $ H.closeDb h
closeDb (RepoSizeHandle Nothing) = noop
{- Gets the sizes of repositories as of a commit to the git-annex
- branch. -}
getRepoSizes :: RepoSizeHandle -> IO (M.Map UUID RepoSize, Maybe Sha)
getRepoSizes (RepoSizeHandle (Just h)) = H.queryDb h $ do
sizemap <- M.fromList . map conv <$> getRepoSizes'
sizemap <- M.fromList <$> getRepoSizes'
annexbranchsha <- getAnnexBranchCommit
return (sizemap, annexbranchsha)
getRepoSizes (RepoSizeHandle Nothing) = return (mempty, Nothing)
getRepoSizes' :: SqlPersistM [(UUID, RepoSize)]
getRepoSizes' = map conv <$> selectList [] []
where
conv entity =
let RepoSizes u sz = entityVal entity
in (u, RepoSize sz)
getRepoSizes (RepoSizeHandle Nothing) = return (mempty, Nothing)
getRepoSizes' :: SqlPersistM [Entity RepoSizes]
getRepoSizes' = selectList [] []
getAnnexBranchCommit :: SqlPersistM (Maybe Sha)
getAnnexBranchCommit = do
@ -149,8 +158,8 @@ getAnnexBranchCommit = do
setRepoSizes :: RepoSizeHandle -> M.Map UUID RepoSize -> Sha -> IO ()
setRepoSizes (RepoSizeHandle (Just h)) sizemap branchcommitsha =
H.commitDb h $ do
l <- getRepoSizes'
forM_ (map entityVal l) $ \(RepoSizes u _) ->
l <- getRepoSizes'
forM_ (map fst l) $ \u ->
unless (M.member u sizemap) $
unsetRepoSize u
forM_ (M.toList sizemap) $
@ -173,8 +182,6 @@ recordAnnexBranchCommit branchcommitsha = do
deleteWhere ([] :: [Filter AnnexBranch])
void $ insertUniqueFast $ AnnexBranch $ toSSha branchcommitsha
{- If there is already a size change for the same UUID, Key,
- and SizeChangeId, it is overwritten with the new size change. -}
startingLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
startingLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
H.commitDb h $ void $ upsertBy
@ -188,10 +195,11 @@ startingLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
successfullyFinishedLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
successfullyFinishedLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
H.commitDb h $ do
-- Update the rolling total and remove the live change in the
-- same transaction.
-- Update the rolling total, add as a recent change,
-- and remove the live change in the same transaction.
rollingtotal <- getSizeChangeFor u
setSizeChangeFor u (updaterollingtotal rollingtotal)
setSizeChangeFor u (updateRollingTotal rollingtotal sc k)
addRecentChange u k sc
removeLiveSizeChange u k sc sid
where
updaterollingtotal t = case sc of
@ -200,10 +208,17 @@ successfullyFinishedLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
ksz = fromMaybe 0 $ fromKey keySize k
successfullyFinishedLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
staleLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
staleLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
updateRollingTotal :: FileSize -> SizeChange -> Key -> FileSize
updateRollingTotal t sc k = case sc of
AddingKey -> t + ksz
RemovingKey -> t - ksz
where
ksz = fromMaybe 0 $ fromKey keySize k
removeStaleLiveSizeChange :: RepoSizeHandle -> UUID -> Key -> SizeChange -> SizeChangeId -> IO ()
removeStaleLiveSizeChange (RepoSizeHandle (Just h)) u k sc sid =
H.commitDb h $ removeLiveSizeChange u k sc sid
staleLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
removeStaleLiveSizeChange (RepoSizeHandle Nothing) _ _ _ _ = noop
removeLiveSizeChange :: UUID -> Key -> SizeChange -> SizeChangeId -> SqlPersistM ()
removeLiveSizeChange u k sc sid =
@ -214,25 +229,15 @@ removeLiveSizeChange u k sc sid =
, LiveSizeChangesChange ==. sc
]
getLiveSizeChanges :: RepoSizeHandle -> IO (M.Map UUID (Key, SizeChange, SizeChangeId))
getLiveSizeChanges (RepoSizeHandle (Just h)) = H.queryDb h $ do
m <- M.fromList . map conv <$> getLiveSizeChanges'
return m
getLiveSizeChanges :: SqlPersistM (M.Map UUID [(Key, (SizeChange, SizeChangeId))])
getLiveSizeChanges = M.fromListWith (++) . map conv <$> selectList [] []
where
conv entity =
let LiveSizeChanges u k sid sc = entityVal entity
in (u, (k, sc, sid))
getLiveSizeChanges (RepoSizeHandle Nothing) = return mempty
in (u, [(k, (sc, sid))])
getLiveSizeChanges' :: SqlPersistM [Entity LiveSizeChanges]
getLiveSizeChanges' = selectList [] []
getSizeChanges :: RepoSizeHandle -> IO (M.Map UUID FileSize)
getSizeChanges (RepoSizeHandle (Just h)) = H.queryDb h getSizeChanges'
getSizeChanges (RepoSizeHandle Nothing) = return mempty
getSizeChanges' :: SqlPersistM (M.Map UUID FileSize)
getSizeChanges' = M.fromList . map conv <$> selectList [] []
getSizeChanges :: SqlPersistM (M.Map UUID FileSize)
getSizeChanges = M.fromList . map conv <$> selectList [] []
where
conv entity =
let SizeChanges u n = entityVal entity
@ -251,3 +256,96 @@ setSizeChangeFor u sz =
(UniqueRepoRollingTotal u)
(SizeChanges u sz)
[SizeChangesRollingtotal =. sz]
addRecentChange :: UUID -> Key -> SizeChange -> SqlPersistM ()
addRecentChange u k sc =
void $ upsertBy
(UniqueRecentChange u k)
(RecentChanges u k sc)
[RecentChangesChange =. sc]
getRecentChange :: UUID -> Key -> SqlPersistM (Maybe SizeChange)
getRecentChange u k = do
l <- selectList
[ RecentChangesRepo ==. u
, RecentChangesKey ==. k
] []
return $ case l of
(s:_) -> Just $ recentChangesChange $ entityVal s
[] -> Nothing
{- Gets the sizes of Repos as of a commit to the git-annex branch
- (which is not necessarily the current commit), adjusted with all
- live changes that have happened since then or are happening now.
-
- This does not necessarily include all changes that have been journalled,
- only ones that had startingLiveSizeChange called for them will be
- included. Also live changes or recent changes that were to a UUID not in
- the RepoSizes map are not included.
-
- In the unlikely case where two live changes are occurring, one
- adding a key and the other removing the same key, the one
- 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.
-
- 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 (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)
where
go
:: M.Map UUID FileSize
-> M.Map UUID [(Key, (SizeChange, SizeChangeId))]
-> (UUID, RepoSize)
-> SqlPersistM (UUID, RepoSize)
go sizechanges livechanges (u, RepoSize startsize) = do
let livechangesbykey =
M.fromListWith (++) $ maybe [] (\v -> [v]) $
M.lookup u livechanges
livechanges' <- combinelikelivechanges <$>
filterM (nonredundantlivechange livechangesbykey u)
(fromMaybe [] $ M.lookup u livechanges)
let sizechange = foldl'
(\t (k, sc) -> updateRollingTotal t sc k)
(fromMaybe 0 (M.lookup u sizechanges))
livechanges'
return (u, RepoSize (startsize + sizechange))
combinelikelivechanges =
S.elems
. S.fromList
. map (\(k, (sc, _)) -> (k, sc))
nonredundantlivechange
:: M.Map Key [(SizeChange, SizeChangeId)]
-> UUID
-> (Key, (SizeChange, SizeChangeId))
-> SqlPersistM Bool
nonredundantlivechange livechangesbykey u (k, (sc, cid))
| null (competinglivechanges livechangesbykey k sc cid) =
getRecentChange u k >>= pure . \case
Nothing -> True
Just sc' -> sc /= sc'
| otherwise = pure False
competinglivechanges
:: M.Map Key [(SizeChange, SizeChangeId)]
-> Key
-> SizeChange
-> SizeChangeId
-> [(SizeChange, SizeChangeId)]
competinglivechanges livechangesbykey k RemovingKey cid =
filter (\(sc', cid') -> cid /= cid' && sc' == AddingKey)
(fromMaybe [] $ M.lookup k livechangesbykey)
competinglivechanges _ _ AddingKey _ = []
getLiveRepoSizes (RepoSizeHandle Nothing) = return mempty