summaryrefslogtreecommitdiff
path: root/Annex/Drop.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-01-23 16:37:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-01-23 16:44:02 -0400
commit5112650348f6bf04cebe1fb97ed900b24e4aaac1 (patch)
tree4e207b96021812213d237e68d156e2e0bbdf32c3 /Annex/Drop.hs
parent425c6ddfcd84b6bf26f3a277d010df1fb6b018da (diff)
fix transfers of key with no associated file
Several places assumed this would not happen, and when the AssociatedFile was Nothing, did nothing. As part of this, preferred content checks pass the Key around. Note that checkMatcher is sometimes now called with Just Key and Just File. It currently constructs a FileMatcher, ignoring the Key. However, if it constructed a FileKeyMatcher, which contained both, then it might be possible to speed up parts of Limit, which currently call the somewhat expensive lookupFileKey to get the Key. I have not made this optimisation yet, because I am not sure if the key is always the same. Will need some significant checking to satisfy myself that's the case..
Diffstat (limited to 'Annex/Drop.hs')
-rw-r--r--Annex/Drop.hs48
1 files changed, 29 insertions, 19 deletions
diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index 09ca822a3..61b0cf9e1 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -11,6 +11,7 @@ import Common.Annex
import Logs.Trust
import Config.NumCopies
import Types.Remote (uuid)
+import Types.Key (key2file)
import qualified Remote
import qualified Command.Drop
import Command
@@ -43,15 +44,14 @@ type Reason = String
- or commandAction.
-}
handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> CommandActionRunner -> Annex ()
-handleDropsFrom _ _ _ _ _ Nothing _ _ = noop
-handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runner = do
+handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do
fs <- ifM isDirect
( do
l <- associatedFilesRelative key
if null l
- then return [afile]
+ then return $ maybe [] (:[]) afile
else return l
- , return [afile]
+ , return $ maybe [] (:[]) afile
)
n <- getcopies fs
if fromhere && checkcopies n Nothing
@@ -60,7 +60,9 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn
where
getcopies fs = do
(untrusted, have) <- trustPartition UnTrusted locs
- numcopies <- maximum <$> mapM getFileNumCopies fs
+ numcopies <- if null fs
+ then getNumCopies
+ else maximum <$> mapM getFileNumCopies fs
return (NumCopies (length have), numcopies, S.fromList untrusted)
{- Check that we have enough copies still to drop the content.
@@ -85,28 +87,36 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn
dropr fs r n >>= go fs rest
| otherwise = noop
- checkdrop fs n@(have, numcopies, _untrusted) u a =
- ifM (allM (wantDrop True u . Just) fs)
- ( ifM (safely $ runner $ a numcopies)
- ( do
- liftIO $ debugM "drop" $ unwords
- [ "dropped"
- , afile
- , "(from " ++ maybe "here" show u ++ ")"
- , "(copies now " ++ show (fromNumCopies have - 1) ++ ")"
- , ": " ++ reason
- ]
- return $ decrcopies n u
+ checkdrop fs n u a
+ | null fs = check $ -- no associated files; unused content
+ wantDrop True u (Just key) Nothing
+ | otherwise = check $
+ allM (wantDrop True u (Just key) . Just) fs
+ where
+ check c = ifM c
+ ( dodrop n u a
, return n
)
+
+ dodrop n@(have, numcopies, _untrusted) u a =
+ ifM (safely $ runner $ a numcopies)
+ ( do
+ liftIO $ debugM "drop" $ unwords
+ [ "dropped"
+ , fromMaybe (key2file key) afile
+ , "(from " ++ maybe "here" show u ++ ")"
+ , "(copies now " ++ show (fromNumCopies have - 1) ++ ")"
+ , ": " ++ reason
+ ]
+ return $ decrcopies n u
, return n
)
dropl fs n = checkdrop fs n Nothing $ \numcopies ->
- Command.Drop.startLocal (Just afile) numcopies key knownpresentremote
+ Command.Drop.startLocal afile numcopies key knownpresentremote
dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
- Command.Drop.startRemote (Just afile) numcopies key r
+ Command.Drop.startRemote afile numcopies key r
slocs = S.fromList locs