refactor

Annex/Drop.hs

@@ -9,7 +9,7 @@ module Annex.Drop where
 
 import Common.Annex
 import Logs.Trust
-import Config.NumCopies
+import Annex.NumCopies
 import Types.Remote (uuid)
 import Types.Key (key2file)
 import qualified Remote

Annex/NumCopies.hs

@@ -1,11 +1,11 @@
-{- git-annex numcopies configuration
+{- git-annex numcopies configuration and checking
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Config.NumCopies (
+module Annex.NumCopies (
 	module Types.NumCopies,
 	module Logs.NumCopies,
 	getFileNumCopies,
@@ -15,6 +15,8 @@ module Config.NumCopies (
 	defaultNumCopies,
 	numCopiesCheck,
 	numCopiesCheck',
+	verifyEnoughCopies,
+	knownCopies,
 ) where
 
 import Common.Annex
@@ -24,6 +26,8 @@ import Logs.NumCopies
 import Logs.Trust
 import Annex.CheckAttr
 import qualified Remote
+import Annex.UUID
+import Annex.Content
 
 defaultNumCopies :: NumCopies
 defaultNumCopies = NumCopies 1
@@ -83,3 +87,60 @@ numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v
 numCopiesCheck' file vs have = do
 	NumCopies needed <- getFileNumCopies file
 	return $ length have `vs` needed
+
+{- Verifies that enough copies of a key exist amoung the listed remotes,
+ - priting an informative message if not.
+ -}
+verifyEnoughCopies 
+	:: String -- message to print when there are no known locations
+	-> Key
+	-> NumCopies
+	-> [UUID] -- repos to skip (generally untrusted remotes)
+	-> [UUID] -- repos that are trusted or already verified to have it
+	-> [Remote] -- remotes to check to see if they have it
+	-> Annex Bool
+verifyEnoughCopies nolocmsg key need skip = helper [] []
+  where
+	helper bad missing have []
+		| NumCopies (length have) >= need = return True
+		| otherwise = do
+			notEnoughCopies key need have (skip++missing) bad nolocmsg
+			return False
+	helper bad missing have (r:rs)
+		| NumCopies (length have) >= need = return True
+		| otherwise = do
+			let u = Remote.uuid r
+			let duplicate = u `elem` have
+			haskey <- Remote.hasKey r key
+			case (duplicate, haskey) of
+				(False, Right True)  -> helper bad missing (u:have) rs
+				(False, Left _)      -> helper (r:bad) missing have rs
+				(False, Right False) -> helper bad (u:missing) have rs
+				_                    -> helper bad missing have rs
+
+notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> String -> Annex ()
+notEnoughCopies key need have skip bad nolocmsg = do
+	showNote "unsafe"
+	showLongNote $
+		"Could only verify the existence of " ++
+		show (length have) ++ " out of " ++ show (fromNumCopies need) ++ 
+		" necessary copies"
+	Remote.showTriedRemotes bad
+	Remote.showLocations True key (have++skip) nolocmsg
+
+{- Cost ordered lists of remotes that the location log indicates
+ - may have a key.
+ -
+ - Also returns a list of UUIDs that are trusted to have the key
+ - (some may not have configured remotes). If the current repository
+ - currently has the key, and is not untrusted, it is included in this list.
+ -}
+knownCopies :: Key -> Annex ([Remote], [UUID])
+knownCopies key = do
+	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
+	u <- getUUID
+	trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u)
+		( pure (nub (u:trusteduuids))
+		, pure trusteduuids
+		)
+	return (remotes, trusteduuids')

Assistant/WebApp/Configurators/Preferences.hs

@@ -17,7 +17,7 @@ import qualified Annex
 import qualified Git
 import Config
 import Config.Files
-import Config.NumCopies
+import Annex.NumCopies
 import Utility.DataUnits
 import Git.Config
 import Types.Distribution

Command/Copy.hs

@@ -12,7 +12,7 @@ import Command
 import qualified Command.Move
 import qualified Remote
 import Annex.Wanted
-import Config.NumCopies
+import Annex.NumCopies
 
 cmd :: [Command]
 cmd = [withOptions copyOptions $ command "copy" paramPaths seek

Command/Drop.hs

@@ -15,7 +15,7 @@ import Annex.UUID
 import Logs.Location
 import Logs.Trust
 import Logs.PreferredContent
-import Config.NumCopies
+import Annex.NumCopies
 import Annex.Content
 import Annex.Wanted
 import Annex.Notification
@@ -91,14 +91,9 @@ performRemote key afile numcopies remote = do
 	-- Filter the remote it's being dropped from out of the lists of
 	-- places assumed to have the key, and places to check.
 	-- When the local repo has the key, that's one additional copy,
-	-- as long asthe local repo is not untrusted.
+	-- as long as the local repo is not untrusted.
-	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
+	(remotes, trusteduuids) <- knownCopies key
-	u <- getUUID
+	let have = filter (/= uuid) trusteduuids
-	trusteduuids' <- ifM (inAnnex key <&&> (<= SemiTrusted) <$> lookupTrust u)
-		( pure (nub (u:trusteduuids))
-		, pure trusteduuids
-		)
-	let have = filter (/= uuid) trusteduuids'
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = filter (/= remote) $
 		Remote.remotesWithoutUUID remotes (have++untrusteduuids)
@@ -128,45 +123,20 @@ cleanupRemote key remote ok = do
  - --force overrides and always allows dropping.
  -}
 canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
-canDrop dropfrom key afile numcopies have check skip = ifM (Annex.getState Annex.force)
+canDrop dropfrom key afile numcopies have check skip = 
-	( return True
+	ifM (Annex.getState Annex.force)
-	, checkRequiredContent dropfrom key afile
+		( return True
-		<&&>
+			, ifM (checkRequiredContent dropfrom key afile
-	  findCopies key numcopies skip have check
+				<&&> verifyEnoughCopies nolocmsg key numcopies skip have check
-	)
+				)
-
+				( return True
-findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
+				, do
-findCopies key need skip = helper [] []
+					hint
+					return False
+				)
+		)
   where
-	helper bad missing have []
+	nolocmsg = "Rather than dropping this file, try using: git annex move"
-		| NumCopies (length have) >= need = return True
-		| otherwise = notEnoughCopies key need have (skip++missing) bad
-	helper bad missing have (r:rs)
-		| NumCopies (length have) >= need = return True
-		| otherwise = do
-			let u = Remote.uuid r
-			let duplicate = u `elem` have
-			haskey <- Remote.hasKey r key
-			case (duplicate, haskey) of
-				(False, Right True)  -> helper bad missing (u:have) rs
-				(False, Left _)      -> helper (r:bad) missing have rs
-				(False, Right False) -> helper bad (u:missing) have rs
-				_                    -> helper bad missing have rs
-
-notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
-notEnoughCopies key need have skip bad = do
-	unsafe
-	showLongNote $
-		"Could only verify the existence of " ++
-		show (length have) ++ " out of " ++ show (fromNumCopies need) ++ 
-		" necessary copies"
-	Remote.showTriedRemotes bad
-	Remote.showLocations True key (have++skip)
-		"Rather than dropping this file, try using: git annex move"
-	hint
-	return False
-  where
-	unsafe = showNote "unsafe"
 	hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
 
 checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool

Command/DropUnused.hs

@@ -14,7 +14,7 @@ import qualified Command.Drop
 import qualified Remote
 import qualified Git
 import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
-import Config.NumCopies
+import Annex.NumCopies
 
 cmd :: [Command]
 cmd = [withOptions [Command.Drop.dropFromOption] $

Command/Fsck.hs

@@ -24,7 +24,7 @@ import Annex.Link
 import Logs.Location
 import Logs.Trust
 import Logs.Activity
-import Config.NumCopies
+import Annex.NumCopies
 import Annex.UUID
 import Utility.DataUnits
 import Config

Command/Get.hs

@@ -12,7 +12,7 @@ import Command
 import qualified Remote
 import Annex.Content
 import Annex.Transfer
-import Config.NumCopies
+import Annex.NumCopies
 import Annex.Wanted
 import qualified Command.Move
 

Command/Info.hs

@@ -30,7 +30,7 @@ import Types.Key
 import Logs.UUID
 import Logs.Trust
 import Logs.Location
-import Config.NumCopies
+import Annex.NumCopies
 import Remote
 import Config
 import Utility.Percentage

Command/Mirror.hs

@@ -14,7 +14,7 @@ import qualified Command.Drop
 import qualified Command.Get
 import qualified Remote
 import Annex.Content
-import Config.NumCopies
+import Annex.NumCopies
 
 cmd :: [Command]
 cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek

Command/NumCopies.hs

@@ -10,7 +10,7 @@ module Command.NumCopies where
 import Common.Annex
 import qualified Annex
 import Command
-import Config.NumCopies
+import Annex.NumCopies
 import Types.Messages
 
 cmd :: [Command]

Limit.hs

@@ -15,7 +15,7 @@ import qualified Backend
 import Annex.Content
 import Annex.UUID
 import Logs.Trust
-import Config.NumCopies
+import Annex.NumCopies
 import Types.TrustLevel
 import Types.Key
 import Types.Group