remove stale live changes from reposize database
Reorganized the reposize database directory, and split up a column. checkStaleSizeChanges needs to run before needLiveUpdate, otherwise the process won't be holding a lock on its pid file, and another process could go in and expire the live update it records. It just so happens that they do get called in the correct order, since checking balanced preferred content calls getLiveRepoSizes before needLiveUpdate. The 1 minute delay between checks is arbitrary, but will avoid excess work. The downside of it is that, if a process is dropping a file and gets interrupted, for 1 minute another process can expect a repository will soon be smaller than it is. And so a process might send data to a repository when a file is not really going to be dropped from it. But note that can already happen if a drop takes some time in eg locking and then fails. So it seems possible that live updates should only be allowed to increase, rather than decrease the size of a repository.
This commit is contained in:
parent
278adbb726
commit
f89a1b8216
7 changed files with 199 additions and 83 deletions
|
@ -14,11 +14,11 @@ import Types.Key
|
|||
|
||||
import Control.Concurrent
|
||||
import Database.Persist.Sql hiding (Key)
|
||||
import qualified Data.Text as T
|
||||
import Data.Unique
|
||||
import Text.Read
|
||||
import System.Process (Pid)
|
||||
import Utility.Split
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- The current size of a repo.
|
||||
newtype RepoSize = RepoSize { fromRepoSize :: Integer }
|
||||
|
@ -62,36 +62,57 @@ instance PersistFieldSql SizeChange where
|
|||
sqlType _ = SqlInt32
|
||||
|
||||
data SizeChangeId = SizeChangeId
|
||||
{ sizeChangeUniqueId :: Int
|
||||
-- ^ unique per process
|
||||
, sizeChangeProcessId :: Integer
|
||||
-- ^ a pid, using Integer for portability
|
||||
{ sizeChangeUniqueId :: SizeChangeUniqueId
|
||||
, sizeChangeProcessId :: SizeChangeProcessId
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- A unique value for the current process.
|
||||
newtype SizeChangeUniqueId = SizeChangeUniqueId Int
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- A pid, using Integer for portability
|
||||
newtype SizeChangeProcessId = SizeChangeProcessId Integer
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
mkSizeChangeId :: Pid -> IO SizeChangeId
|
||||
mkSizeChangeId pid = do
|
||||
u <- newUnique
|
||||
return $ SizeChangeId
|
||||
{ sizeChangeProcessId = fromIntegral pid
|
||||
, sizeChangeUniqueId = hashUnique u
|
||||
{ sizeChangeUniqueId =
|
||||
SizeChangeUniqueId $ hashUnique u
|
||||
, sizeChangeProcessId =
|
||||
SizeChangeProcessId $ fromIntegral pid
|
||||
}
|
||||
|
||||
instance PersistField SizeChangeId where
|
||||
toPersistValue cid = toPersistValue $
|
||||
show (sizeChangeProcessId cid) ++ ":" ++
|
||||
show (sizeChangeUniqueId cid)
|
||||
instance PersistField SizeChangeUniqueId where
|
||||
toPersistValue (SizeChangeUniqueId i) = toPersistValue (show i)
|
||||
fromPersistValue b = fromPersistValue b >>= parse
|
||||
where
|
||||
parse s = maybe
|
||||
(Left $ T.pack $ "bad serialized SizeChangeId " ++ show s)
|
||||
(Left $ T.pack $ "bad serialized SizeChangeUniqueId " ++ show s)
|
||||
Right
|
||||
(parse' s)
|
||||
parse' s = case splitc ':' s of
|
||||
(pid:uid:[]) -> SizeChangeId
|
||||
<$> readMaybe pid
|
||||
<*> readMaybe uid
|
||||
_ -> Nothing
|
||||
(SizeChangeUniqueId <$> readMaybe s)
|
||||
|
||||
instance PersistFieldSql SizeChangeId where
|
||||
instance PersistFieldSql SizeChangeUniqueId where
|
||||
sqlType _ = SqlString
|
||||
|
||||
instance PersistField SizeChangeProcessId where
|
||||
toPersistValue (SizeChangeProcessId i) = toPersistValue (show i)
|
||||
fromPersistValue b = fromPersistValue b >>= parse
|
||||
where
|
||||
parse s = maybe
|
||||
(Left $ T.pack $ "bad serialized SizeChangeProcessId " ++ show s)
|
||||
Right
|
||||
(SizeChangeProcessId <$> readMaybe s)
|
||||
|
||||
instance PersistFieldSql SizeChangeProcessId where
|
||||
sqlType _ = SqlString
|
||||
|
||||
newtype StaleSizeChanger = StaleSizeChanger
|
||||
{ staleSizeChangerProcessId :: SizeChangeProcessId }
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
isStaleSizeChangeId :: S.Set StaleSizeChanger -> SizeChangeId -> Bool
|
||||
isStaleSizeChangeId s cid =
|
||||
StaleSizeChanger (sizeChangeProcessId cid) `S.member` s
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue