From 1ee4d018f3e03de1e06f99a6dd2138c6141c864c Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 4 Mar 2025 14:06:55 -0400
Subject: [PATCH] cycle detection

---
 Remote/Compute.hs | 50 +++++++++++++++++++++++++++++++++++++++++++----
 TODO-compute      |  5 -----
 2 files changed, 46 insertions(+), 9 deletions(-)

diff --git a/Remote/Compute.hs b/Remote/Compute.hs
index b54a196e6f..53f08c6cf9 100644
--- a/Remote/Compute.hs
+++ b/Remote/Compute.hs
@@ -518,12 +518,10 @@ computeKey rs (ComputeProgram program) k _af dest p vc =
 			Nothing -> error "internal"
 	
 	getinputcontent' f inputkey = do
-		remotelist <- Annex.getState Annex.remotes
-		locs <- loggedLocations inputkey
-		remotes <- keyPossibilities' (IncludeIgnored False) inputkey locs remotelist
+		remotes <- avoidCycles [k] inputkey
+			=<< keyPossibilities inputkey
 		anyM (getinputcontentfrom f inputkey) remotes
 	
-	-- TODO cycle prevention
 	getinputcontentfrom f inputkey r = do
 		showAction $ "getting input " <> QuotedPath f
 			<> " from " <> UnquotedString (name r)
@@ -571,6 +569,50 @@ computeKey rs (ComputeProgram program) k _af dest p vc =
 		-- The program might not be reproducible,
 		-- so require strong verification.
 		return $ fromMaybe MustVerify mverification
+		
+keyPossibilities :: Key -> Annex [Remote]
+keyPossibilities key = do
+	remotelist <- Annex.getState Annex.remotes
+	locs <- loggedLocations key
+	keyPossibilities' (IncludeIgnored False) key locs remotelist
+
+{- Filter out any remotes that, in order to compute the inputkey, would
+ - need to get the outputkey from some remote.
+ -
+ - This only finds cycles of compute special remotes, not any other
+ - similar type of special remote that might have its own input keys.
+ - There are no other such special remotes in git-annex itself, so this
+ - is the best that can be done.
+ -
+ - Note that, in a case where a compute special remote needs the outputkey
+ - to compute the inputkey, but could get the outputkey from either this
+ - remote, or some other, non-compute remote, that is filtered out as a
+ - cycle because it's not possible to prevent that remote getting from this
+ - remote.
+ -}
+avoidCycles :: [Key] -> Key -> [Remote] -> Annex [Remote]
+avoidCycles outputkeys inputkey = filterM go
+  where
+	go r
+		| iscomputeremote r = 
+			getComputeState (remoteStateHandle r) inputkey >>= \case
+				Nothing -> return True
+				Just state
+					| inputsoutput state -> return False
+					| otherwise -> checkdeeper state
+		| otherwise = return True
+	
+	iscomputeremote r = remotetype r == remote
+
+	inputsoutput state = not $ M.null $
+		M.filter (`elem` outputkeys)
+			(computeInputs state)
+	
+	checkdeeper state =
+		flip allM (M.elems (computeInputs state)) $ \inputkey' -> do
+			rs <- keyPossibilities inputkey'
+			rs' <- avoidCycles (inputkey:outputkeys) inputkey' rs
+			return (rs' == rs)
 
 -- Make sure that the compute state exists.
 checkKey :: RemoteStateHandle -> Key -> Annex Bool
diff --git a/TODO-compute b/TODO-compute
index c0a05ef8db..3eff82e710 100644
--- a/TODO-compute
+++ b/TODO-compute
@@ -3,11 +3,6 @@
 
 * need progress bars for computations and implement PROGRESS message
 
-* get input files for a computation (so `git-annex get .` gets every file,
-  even when input files in a directory are processed after computed files)
-
-  started implementation, but must avoid cycles!
-
 * addcomputed should honor annex.addunlocked.
 
 * Perhaps recompute should write a new version of a file as an unlocked