99a126bebb
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.
101 lines
2.9 KiB
Haskell
101 lines
2.9 KiB
Haskell
{- Sqlite database used to track the sizes of repositories.
|
|
-
|
|
- Copyright 2024 Joey Hess <id@joeyh.name>
|
|
-:
|
|
- 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
|