diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-10-08 16:55:11 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-10-08 16:55:11 -0400 |
commit | d5494842274030d21356c7492e6de5969173c34d (patch) | |
tree | a1c25eacba4e6b98b0b1bf275a89ecc7ea0e20d2 /Assistant | |
parent | 55fb90edfc8732b08bea9239a6f4a471ac7867c3 (diff) |
add VerifiedCopy data type
There should be no behavior changes in this commit, it just adds a more
expressive data type and adjusts code that had been passing around a [UUID]
or sometimes a Maybe Remote to instead use [VerifiedCopy].
Although, since some functions were taking two different [UUID] lists,
there's some potential for me to have gotten it horribly wrong.
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Drop.hs | 7 | ||||
-rw-r--r-- | Assistant/Threads/Committer.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/SanityChecker.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 2 | ||||
-rw-r--r-- | Assistant/TransferSlots.hs | 5 |
5 files changed, 10 insertions, 8 deletions
diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs index 57eef8f3a..5653b7795 100644 --- a/Assistant/Drop.hs +++ b/Assistant/Drop.hs @@ -15,11 +15,12 @@ import Assistant.DaemonStatus import Annex.Drop (handleDropsFrom, Reason) import Logs.Location import CmdLine.Action +import Types.NumCopies {- Drop from local and/or remote when allowed by the preferred content and - numcopies settings. -} -handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant () -handleDrops reason fromhere key f knownpresentremote = do +handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> Assistant () +handleDrops reason fromhere key f preverified = do syncrs <- syncDataRemotes <$> getDaemonStatus locs <- liftAnnex $ loggedLocations key - liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote callCommandAction + liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f preverified callCommandAction diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index f4af93285..59ca69e88 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -479,7 +479,7 @@ checkChangeContent change@(Change { changeInfo = i }) = void $ if present then queueTransfers "new file created" Next k (Just f) Upload else queueTransfers "new or renamed file wanted" Next k (Just f) Download - handleDrops "file renamed" present k (Just f) Nothing + handleDrops "file renamed" present k (Just f) [] where f = changeFile change checkChangeContent _ = noop diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 0f2c1245a..f42462e52 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -191,7 +191,7 @@ dailyCheck urlrenderer = do void $ liftAnnex $ setUnusedKeys unused forM_ unused $ \k -> do unlessM (queueTransfers "unused" Later k Nothing Upload) $ - handleDrops "unused" True k Nothing Nothing + handleDrops "unused" True k Nothing [] return True where diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 3cbaadf19..f35c1f1f5 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -157,7 +157,7 @@ expensiveScan urlrenderer rs = batch <~> do present <- liftAnnex $ inAnnex key liftAnnex $ handleDropsFrom locs syncrs "expensive scan found too many copies of object" - present key (Just f) Nothing callCommandAction + present key (Just f) [] callCommandAction liftAnnex $ do let slocs = S.fromList locs let use a = return $ mapMaybe (a key slocs) syncrs diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 7490ede39..232d1d6e1 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -30,6 +30,7 @@ import Annex.Content import Annex.Wanted import Annex.Path import Utility.Batch +import Types.NumCopies import qualified Data.Map as M import qualified Control.Exception as E @@ -160,7 +161,7 @@ genTransfer t info = case transferRemote info of ("object uploaded to " ++ show remote) True (transferKey t) (associatedFile info) - (Just remote) + [VerifiedCopy (Remote.uuid remote)] void recordCommit , whenM (liftAnnex $ isNothing <$> checkTransfer t) $ void $ removeTransfer t @@ -225,7 +226,7 @@ finishedTransfer t (Just info) where dodrops fromhere = handleDrops ("drop wanted after " ++ describeTransfer t info) - fromhere (transferKey t) (associatedFile info) Nothing + fromhere (transferKey t) (associatedFile info) [] finishedTransfer _ _ = noop {- Pause a running transfer. -} |