add live size changes to RepoSize database

Not yet used.
This commit is contained in:
Joey Hess 2024-08-23 12:51:00 -04:00
parent dad1fb150f
commit 4885073377
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 54 additions and 0 deletions

View file

@ -6,6 +6,7 @@
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
@ -24,6 +25,9 @@ module Database.RepoSize (
closeDb, closeDb,
getRepoSizes, getRepoSizes,
setRepoSizes, setRepoSizes,
getLiveSizeChanges,
startingLiveSizeChange,
finishedLiveSizeChange,
) where ) where
import Annex.Common import Annex.Common
@ -40,6 +44,7 @@ import Database.Persist.Sql hiding (Key)
import Database.Persist.TH import Database.Persist.TH
import qualified System.FilePath.ByteString as P import qualified System.FilePath.ByteString as P
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Text as T
newtype RepoSizeHandle = RepoSizeHandle (Maybe H.DbHandle) newtype RepoSizeHandle = RepoSizeHandle (Maybe H.DbHandle)
@ -53,6 +58,12 @@ RepoSizes
AnnexBranch AnnexBranch
commit SSha commit SSha
UniqueCommit commit UniqueCommit commit
-- Changes that are currently being made that affect repo sizes.
LiveSizeChanges
repo UUID
key Key
change SizeChange
UniqueLiveSizeChange repo key
|] |]
{- Opens the database, creating it if it doesn't exist yet. {- Opens the database, creating it if it doesn't exist yet.
@ -143,3 +154,45 @@ recordAnnexBranchCommit :: Sha -> SqlPersistM ()
recordAnnexBranchCommit branchcommitsha = do recordAnnexBranchCommit branchcommitsha = do
deleteWhere ([] :: [Filter AnnexBranch]) deleteWhere ([] :: [Filter AnnexBranch])
void $ insertUniqueFast $ AnnexBranch $ toSSha branchcommitsha void $ insertUniqueFast $ AnnexBranch $ toSSha branchcommitsha
data SizeChange = AddingKey | RemovingKey
{- If there is already a size change for the same UUID and Key, it is
- overwritten with the new size change. -}
startingLiveSizeChange :: UUID -> Key -> SizeChange -> SqlPersistM ()
startingLiveSizeChange u k sc =
void $ upsertBy
(UniqueLiveSizeChange u k)
(LiveSizeChanges u k sc)
[LiveSizeChangesChange =. sc]
finishedLiveSizeChange :: UUID -> Key -> SizeChange -> SqlPersistM ()
finishedLiveSizeChange u k sc = deleteWhere
[ LiveSizeChangesRepo ==. u
, LiveSizeChangesKey ==. k
, LiveSizeChangesChange ==. sc
]
getLiveSizeChanges :: RepoSizeHandle -> IO (M.Map UUID (Key, SizeChange))
getLiveSizeChanges (RepoSizeHandle (Just h)) = H.queryDb h $ do
m <- M.fromList . map conv <$> getLiveSizeChanges'
return m
where
conv entity =
let LiveSizeChanges u k sc = entityVal entity
in (u, (k, sc))
getLiveSizeChanges (RepoSizeHandle Nothing) = return mempty
getLiveSizeChanges' :: SqlPersistM [Entity LiveSizeChanges]
getLiveSizeChanges' = selectList [] []
instance PersistField SizeChange where
toPersistValue AddingKey = toPersistValue (1 :: Int)
toPersistValue RemovingKey = toPersistValue (-1 :: Int)
fromPersistValue b = fromPersistValue b >>= \case
(1 :: Int) -> Right AddingKey
-1 -> Right RemovingKey
v -> Left $ T.pack $ "bad serialized SizeChange "++ show v
instance PersistFieldSql SizeChange where
sqlType _ = SqlInt32

View file

@ -79,6 +79,7 @@ Planned schedule of work:
Add to reposizes db a table for live updates. Add to reposizes db a table for live updates.
Listing process ID, thread ID, UUID, key, addition or removal Listing process ID, thread ID, UUID, key, addition or removal
(done)
Make checking the balanced preferred content limit record a Make checking the balanced preferred content limit record a
live update in the table and use other live updates in making its live update in the table and use other live updates in making its