From 99a126bebb8d665fa4aee91954b30cf3555aead9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 12 Aug 2024 11:19:58 -0400 Subject: [PATCH] added reposize database The idea is that upon a merge of the git-annex branch, or a commit to the git-annex branch, the reposize database will be updated. So it should always accurately reflect the location log sizes, but it will often be behind the actual current sizes. Annex.reposizes will start with the value from the database, and get updated with each transfer, so it will reflect a process's best understanding of the current sizes. When there are multiple processes all transferring to the same repo, Annex.reposize will not reflect transfers made by the other processes since the current process started. So when using balanced preferred content, it may make suboptimal choices, including trying to transfer content to the repo when another process has already filled it up. But this is the same as if there are multiple processes running on ifferent machines, so is acceptable. The reposize will eventually get an accurate value reflecting changes made by other processes or in other repos. --- Annex.hs | 4 +- Annex/Locations.hs | 6 +++ Database/Queue.hs | 1 + Database/RepoSize.hs | 101 +++++++++++++++++++++++++++++++++++++++++++ Logs/MaxSize.hs | 2 +- Types/MaxSize.hs | 11 ----- Types/RepoSize.hs | 16 +++++++ git-annex.cabal | 3 +- 8 files changed, 130 insertions(+), 14 deletions(-) create mode 100644 Database/RepoSize.hs delete mode 100644 Types/MaxSize.hs create mode 100644 Types/RepoSize.hs diff --git a/Annex.hs b/Annex.hs index 102471998d..1de9c234f8 100644 --- a/Annex.hs +++ b/Annex.hs @@ -75,7 +75,7 @@ import Types.RemoteConfig import Types.TransferrerPool import Types.VectorClock import Types.Cluster -import Types.MaxSize +import Types.RepoSize import Annex.VectorClock.Utility import Annex.Debug.Utility import qualified Database.Keys.Handle as Keys @@ -202,6 +202,7 @@ data AnnexState = AnnexState , remoteconfigmap :: Maybe (M.Map UUID RemoteConfig) , clusters :: Maybe (Annex Clusters) , maxsizes :: Maybe (M.Map UUID MaxSize) + , reposizes :: Maybe (M.Map UUID RepoSize) , forcetrust :: TrustMap , trustmap :: Maybe TrustMap , groupmap :: Maybe GroupMap @@ -257,6 +258,7 @@ newAnnexState c r = do , remoteconfigmap = Nothing , clusters = Nothing , maxsizes = Nothing + , reposizes = Nothing , forcetrust = M.empty , trustmap = Nothing , groupmap = Nothing diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 6f6203cfa2..2605f74651 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -75,6 +75,7 @@ module Annex.Locations ( gitAnnexContentIdentifierLock, gitAnnexImportFeedDbDir, gitAnnexImportFeedDbLock, + gitAnnexRepoSizeDbDir, gitAnnexScheduleState, gitAnnexTransferDir, gitAnnexCredsDir, @@ -515,6 +516,11 @@ gitAnnexImportFeedDbDir r c = gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> RawFilePath gitAnnexImportFeedDbLock r c = gitAnnexImportFeedDbDir r c <> ".lck" +{- Directory containing reposize database. -} +gitAnnexRepoSizeDbDir :: Git.Repo -> GitConfig -> RawFilePath +gitAnnexRepoSizeDbDir r c = + fromMaybe (gitAnnexDir r) (annexDbDir c) P. "reposize" + {- .git/annex/schedulestate is used to store information about when - scheduled jobs were last run. -} gitAnnexScheduleState :: Git.Repo -> RawFilePath diff --git a/Database/Queue.hs b/Database/Queue.hs index f4882d2fa8..8e941fa66c 100644 --- a/Database/Queue.hs +++ b/Database/Queue.hs @@ -14,6 +14,7 @@ module Database.Queue ( closeDbQueue, flushDbQueue, QueueSize, + LastCommitTime, queueDb, ) where diff --git a/Database/RepoSize.hs b/Database/RepoSize.hs new file mode 100644 index 0000000000..c4a6814e1a --- /dev/null +++ b/Database/RepoSize.hs @@ -0,0 +1,101 @@ +{- Sqlite database used to track the sizes of repositories. + - + - Copyright 2024 Joey Hess + -: + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DataKinds, FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeOperators #-} +#if MIN_VERSION_persistent_template(2,8,0) +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE StandaloneDeriving #-} +#endif + +module Database.RepoSize ( + RepoSizeHandle, + openDb, + closeDb, + getRepoSizes, + setRepoSize, + updateRepoSize, +) where + +import Types.RepoSize +import Database.Types () +import qualified Database.Queue as H +import Database.Init +import Annex.Locations +import Annex.Common +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 + +newtype RepoSizeHandle = RepoSizeHandle H.DbQueue + +share [mkPersist sqlSettings, mkMigrate "migrateRepoSizes"] [persistLowerCase| +RepoSizes + repo UUID + size Integer + UniqueRepo repo +|] + +{- Opens the database, creating it if it doesn't exist yet. + - + - No locking is done by this, so caller must prevent multiple processes + - running this at the same time. + -} +openDb :: Annex RepoSizeHandle +openDb = do + dbdir <- calcRepo' gitAnnexRepoSizeDbDir + let db = dbdir P. "db" + unlessM (liftIO $ R.doesPathExist db) $ do + initDb db $ void $ + runMigrationSilent migrateRepoSizes + h <- liftIO $ H.openDbQueue db "reposizes" + return $ RepoSizeHandle h + +closeDb :: RepoSizeHandle -> Annex () +closeDb (RepoSizeHandle h) = liftIO $ H.closeDbQueue h + +{- Doesn't see changes that were just made with setRepoSize or + - updateRepoSize before flushing the queue. -} +getRepoSizes :: RepoSizeHandle -> IO (M.Map UUID RepoSize) +getRepoSizes (RepoSizeHandle h) = H.queryDbQueue h $ + M.fromList . map conv <$> getRepoSizes' + where + conv entity = + let RepoSizes u sz = entityVal entity + in (u, RepoSize sz) + +getRepoSizes' :: SqlPersistM [Entity RepoSizes] +getRepoSizes' = selectList [] [] + +setRepoSize :: UUID -> RepoSize -> RepoSizeHandle -> IO () +setRepoSize u (RepoSize sz) (RepoSizeHandle h) = H.queueDb h checkCommit $ + void $ upsertBy + (UniqueRepo u) + (RepoSizes u sz) + [RepoSizesSize =. sz] + +{- Applies an offset to the size. If no size is recorded for the repo, does + - nothing. -} +updateRepoSize :: UUID -> Integer -> RepoSizeHandle -> IO () +updateRepoSize u offset (RepoSizeHandle h) = H.queueDb h checkCommit $ + void $ updateWhere + [RepoSizesRepo ==. u] + [RepoSizesSize +=. offset] + +checkCommit :: H.QueueSize -> H.LastCommitTime -> IO Bool +checkCommit sz _lastcommittime + | sz > 1000 = return True + | otherwise = return False diff --git a/Logs/MaxSize.hs b/Logs/MaxSize.hs index 097cf71514..d1d65a670b 100644 --- a/Logs/MaxSize.hs +++ b/Logs/MaxSize.hs @@ -13,7 +13,7 @@ module Logs.MaxSize ( import qualified Annex import Annex.Common -import Types.MaxSize +import Types.RepoSize import Logs import Logs.UUIDBased import Logs.MapLog diff --git a/Types/MaxSize.hs b/Types/MaxSize.hs deleted file mode 100644 index bddcce5251..0000000000 --- a/Types/MaxSize.hs +++ /dev/null @@ -1,11 +0,0 @@ -{- git-annex maxsize type - - - - Copyright 2024 Joey Hess - - - - Licensed under the GNU AGPL version 3 or higher. - -} - -module Types.MaxSize where - -newtype MaxSize = MaxSize Integer - deriving (Show, Eq, Ord) diff --git a/Types/RepoSize.hs b/Types/RepoSize.hs new file mode 100644 index 0000000000..33c5da616b --- /dev/null +++ b/Types/RepoSize.hs @@ -0,0 +1,16 @@ +{- git-annex repo sizes types + - + - Copyright 2024 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Types.RepoSize where + +-- The current size of a repo. +newtype RepoSize = RepoSize Integer + deriving (Show, Eq, Ord) + +-- The maximum size of a repo. +newtype MaxSize = MaxSize Integer + deriving (Show, Eq, Ord) diff --git a/git-annex.cabal b/git-annex.cabal index bcfb668268..713c9e658c 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -783,6 +783,7 @@ Executable git-annex Database.Keys.SQL Database.Queue Database.RawFilePath + Database.RepoSize Database.Types Database.Utility Git @@ -988,7 +989,6 @@ Executable git-annex Types.KeySource Types.Link Types.LockCache - Types.MaxSize Types.Messages Types.MetaData Types.Mime @@ -998,6 +998,7 @@ Executable git-annex Types.Remote Types.RemoteConfig Types.RemoteState + Types.RepoSize Types.RepoVersion Types.ScheduledActivity Types.StandardGroups -- 2.30.2