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:
Joey Hess 2024-08-23 16:35:12 -04:00
parent 4885073377
commit c3d40b9ec3
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
58 changed files with 363 additions and 247 deletions

View file

@ -95,7 +95,7 @@ seek' o = do
annexdotfiles <- getGitConfigVal annexDotFiles
let gofile includingsmall (si, file) = case largeFilesOverride o of
Nothing -> ifM (pure (annexdotfiles || not (dotfile file))
<&&> (checkFileMatcher largematcher file
<&&> (checkFileMatcher NoLiveUpdate largematcher file
<||> Annex.getRead Annex.force))
( start dr si file addunlockedmatcher
, if includingsmall
@ -267,5 +267,5 @@ cleanup :: Key -> Bool -> CommandCleanup
cleanup key hascontent = do
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
when hascontent $
logStatus key InfoPresent
logStatus NoLiveUpdate key InfoPresent
return True

View file

@ -32,7 +32,7 @@ start = startUnused go (other "bad") (other "tmp")
(ActionItemTreeFile file)
(SeekInput [show n]) $
next $ do
logStatus key InfoPresent
logStatus NoLiveUpdate key InfoPresent
addSymlink file key Nothing
return True

View file

@ -323,7 +323,7 @@ addUrlChecked o url file u checkexistssize key =
Just (exists, samesize, url')
| exists && (samesize || relaxedOption (downloadOptions o)) -> do
setUrlPresent key url'
logChange key u InfoPresent
logChange NoLiveUpdate key u InfoPresent
next $ return True
| otherwise -> do
warning $ UnquotedString $ "while adding a new url to an already annexed file, " ++ if exists
@ -511,7 +511,7 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
createWorkTreeDirectory (P.takeDirectory file)
liftIO $ moveFile tmp file
largematcher <- largeFilesMatcher
large <- checkFileMatcher largematcher file
large <- checkFileMatcher NoLiveUpdate largematcher file
if large
then do
-- Move back to tmp because addAnnexedFile
@ -525,11 +525,11 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
go = do
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
setUrlPresent key url
logChange key u InfoPresent
logChange NoLiveUpdate key u InfoPresent
ifM (addAnnexedFile addunlockedmatcher file key mtmp)
( do
when (isJust mtmp) $
logStatus key InfoPresent
logStatus NoLiveUpdate key InfoPresent
, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp
)

View file

@ -83,15 +83,17 @@ start o from si file key = start' o from key afile ai si
ai = mkActionItem (key, afile)
start' :: DropOptions -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
start' o from key afile ai si =
checkDropAuto (autoMode o) from afile key $ \numcopies mincopies ->
stopUnless wantdrop $
start' o from key afile ai si = do
checkDropAuto (autoMode o) from afile key $ \numcopies mincopies -> do
lu <- prepareLiveUpdate remoteuuid key RemovingKey
stopUnless (wantdrop lu) $
case from of
Nothing -> startLocal pcc afile ai si numcopies mincopies key [] ud
Just remote -> startRemote pcc afile ai si numcopies mincopies key ud remote
Nothing -> startLocal lu pcc afile ai si numcopies mincopies key [] ud
Just remote -> startRemote lu pcc afile ai si numcopies mincopies key ud remote
where
wantdrop
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile Nothing
remoteuuid = Remote.uuid <$> from
wantdrop lu
| autoMode o = wantDrop lu False remoteuuid (Just key) afile Nothing
| otherwise = return True
pcc = PreferredContentChecked (autoMode o)
ud = case (batchOption o, keyOptions o) of
@ -101,22 +103,22 @@ start' o from key afile ai si =
startKeys :: DropOptions -> Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys o from (si, key, ai) = start' o from key (AssociatedFile Nothing) ai si
startLocal :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> DroppingUnused -> CommandStart
startLocal pcc afile ai si numcopies mincopies key preverified ud =
startLocal :: LiveUpdate -> PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> DroppingUnused -> CommandStart
startLocal lu pcc afile ai si numcopies mincopies key preverified ud =
starting "drop" (OnlyActionOn key ai) si $
performLocal pcc key afile numcopies mincopies preverified ud
performLocal lu pcc key afile numcopies mincopies preverified ud
startRemote :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart
startRemote pcc afile ai si numcopies mincopies key ud remote =
startRemote :: LiveUpdate -> PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart
startRemote lu pcc afile ai si numcopies mincopies key ud remote =
starting "drop" (OnlyActionOn key ai) si $ do
showAction $ UnquotedString $ "from " ++ Remote.name remote
performRemote pcc key afile numcopies mincopies remote ud
performRemote lu pcc key afile numcopies mincopies remote ud
performLocal :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> DroppingUnused -> CommandPerform
performLocal pcc key afile numcopies mincopies preverified ud = lockContentForRemoval key fallback $ \contentlock -> do
performLocal :: LiveUpdate -> PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> DroppingUnused -> CommandPerform
performLocal lu pcc key afile numcopies mincopies preverified ud = lockContentForRemoval key fallback $ \contentlock -> do
u <- getUUID
(tocheck, verified) <- verifiableCopies key [u]
doDrop pcc u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
doDrop lu pcc u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
( \proof -> do
fastDebug "Command.Drop" $ unwords
[ "Dropping from here"
@ -125,7 +127,7 @@ performLocal pcc key afile numcopies mincopies preverified ud = lockContentForRe
]
removeAnnex contentlock
notifyDrop afile True
next $ cleanupLocal key ud
next $ cleanupLocal lu key ud
, do
notifyDrop afile False
stop
@ -136,14 +138,14 @@ performLocal pcc key afile numcopies mincopies preverified ud = lockContentForRe
-- is present, but due to buffering, may find it present for the
-- second file before the first is dropped. If so, nothing remains
-- to be done except for cleaning up.
fallback = next $ cleanupLocal key ud
fallback = next $ cleanupLocal lu key ud
performRemote :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> DroppingUnused -> CommandPerform
performRemote pcc key afile numcopies mincopies remote ud = do
performRemote :: LiveUpdate -> PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> DroppingUnused -> CommandPerform
performRemote lu pcc key afile numcopies mincopies remote ud = do
-- Filter the uuid it's being dropped from out of the lists of
-- places assumed to have the key, and places to check.
(tocheck, verified) <- verifiableCopies key [uuid]
doDrop pcc uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
doDrop lu pcc uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
( \proof -> do
fastDebug "Command.Drop" $ unwords
[ "Dropping from remote"
@ -152,21 +154,21 @@ performRemote pcc key afile numcopies mincopies remote ud = do
, show proof
]
ok <- Remote.action (Remote.removeKey remote proof key)
next $ cleanupRemote key remote ud ok
next $ cleanupRemote lu key remote ud ok
, stop
)
where
uuid = Remote.uuid remote
cleanupLocal :: Key -> DroppingUnused -> CommandCleanup
cleanupLocal key ud = do
logStatus key (dropStatus ud)
cleanupLocal :: LiveUpdate -> Key -> DroppingUnused -> CommandCleanup
cleanupLocal lu key ud = do
logStatus lu key (dropStatus ud)
return True
cleanupRemote :: Key -> Remote -> DroppingUnused -> Bool -> CommandCleanup
cleanupRemote key remote ud ok = do
cleanupRemote :: LiveUpdate -> Key -> Remote -> DroppingUnused -> Bool -> CommandCleanup
cleanupRemote lu key remote ud ok = do
when ok $
Remote.logStatus remote key (dropStatus ud)
Remote.logStatus lu remote key (dropStatus ud)
return ok
{- Set when the user explicitly chose to operate on unused content.
@ -189,7 +191,8 @@ dropStatus (DroppingUnused True) = InfoDead
- --force overrides and always allows dropping.
-}
doDrop
:: PreferredContentChecked
:: LiveUpdate
-> PreferredContentChecked
-> UUID
-> Maybe ContentRemovalLock
-> Key
@ -201,10 +204,10 @@ doDrop
-> [UnVerifiedCopy]
-> (Maybe SafeDropProof -> CommandPerform, CommandPerform)
-> CommandPerform
doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
doDrop lu pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
ifM (Annex.getRead Annex.force)
( dropaction Nothing
, ifM (checkRequiredContent pcc dropfrom key afile)
, ifM (checkRequiredContent lu pcc dropfrom key afile)
( verifyEnoughCopiesToDrop nolocmsg key (Just dropfrom)
contentlock numcopies mincopies
skip preverified check
@ -225,10 +228,10 @@ doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified c
- providing this avoids that extra work. -}
newtype PreferredContentChecked = PreferredContentChecked Bool
checkRequiredContent :: PreferredContentChecked -> UUID -> Key -> AssociatedFile -> Annex Bool
checkRequiredContent (PreferredContentChecked True) _ _ _ = return True
checkRequiredContent (PreferredContentChecked False) u k afile =
checkDrop isRequiredContent False (Just u) (Just k) afile Nothing >>= \case
checkRequiredContent :: LiveUpdate -> PreferredContentChecked -> UUID -> Key -> AssociatedFile -> Annex Bool
checkRequiredContent _ (PreferredContentChecked True) _ _ _ = return True
checkRequiredContent lu (PreferredContentChecked False) u k afile =
checkDrop isRequiredContent lu False (Just u) (Just k) afile Nothing >>= \case
Nothing -> return True
Just afile' -> do
if afile == afile'

View file

@ -55,5 +55,5 @@ perform key = ifM (inAnnex key)
cleanup :: Key -> CommandCleanup
cleanup key = do
logStatus key InfoMissing
logStatus NoLiveUpdate key InfoMissing
return True

View file

@ -57,7 +57,8 @@ perform :: Maybe Remote -> NumCopies -> MinCopies -> Key -> CommandPerform
perform from numcopies mincopies key = case from of
Just r -> do
showAction $ UnquotedString $ "from " ++ Remote.name r
Command.Drop.performRemote pcc key (AssociatedFile Nothing) numcopies mincopies r ud
Command.Drop.performRemote NoLiveUpdate pcc key
(AssociatedFile Nothing) numcopies mincopies r ud
Nothing -> ifM (inAnnex key)
( droplocal
, ifM (objectFileExists key)
@ -71,7 +72,8 @@ perform from numcopies mincopies key = case from of
)
)
where
droplocal = Command.Drop.performLocal pcc key (AssociatedFile Nothing) numcopies mincopies [] ud
droplocal = Command.Drop.performLocal NoLiveUpdate pcc
key (AssociatedFile Nothing) numcopies mincopies [] ud
pcc = Command.Drop.PreferredContentChecked False
ud = Command.Drop.DroppingUnused True

View file

@ -334,12 +334,12 @@ verifyLocationLog key keystatus ai = do
whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
warning $ "** Despite annex.securehashesonly being set, " <> QuotedPath obj <> " has content present in the annex using an insecure " <> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key))) <> " key"
verifyLocationLog' key ai present u (logChange key u)
verifyLocationLog' key ai present u (logChange NoLiveUpdate key u)
verifyLocationLogRemote :: Key -> ActionItem -> Remote -> Bool -> Annex Bool
verifyLocationLogRemote key ai remote present =
verifyLocationLog' key ai present (Remote.uuid remote)
(Remote.logStatus remote key)
(Remote.logStatus NoLiveUpdate remote key)
verifyLocationLog' :: Key -> ActionItem -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool
verifyLocationLog' key ai present u updatestatus = do
@ -385,7 +385,7 @@ verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = case afile of
go requiredlocs = do
presentlocs <- S.fromList <$> loggedLocations key
missinglocs <- filterM
(\u -> isRequiredContent (Just u) S.empty (Just key) afile False)
(\u -> isRequiredContent NoLiveUpdate (Just u) S.empty (Just key) afile False)
(S.toList $ S.difference requiredlocs presentlocs)
if null missinglocs
then return True
@ -641,7 +641,7 @@ badContentRemote remote localcopy key = do
dropped <- tryNonAsync (Remote.removeKey remote Nothing key)
when (isRight dropped) $
Remote.logStatus remote key InfoMissing
Remote.logStatus NoLiveUpdate remote key InfoMissing
return $ case (movedbad, dropped) of
(True, Right ()) -> "moved from " ++ Remote.name remote ++
" to " ++ fromRawFilePath destbad

View file

@ -51,7 +51,6 @@ import qualified Limit
import Messages.JSON (DualDisp(..), ObjectMap(..))
import Annex.BloomFilter
import Annex.RepoSize
import Types.RepoSize
import qualified Command.Unused
import qualified Utility.RawFilePath as R

View file

@ -98,7 +98,7 @@ perform file key = do
)
Nothing -> lostcontent
lostcontent = logStatus key InfoMissing
lostcontent = logStatus NoLiveUpdate key InfoMissing
errorModified :: a
errorModified = giveup "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"

