diff options
| -rw-r--r-- | Command/Drop.hs | 28 | ||||
| -rw-r--r-- | Types/NumCopies.hs | 3 |
2 files changed, 25 insertions, 6 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 ) ) diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs index 476c33058..17080cf7c 100644 --- a/Types/NumCopies.hs +++ b/Types/NumCopies.hs @@ -31,7 +31,7 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad newtype NumCopies = NumCopies Int - deriving (Ord, Eq) + deriving (Ord, Eq, Show) fromNumCopies :: NumCopies -> Int fromNumCopies (NumCopies n) = n @@ -138,6 +138,7 @@ fullVerification (RecentlyVerifiedCopy _) = False -- A proof that it's currently safe to drop an object. data SafeDropProof = SafeDropProof NumCopies [VerifiedCopy] + deriving (Show) -- Make sure that none of the VerifiedCopies have become invalidated -- before constructing proof. |