Added required content configuration.

This includes checking when dropping files that any required content
configuration is satisfied. However, it does not yet include an active
check on the required content; the location log is trusted when checking
the required content expression.

3 files changed, 52 insertions, 14 deletions

diff --git a/Command/Drop.hs b/Command/Drop.hs
index f6c1880e9..269c4c26b 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -14,11 +14,14 @@ import qualified Annex
 import Annex.UUID
 import Logs.Location
 import Logs.Trust
+import Logs.PreferredContent
 import Config.NumCopies
 import Annex.Content
 import Annex.Wanted
 import Annex.Notification
 
+import qualified Data.Set as S
+
 def :: [Command]
 def = [withOptions [dropFromOption] $ command "drop" paramPaths seek
 	SectionCommon "indicate content of files not currently wanted"]
@@ -50,7 +53,7 @@ startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ d
 startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart
 startRemote afile numcopies key remote = do
 	showStart' ("drop " ++ Remote.name remote) key afile
-	next $ performRemote key numcopies remote
+	next $ performRemote key afile numcopies remote
 
 performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
 performLocal key afile numcopies knownpresentremote = lockContent key $ do
@@ -60,7 +63,8 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do
 		Just r -> nub (Remote.uuid r:trusteduuids)
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
-	ifM (canDropKey key numcopies trusteduuids' tocheck [])
+	u <- getUUID
+	ifM (canDrop u key afile numcopies trusteduuids' tocheck [])
 		( do
 			removeAnnex key
 			notifyDrop afile True
@@ -70,8 +74,8 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do
 			stop
 		)
 
-performRemote :: Key -> NumCopies -> Remote -> CommandPerform
-performRemote key numcopies remote = lockContent key $ do
+performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> CommandPerform
+performRemote key afile numcopies remote = lockContent key $ 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.
@@ -83,7 +87,7 @@ performRemote key numcopies remote = lockContent key $ do
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = filter (/= remote) $
 		Remote.remotesWithoutUUID remotes (have++untrusteduuids)
-	stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do
+	stopUnless (canDrop uuid key afile numcopies have tocheck [uuid]) $ do
 		ok <- Remote.removeKey remote key
 		next $ cleanupRemote key remote ok
   where
@@ -102,13 +106,19 @@ cleanupRemote key remote ok = do
 
 {- Checks specified remotes to verify that enough copies of a key exist to
  - allow it to be safely removed (with no data loss). Can be provided with
- - some locations where the key is known/assumed to be present. -}
-canDropKey :: Key -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
-canDropKey key numcopies have check skip = do
-	force <- Annex.getState Annex.force
-	if force || numcopies == NumCopies 0
-		then return True
-		else findCopies key numcopies skip have check
+ - some locations where the key is known/assumed to be present.
+ -
+ - Also checks if it's required content, and refuses to drop if so.
+ -
+ - --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)
+	( return True
+	, checkRequiredContent dropfrom key afile
+		<&&>
+	  findCopies key numcopies skip have check
+	)
 
 findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
 findCopies key need skip = helper [] []
@@ -144,6 +154,19 @@ notEnoughCopies key need have skip bad = do
 	unsafe = showNote "unsafe"
 	hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
 
+checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool
+checkRequiredContent u k afile =
+	ifM (isRequiredContent (Just u) S.empty (Just k) afile False)
+		( requiredContent
+		, return True
+		)
+
+requiredContent :: Annex Bool
+requiredContent = do
+	showLongNote "That file is required content, it cannot be dropped!"
+	showLongNote "(Use --force to override this check, or adjust required content configuration.)"
+	return False
+
 {- In auto mode, only runs the action if there are enough
  - copies on other semitrusted repositories. -}
 checkDropAuto :: Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 5d1923d34..ce49795c9 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -34,7 +34,7 @@ perform numcopies key = maybe droplocal dropremote =<< Remote.byNameWithUUID =<<
   where
 	dropremote r = do
 		showAction $ "from " ++ Remote.name r
-		Command.Drop.performRemote key numcopies r
+		Command.Drop.performRemote key Nothing numcopies r
 	droplocal = Command.Drop.performLocal key Nothing numcopies Nothing
 	from = Annex.getField $ optionName Command.Drop.dropFromOption
 
diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index c62769c95..d7d5229da 100644
--- a/Command/Vicfg.hs
+++ b/Command/Vicfg.hs
@@ -61,6 +61,7 @@ data Cfg = Cfg
 	{ cfgTrustMap :: TrustMap
 	, cfgGroupMap :: M.Map UUID (S.Set Group)
 	, cfgPreferredContentMap :: M.Map UUID PreferredContentExpression
+	, cfgRequiredContentMap :: M.Map UUID PreferredContentExpression
 	, cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression
 	, cfgScheduleMap :: M.Map UUID [ScheduledActivity]
 	}
@@ -70,6 +71,7 @@ getCfg = Cfg
 	<$> trustMapRaw -- without local trust overrides
 	<*> (groupsByUUID <$> groupMap)
 	<*> preferredContentMapRaw
+	<*> requiredContentMapRaw
 	<*> groupPreferredContentMapRaw
 	<*> scheduleMap
 
@@ -79,6 +81,7 @@ setCfg curcfg newcfg = do
 	mapM_ (uncurry trustSet) $ M.toList $ cfgTrustMap diff
 	mapM_ (uncurry groupSet) $ M.toList $ cfgGroupMap diff
 	mapM_ (uncurry preferredContentSet) $ M.toList $ cfgPreferredContentMap diff
+	mapM_ (uncurry requiredContentSet) $ M.toList $ cfgRequiredContentMap diff
 	mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff
 	mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff
 
@@ -87,6 +90,7 @@ diffCfg curcfg newcfg = Cfg
 	{ cfgTrustMap = diff cfgTrustMap
 	, cfgGroupMap = diff cfgGroupMap
 	, cfgPreferredContentMap = diff cfgPreferredContentMap
+	, cfgRequiredContentMap = diff cfgRequiredContentMap
 	, cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap
 	, cfgScheduleMap = diff cfgScheduleMap
 	}
@@ -102,6 +106,7 @@ genCfg cfg descs = unlines $ intercalate [""]
 	, preferredcontent
 	, grouppreferredcontent
 	, standardgroups
+	, requiredcontent
 	, schedule
 	]
   where
@@ -137,6 +142,11 @@ genCfg cfg descs = unlines $ intercalate [""]
 		[ com "Repository preferred contents" ]
 		(\(s, u) -> line "wanted" u s)
 		(\u -> line "wanted" u "standard")
+	
+	requiredcontent = settings cfg descs cfgRequiredContentMap
+		[ com "Repository required contents" ]
+		(\(s, u) -> line "required" u s)
+		(\u -> line "required" u "")
 
 	grouppreferredcontent = settings' cfg allgroups cfgGroupPreferredContentMap
 		[ com "Group preferred contents"
@@ -228,6 +238,12 @@ parseCfg curcfg = go [] curcfg . lines
 				Nothing ->
 					let m = M.insert u value (cfgPreferredContentMap cfg)
 					in Right $ cfg { cfgPreferredContentMap = m }
+		| setting == "required" = 
+			case checkPreferredContentExpression value of
+				Just e -> Left e
+				Nothing ->
+					let m = M.insert u value (cfgRequiredContentMap cfg)
+					in Right $ cfg { cfgRequiredContentMap = m }
 		| setting == "groupwanted" =
 			case checkPreferredContentExpression value of
 				Just e -> Left e
@@ -255,7 +271,6 @@ parseCfg curcfg = go [] curcfg . lines
 		[ com "** There was a problem parsing your input!"
 		, com "** Search for \"Parse error\" to find the bad lines."
 		, com "** Either fix the bad lines, or delete them (to discard your changes)."
-		, ""
 		]
 	parseerr = com "** Parse error in next line: "