adapt recent bug fixes to support private journal

At this point, private repos should mostly work, except for a few
commands that directly read from the git-annex branch and will not see
the private journal.

Private index not yet implemented.
This commit is contained in:
Joey Hess 2021-04-21 15:54:37 -04:00
parent 0bb57702e1
commit 24eeacdba8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 21 additions and 14 deletions

View file

@ -274,7 +274,8 @@ precache file branchcontent = do
st <- getState
content <- if journalIgnorable st
then pure branchcontent
else fromMaybe branchcontent <$> getJournalFileStale file
else fromMaybe branchcontent
<$> getJournalFileStale (GetPrivate True) file
Annex.BranchState.setCache file content
{- Like get, but does not merge the branch, so the info returned may not
@ -439,17 +440,21 @@ files :: Annex ([RawFilePath], IO Bool)
files = do
_ <- update
(bfs, cleanup) <- branchFiles
-- ++ forces the content of all but the last list to be buffered in
-- memory, so use getJournalledFilesStale which should be much smaller
-- ++ forces the content of the first list to be buffered in
-- memory, so use journalledFiles, which should be much smaller
-- most of the time. branchFiles will stream as the list is consumed.
l <- (\a b c -> a ++ b ++ c)
<$> (if privateUUIDsKnown
then getJournalledFilesStale gitAnnexPrivateJournalDir
else pure [])
<*> (getJournalledFilesStale gitAnnexJournalDir)
<*> pure bfs
l <- (++) <$> journalledFiles <*> pure bfs
return (l, cleanup)
{- Lists all files currently in the journal. There may be duplicates in
- the list when using a private journal. -}
journalledFiles :: Annex [RawFilePath]
journalledFiles
| privateUUIDsKnown = (++)
<$> getJournalledFilesStale gitAnnexPrivateJournalDir
<*> getJournalledFilesStale gitAnnexJournalDir
| otherwise = getJournalledFilesStale gitAnnexJournalDir
{- Files in the branch, not including any from journalled changes,
- and without updating the branch. -}
branchFiles :: Annex ([RawFilePath], IO Bool)
@ -801,7 +806,8 @@ overBranchFileContents select go = do
-- committed to the branch
content' <- if journalIgnorable st
then pure content
else maybe content Just <$> getJournalFileStale f
else maybe content Just
<$> getJournalFileStale (GetPrivate True) f
return (Just (v, f, content'))
Nothing
| journalIgnorable st -> return Nothing
@ -812,7 +818,7 @@ overBranchFileContents select go = do
-- This can cause the action to be run a
-- second time with a file it already ran on.
| otherwise -> liftIO (tryTakeMVar buf) >>= \case
Nothing -> drain buf =<< getJournalledFilesStale
Nothing -> drain buf =<< journalledFiles
Just fs -> drain buf fs
catObjectStreamLsTree l (select' . getTopFilePath . Git.LsTree.file) g go'
liftIO $ void cleanup
@ -825,7 +831,7 @@ overBranchFileContents select go = do
drain buf fs = case getnext fs of
Just (v, f, fs') -> do
liftIO $ putMVar buf fs'
content <- getJournalFileStale f
content <- getJournalFileStale (GetPrivate True) f
return (Just (v, f, content))
Nothing -> do
liftIO $ putMVar buf []

View file

@ -49,13 +49,14 @@ instance Journalable Builder where
data RegardingUUID = RegardingUUID [UUID]
regardingPrivateUUID :: RegardingUUID -> Bool
regardingPrivateUUID _ = False -- TODO
regardingPrivateUUID (RegardingUUID []) = False
regardingPrivateUUID (RegardingUUID _) = True -- TODO
-- Are any private UUIDs known to exist? If so, extra work has to be done,
-- to check for information separately recorded for them, outside the usual
-- locations.
privateUUIDsKnown :: Bool
privateUUIDsKnown = False -- TODO
privateUUIDsKnown = True -- TODO
{- Records content for a file in the branch to the journal.
-