avoid duplicates building up in outManifest
Happened exponentially since commit 1a3c60cc8e
This commit is contained in:
parent
58301e40d2
commit
cb59ec3efc
2 changed files with 30 additions and 17 deletions
|
@ -270,8 +270,10 @@ fullPush st rmt refs = guardPush st $ do
|
|||
(manifestCache st)
|
||||
let bs = map Git.Bundle.fullBundleSpec refs
|
||||
(bundlekey, uploadbundle) <- generateGitBundle rmt bs oldmanifest
|
||||
let manifest = mkManifest [bundlekey]
|
||||
(inManifest oldmanifest ++ outManifest oldmanifest)
|
||||
let manifest = mkManifest [bundlekey] $
|
||||
S.fromList (inManifest oldmanifest)
|
||||
`S.union`
|
||||
outManifest oldmanifest
|
||||
manifest' <- startPush rmt manifest
|
||||
uploadbundle
|
||||
uploadManifest rmt manifest'
|
||||
|
@ -292,7 +294,7 @@ incrementalPush st rmt oldtrackingrefs newtrackingrefs = guardPush st $ do
|
|||
oldmanifest <- maybe (downloadManifestWhenPresent rmt) pure (manifestCache st)
|
||||
bs <- calc [] (M.toList newtrackingrefs)
|
||||
(bundlekey, uploadbundle) <- generateGitBundle rmt bs oldmanifest
|
||||
let manifest = oldmanifest <> mkManifest [bundlekey] []
|
||||
let manifest = oldmanifest <> mkManifest [bundlekey] mempty
|
||||
manifest' <- startPush rmt manifest
|
||||
uploadbundle
|
||||
uploadManifest rmt manifest'
|
||||
|
@ -361,8 +363,10 @@ pushEmpty :: State -> Remote -> Annex (Bool, State)
|
|||
pushEmpty st rmt = guardPush st $ do
|
||||
oldmanifest <- maybe (downloadManifestWhenPresent rmt) pure
|
||||
(manifestCache st)
|
||||
let manifest = mkManifest mempty
|
||||
(inManifest oldmanifest ++ outManifest oldmanifest)
|
||||
let manifest = mkManifest mempty $
|
||||
S.fromList (inManifest oldmanifest)
|
||||
`S.union`
|
||||
outManifest oldmanifest
|
||||
(manifest', manifestwriter) <- startPush' rmt manifest
|
||||
manifest'' <- dropOldKeys rmt manifest'
|
||||
manifestwriter manifest''
|
||||
|
@ -534,14 +538,15 @@ formatManifest manifest =
|
|||
B8.unlines $
|
||||
map serializeKey' (inManifest manifest)
|
||||
<>
|
||||
map (\k -> "-" <> serializeKey' k) (outManifest manifest)
|
||||
map (\k -> "-" <> serializeKey' k)
|
||||
(S.toList (outManifest manifest))
|
||||
|
||||
parseManifest :: B.ByteString -> Either String Manifest
|
||||
parseManifest b =
|
||||
let (outks, inks) = partitionEithers $ map parseline $ B8.lines b
|
||||
in case (checkvalid [] inks, checkvalid [] outks) of
|
||||
(Right inks', Right outks') ->
|
||||
Right $ mkManifest inks' outks'
|
||||
Right $ mkManifest inks' (S.fromList outks')
|
||||
(Left err, _) -> Left err
|
||||
(_, Left err) -> Left err
|
||||
where
|
||||
|
@ -714,8 +719,11 @@ startPush' rmt manifest = do
|
|||
fromRight mempty . parseManifest
|
||||
<$> B.readFile (fromRawFilePath f)
|
||||
`catchNonAsync` (const (pure mempty))
|
||||
let manifest' = manifest <> mkManifest []
|
||||
(inManifest oldmanifest ++ outManifest oldmanifest)
|
||||
let oldmanifest' = mkManifest [] $
|
||||
S.fromList (inManifest oldmanifest)
|
||||
`S.union`
|
||||
outManifest oldmanifest
|
||||
let manifest' = manifest <> oldmanifest'
|
||||
let writer = writeLogFile f . decodeBS . formatManifest
|
||||
return (manifest', writer)
|
||||
|
||||
|
@ -726,8 +734,9 @@ startPush' rmt manifest = do
|
|||
-- in the outManifest, so the drop will be tried again later.
|
||||
dropOldKeys :: Remote -> Manifest -> Annex Manifest
|
||||
dropOldKeys rmt manifest =
|
||||
mkManifest (inManifest manifest)
|
||||
<$> filterM (not <$$> dropKey rmt) (outManifest manifest)
|
||||
mkManifest (inManifest manifest) . S.fromList
|
||||
<$> filterM (not <$$> dropKey rmt)
|
||||
(S.toList (outManifest manifest))
|
||||
|
||||
-- When pushEmpty raced with another push, it could result in the manifest
|
||||
-- listing bundles that it deleted. Such a manifest has to be treated the
|
||||
|
@ -737,7 +746,10 @@ verifyManifest :: Remote -> Manifest -> Annex Manifest
|
|||
verifyManifest rmt manifest =
|
||||
ifM (allM (checkPresentGitBundle rmt) (inManifest manifest))
|
||||
( return manifest
|
||||
, return $ mkManifest [] (inManifest manifest <> outManifest manifest)
|
||||
, return $ mkManifest [] $
|
||||
S.fromList (inManifest manifest)
|
||||
`S.union`
|
||||
outManifest manifest
|
||||
)
|
||||
|
||||
-- Downloads a git bundle to the annex objects directory, unless
|
||||
|
|
|
@ -15,6 +15,7 @@ module Types.GitRemoteAnnex
|
|||
import Types.Key
|
||||
|
||||
import qualified Data.Semigroup as Sem
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- The manifest contains an ordered list of git bundle keys.
|
||||
--
|
||||
|
@ -24,21 +25,21 @@ import qualified Data.Semigroup as Sem
|
|||
data Manifest =
|
||||
Manifest
|
||||
{ inManifest :: [Key]
|
||||
, outManifest :: [Key]
|
||||
, outManifest :: S.Set Key
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
-- Smart constructor for Manifest. Preserves outManifest invariant.
|
||||
mkManifest
|
||||
:: [Key] -- ^ inManifest
|
||||
-> [Key] -- ^ outManifest
|
||||
-> S.Set Key -- ^ outManifest
|
||||
-> Manifest
|
||||
mkManifest inks outks = Manifest inks (filter (`notElem` inks) outks)
|
||||
mkManifest inks outks = Manifest inks (S.filter (`notElem` inks) outks)
|
||||
|
||||
instance Monoid Manifest where
|
||||
mempty = Manifest [] []
|
||||
mempty = Manifest mempty mempty
|
||||
|
||||
instance Sem.Semigroup Manifest where
|
||||
a <> b = mkManifest
|
||||
(inManifest a <> inManifest b)
|
||||
(outManifest a <> outManifest b)
|
||||
(S.union (outManifest a) (outManifest b))
|
||||
|
|
Loading…
Reference in a new issue