summaryrefslogtreecommitdiff
path: root/Assistant/TransferSlots.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 /Assistant/TransferSlots.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 'Assistant/TransferSlots.hs')
-rw-r--r--Assistant/TransferSlots.hs18
1 files changed, 10 insertions, 8 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index cb5d61a39..6fc8c3fd7 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -103,8 +103,8 @@ runTransferThread' program batchmaker d run = go
{- By the time this is called, the daemonstatus's currentTransfers map should
- already have been updated to include the transfer. -}
genTransfer :: Transfer -> TransferInfo -> TransferGenerator
-genTransfer t info = case (transferRemote info, associatedFile info) of
- (Just remote, Just file)
+genTransfer t info = case transferRemote info of
+ Just remote
| Git.repoIsLocalUnknown (Remote.repo remote) -> do
-- optimisation for removable drives not plugged in
liftAnnex $ recordFailedTransfer t info
@@ -114,7 +114,7 @@ genTransfer t info = case (transferRemote info, associatedFile info) of
( do
debug [ "Transferring:" , describeTransfer t info ]
notifyTransfer
- return $ Just (t, info, go remote file)
+ return $ Just (t, info, go remote)
, do
debug [ "Skipping unnecessary transfer:",
describeTransfer t info ]
@@ -149,10 +149,12 @@ genTransfer t info = case (transferRemote info, associatedFile info) of
- usual cleanup. However, first check if something else is
- running the transfer, to avoid removing active transfers.
-}
- go remote file transferrer = ifM (liftIO $ performTransfer transferrer t $ associatedFile info)
+ go remote transferrer = ifM (liftIO $ performTransfer transferrer t $ associatedFile info)
( do
- void $ addAlert $ makeAlertFiller True $
- transferFileAlert direction True file
+ maybe noop
+ (void . addAlert . makeAlertFiller True
+ . transferFileAlert direction True)
+ (associatedFile info)
unless isdownload $
handleDrops
("object uploaded to " ++ show remote)
@@ -188,11 +190,11 @@ genTransfer t info = case (transferRemote info, associatedFile info) of
shouldTransfer :: Transfer -> TransferInfo -> Annex Bool
shouldTransfer t info
| transferDirection t == Download =
- (not <$> inAnnex key) <&&> wantGet True file
+ (not <$> inAnnex key) <&&> wantGet True (Just key) file
| transferDirection t == Upload = case transferRemote info of
Nothing -> return False
Just r -> notinremote r
- <&&> wantSend True file (Remote.uuid r)
+ <&&> wantSend True (Just key) file (Remote.uuid r)
| otherwise = return False
where
key = transferKey t