diff options
Diffstat (limited to 'Assistant/Drop.hs')
| -rw-r--r-- | Assistant/Drop.hs | 99 |
1 files changed, 6 insertions, 93 deletions
diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs index d9d812397..03ab5ab2c 100644 --- a/Assistant/Drop.hs +++ b/Assistant/Drop.hs @@ -5,24 +5,15 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Assistant.Drop where +module Assistant.Drop ( + handleDrops, + handleDropsFrom, +) where import Assistant.Common import Assistant.DaemonStatus +import Annex.Drop (handleDropsFrom, Reason) import Logs.Location -import Logs.Trust -import Types.Remote (uuid) -import qualified Remote -import qualified Command.Drop -import Command -import Annex.Wanted -import Annex.Exception -import Config -import Annex.Content.Direct - -import qualified Data.Set as S - -type Reason = String {- Drop from local and/or remote when allowed by the preferred content and - numcopies settings. -} @@ -31,82 +22,4 @@ handleDrops _ _ _ Nothing _ = noop handleDrops reason fromhere key f knownpresentremote = do syncrs <- syncDataRemotes <$> getDaemonStatus locs <- liftAnnex $ loggedLocations key - handleDropsFrom locs syncrs reason fromhere key f knownpresentremote - -{- The UUIDs are ones where the content is believed to be present. - - The Remote list can include other remotes that do not have the content; - - only ones that match the UUIDs will be dropped from. - - If allowed to drop fromhere, that drop will be tried first. - - - - In direct mode, all associated files are checked, and only if all - - of them are unwanted are they dropped. - -} -handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant () -handleDropsFrom _ _ _ _ _ Nothing _ = noop -handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do - fs <- liftAnnex $ ifM isDirect - ( do - l <- associatedFilesRelative key - if null l - then return [afile] - else return l - , return [afile] - ) - n <- getcopies fs - if fromhere && checkcopies n Nothing - then go fs rs =<< dropl fs n - else go fs rs n - where - getcopies fs = liftAnnex $ do - (untrusted, have) <- trustPartition UnTrusted locs - numcopies <- maximum <$> mapM (getNumCopies <=< numCopies) fs - return (length have, numcopies, S.fromList untrusted) - - {- Check that we have enough copies still to drop the content. - - When the remote being dropped from is untrusted, it was not - - counted as a copy, so having only numcopies suffices. Otherwise, - - we need more than numcopies to safely drop. -} - checkcopies (have, numcopies, _untrusted) Nothing = have > numcopies - checkcopies (have, numcopies, untrusted) (Just u) - | S.member u untrusted = have >= numcopies - | otherwise = have > numcopies - - decrcopies (have, numcopies, untrusted) Nothing = - (have - 1, numcopies, untrusted) - decrcopies v@(_have, _numcopies, untrusted) (Just u) - | S.member u untrusted = v - | otherwise = decrcopies v Nothing - - go _ [] _ = noop - go fs (r:rest) n - | uuid r `S.notMember` slocs = go fs rest n - | checkcopies n (Just $ Remote.uuid r) = - dropr fs r n >>= go fs rest - | otherwise = noop - - checkdrop fs n@(have, numcopies, _untrusted) u a = - ifM (liftAnnex $ allM (wantDrop True u . Just) fs) - ( ifM (liftAnnex $ safely $ doCommand $ a (Just numcopies)) - ( do - debug - [ "dropped" - , afile - , "(from " ++ maybe "here" show u ++ ")" - , "(copies now " ++ show (have - 1) ++ ")" - , ": " ++ reason - ] - return $ decrcopies n u - , return n - ) - , return n - ) - - dropl fs n = checkdrop fs n Nothing $ \numcopies -> - Command.Drop.startLocal (Just afile) numcopies key knownpresentremote - - dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies -> - Command.Drop.startRemote (Just afile) numcopies key r - - safely a = either (const False) id <$> tryAnnex a - - slocs = S.fromList locs + liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote |