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