View file

@ -90,7 +90,7 @@ seek o = do
, liftIO exitFailure
)
where
checkmatcher matcher = checkMatcher' matcher (matchinfo o) S.empty
checkmatcher matcher = checkMatcher' matcher (matchinfo o) NoLiveUpdate S.empty
bail :: String -> IO a
bail s = do

View file

@ -174,7 +174,7 @@ update oldkey newkey =
starting "migrate" ai (SeekInput []) $
ifM (Command.ReKey.linkKey' v oldkey newkey)
( do
logStatus newkey InfoPresent
logStatus NoLiveUpdate newkey InfoPresent
next $ return True
, next $ return False
)

View file

@ -213,7 +213,7 @@ storeReceived f = do
Nothing -> do
warning $ "Received a file " <> QuotedPath (toRawFilePath f) <> " that is not a git-annex key. Deleting this file."
liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
Just k -> void $ logStatusAfter k $
Just k -> void $ logStatusAfter NoLiveUpdate k $
getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $
liftIO $ catchBoolIO $ do
R.rename (toRawFilePath f) dest

View file

@ -149,6 +149,6 @@ cleanup file newkey a = do
return (MigrationRecord sha)
)
whenM (inAnnex newkey) $
logStatus newkey InfoPresent
logStatus NoLiveUpdate newkey InfoPresent
a newkeyrec
return True

View file

@ -30,7 +30,7 @@ start (_, key) = fieldTransfer Download key $ \_p -> do
let rsp = RetrievalAllKeysSecure
ifM (getViaTmp rsp DefaultVerify key (AssociatedFile Nothing) Nothing go)
( do
logStatus key InfoPresent
logStatus NoLiveUpdate key InfoPresent
_ <- quiesce True
return True
, return False

View file

@ -86,5 +86,5 @@ registerUrl remote key url = do
-- does not have an OtherDownloader, but this command needs to do
-- it for urls claimed by other remotes as well.
case snd (getDownloader url) of
OtherDownloader -> logChange key (Remote.uuid remote) InfoPresent
OtherDownloader -> logChange NoLiveUpdate key (Remote.uuid remote) InfoPresent
_ -> return ()

View file

@ -133,5 +133,5 @@ perform src key = do
cleanup :: Key -> CommandCleanup
cleanup key = do
logStatus key InfoPresent
logStatus NoLiveUpdate key InfoPresent
return True

View file

@ -48,5 +48,5 @@ perform file key = do
cleanup :: Key -> CommandCleanup
cleanup key = do
logStatus key InfoPresent
logStatus NoLiveUpdate key InfoPresent
return True

View file

@ -54,5 +54,5 @@ start si (KeyStatus k u s) = starting "setpresentkey" ai si $ perform k u s
perform :: Key -> UUID -> LogStatus -> CommandPerform
perform k u s = next $ do
logChange k u s
logChange NoLiveUpdate k u s
return True

View file

@ -191,7 +191,7 @@ clean' file mk passthrough discardreststdin emitpointer =
=<< lockDown cfg (fromRawFilePath file)
postingest (Just k, _) = do
logStatus k InfoPresent
logStatus NoLiveUpdate k InfoPresent
return k
postingest _ = giveup "could not add file to the annex"
@ -248,7 +248,7 @@ shouldAnnex file indexmeta moldkey = do
where
go = do
matcher <- largeFilesMatcher
checkFileMatcher' matcher file d
checkFileMatcher' NoLiveUpdate matcher file d
checkwasannexed = pure $ isJust moldkey

View file

@ -298,7 +298,7 @@ test runannex mkr mkk =
Just verifier -> do
loc <- Annex.calcRepo (gitAnnexLocation k)
verifier k loc
get r k = logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
get r k = logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
Right v -> return (True, v)
Left _ -> return (False, UnVerified)
@ -372,13 +372,13 @@ testUnavailable runannex mkr mkk =
, check (`notElem` [Right True, Right False]) "checkPresent" $ \r k ->
Remote.checkPresent r k
, check (== Right False) "retrieveKeyFile" $ \r k ->
logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
Right v -> return (True, v)
Left _ -> return (False, UnVerified)
, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of
Nothing -> return False
Just a -> logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
Just a -> logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
unVerified $ isRight
<$> tryNonAsync (a k (AssociatedFile Nothing) (fromRawFilePath dest))
]

View file

@ -54,7 +54,7 @@ toPerform key af remote = go Upload af $
upload' (uuid remote) key af Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key af Nothing p) >>= \case
Right () -> do
Remote.logStatus remote key InfoPresent
Remote.logStatus NoLiveUpdate remote key InfoPresent
return True
Left e -> do
warning (UnquotedString (show e))
@ -63,7 +63,7 @@ toPerform key af remote = go Upload af $
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
fromPerform key af remote = go Upload af $
download' (uuid remote) key af Nothing stdRetry $ \p ->
logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) vc key af Nothing $ \t ->
logStatusAfter NoLiveUpdate key $ getViaTmp (retrievalSecurityPolicy remote) vc key af Nothing $ \t ->
tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p vc) >>= \case
Right v -> return (True, v)
Left e -> do

View file

@ -46,11 +46,11 @@ start = do
warning (UnquotedString (show e))
return False
Right () -> do
Remote.logStatus remote key InfoPresent
Remote.logStatus NoLiveUpdate remote key InfoPresent
return True
| otherwise = notifyTransfer direction af $
download' (Remote.uuid remote) key af Nothing stdRetry $ \p ->
logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do
logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do
r <- tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
Left e -> do
warning (UnquotedString (show e))

View file

@ -67,12 +67,12 @@ start = do
warning (UnquotedString (show e))
return False
Right () -> do
Remote.logStatus remote key InfoPresent
Remote.logStatus NoLiveUpdate remote key InfoPresent
return True
runner (AssistantDownloadRequest _ key (TransferAssociatedFile file)) remote =
notifyTransfer Download file $
download' (Remote.uuid remote) key file Nothing stdRetry $ \p ->
logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do
logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do
r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
Left e -> do
warning (UnquotedString (show e))