plumb in LiveUpdate (WIP)
Each command that first checks preferred content (and/or required content) and then does something that can change the sizes of repositories needs to call prepareLiveUpdate, and plumb it through the preferred content check and the location log update. So far, only Command.Drop is done. Many other commands that don't need to do this have been updated to keep working. There may be some calls to NoLiveUpdate in places where that should be done. All will need to be double checked. Not currently in a compilable state.
This commit is contained in:
parent
4885073377
commit
c3d40b9ec3
58 changed files with 363 additions and 247 deletions
|
@ -11,6 +11,7 @@ import Types.UUID (UUID)
|
|||
import Types.Key (Key)
|
||||
import Types.Link (LinkType)
|
||||
import Types.Mime
|
||||
import Types.RepoSize (LiveUpdate)
|
||||
import Utility.Matcher (Matcher, Token, MatchDesc)
|
||||
import Utility.FileSize
|
||||
import Utility.FileSystemEncoding
|
||||
|
@ -85,7 +86,7 @@ type MkLimit a = String -> Either String (MatchFiles a)
|
|||
type AssumeNotPresent = S.Set UUID
|
||||
|
||||
data MatchFiles a = MatchFiles
|
||||
{ matchAction :: AssumeNotPresent -> MatchInfo -> a Bool
|
||||
{ matchAction :: LiveUpdate -> AssumeNotPresent -> MatchInfo -> a Bool
|
||||
, matchNeedsFileName :: Bool
|
||||
-- ^ does the matchAction need a filename in order to match?
|
||||
, matchNeedsFileContent :: Bool
|
||||
|
|
|
@ -5,10 +5,17 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
|
||||
|
||||
module Types.RepoSize where
|
||||
|
||||
import Types.UUID
|
||||
import Types.Key
|
||||
|
||||
import Control.Concurrent
|
||||
import Database.Persist.Sql hiding (Key)
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- The current size of a repo.
|
||||
newtype RepoSize = RepoSize { fromRepoSize :: Integer }
|
||||
deriving (Show, Eq, Ord, Num)
|
||||
|
@ -16,3 +23,35 @@ newtype RepoSize = RepoSize { fromRepoSize :: Integer }
|
|||
-- The maximum size of a repo.
|
||||
newtype MaxSize = MaxSize { fromMaxSize :: Integer }
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- Used when an action is in progress that will change the current size of
|
||||
-- a repository.
|
||||
--
|
||||
-- The live update has been recorded as starting, and filling the MVar with
|
||||
-- the correct UUID, Key, and SizeChange will record the live update
|
||||
-- as complete. The Bool should be True when the action successfully
|
||||
-- added/removed the key from the repository.
|
||||
--
|
||||
-- If the MVar gets garbage collected before it is filled, the live update
|
||||
-- will be removed.
|
||||
--
|
||||
-- This allows other concurrent changes to the same repository take
|
||||
-- the changes to its size into account. If NoLiveUpdate is used, it
|
||||
-- prevents that.
|
||||
data LiveUpdate
|
||||
= LiveUpdate (MVar ()) (MVar (Bool, UUID, Key, SizeChange))
|
||||
| NoLiveUpdate
|
||||
|
||||
data SizeChange = AddingKey | RemovingKey
|
||||
deriving (Show, Eq)
|
||||
|
||||
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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue