diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2015-10-09 13:47:19 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-10-09 13:47:19 -0400 |
| commit | 4f9957f5342c58adf5b406122b6a8157352ab89b (patch) | |
| tree | 68a0c04ab77ab2c74b4a4c3c2484aaa7c6eb7580 /Command/Drop.hs | |
| parent | cdc18dea255090d0eb9c1dcd9ffa433665736b18 (diff) | |
display drop safety proofs in debug mode
Diffstat (limited to 'Command/Drop.hs')
| -rw-r--r-- | Command/Drop.hs | 28 |
1 files changed, 23 insertions, 5 deletions
diff --git a/Command/Drop.hs b/Command/Drop.hs index fa8ac45ad..43dc51d74 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -20,6 +20,9 @@ import Annex.Content import Annex.Wanted import Annex.Notification +import Utility.ThreadScheduler + +import System.Log.Logger (debugM) import qualified Data.Set as S cmd :: Command @@ -100,7 +103,12 @@ performLocal key afile numcopies preverified = lockContentExclusive key $ \conte let tocheck = Remote.remotesWithoutUUID remotes (map toUUID preverified'++untrusteduuids) u <- getUUID doDrop u key afile numcopies [] preverified' tocheck - ( do + ( \proof -> do + liftIO $ debugM "drop" $ unwords + [ "Dropping from here" + , "proof: " + , show proof + ] removeAnnex contentlock notifyDrop afile True next $ cleanupLocal key @@ -122,7 +130,15 @@ performRemote key afile numcopies remote = do let tocheck = filter (/= remote) $ Remote.remotesWithoutUUID remotes (trusted++untrusteduuids) doDrop uuid key afile numcopies [uuid] preverified tocheck - ( do + ( \proof -> do + liftIO $ debugM "drop" $ unwords + [ "Dropping from remote" + , show remote + , "proof: " + , show proof + ] + liftIO $ print "waiting to drop.." + liftIO $ threadDelaySeconds (Seconds 10) ok <- Remote.removeKey remote key next $ cleanupRemote key remote ok , stop @@ -149,13 +165,15 @@ cleanupRemote key remote ok = do - - --force overrides and always allows dropping. -} -doDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [VerifiedCopy] -> [Remote] -> (CommandPerform, CommandPerform) -> CommandPerform +doDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [VerifiedCopy] -> [Remote] -> (Maybe SafeDropProof -> CommandPerform, CommandPerform) -> CommandPerform doDrop dropfrom key afile numcopies skip preverified check (dropaction, nodropaction) = ifM (Annex.getState Annex.force) - ( dropaction + ( dropaction Nothing , ifM (checkRequiredContent dropfrom key afile) ( verifyEnoughCopiesToDrop nolocmsg key numcopies - skip preverified check (const dropaction) (forcehint nodropaction) + skip preverified check + (dropaction . Just) + (forcehint nodropaction) , stop ) ) |