From 4fef94d76422c6f0c831eb2fdce4bc0f55750ef2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 22 Sep 2021 10:46:10 -0400
Subject: [PATCH] simplify annex.stalldetection handling

RemoteGitConfig parsing looks for annex.stalldetection when a remote
does not have a per-remote config for it, so no need for a separate
gobal config.

Sponsored-by: Noam Kremen on Patreon
---
 Annex/Transfer.hs          | 25 ++++++++++---------------
 Assistant/TransferSlots.hs |  4 ++--
 Types/GitConfig.hs         |  4 ----
 3 files changed, 12 insertions(+), 21 deletions(-)

diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index c57dbaf3ec..c6597baec2 100644
--- a/Annex/Transfer.hs
+++ b/Annex/Transfer.hs
@@ -19,7 +19,6 @@ module Annex.Transfer (
 	noRetry,
 	stdRetry,
 	pickRemote,
-	stallDetection,
 ) where
 
 import Annex.Common
@@ -55,10 +54,11 @@ import Data.Ord
 
 -- Upload, supporting canceling detected stalls.
 upload :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
-upload r key f d witness = stallDetection r >>= \case
-	Nothing -> go (Just ProbeStallDetection)
-	Just StallDetectionDisabled -> go Nothing
-	Just sd -> runTransferrer sd r key f d Upload witness
+upload r key f d witness = 
+	case remoteAnnexStallDetection (Remote.gitconfig r) of
+		Nothing -> go (Just ProbeStallDetection)
+		Just StallDetectionDisabled -> go Nothing
+		Just sd -> runTransferrer sd r key f d Upload witness
   where
  	go sd = upload' (Remote.uuid r) key f sd d (action . Remote.storeKey r key f) witness
 
@@ -73,10 +73,11 @@ alwaysUpload u key f sd d a _witness = guardHaveUUID u $
 
 -- Download, supporting canceling detected stalls.
 download :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
-download r key f d witness = logStatusAfter key $ stallDetection r >>= \case
-	Nothing -> go (Just ProbeStallDetection)
-	Just StallDetectionDisabled -> go Nothing
-	Just sd -> runTransferrer sd r key f d Download witness
+download r key f d witness = logStatusAfter key $
+	case remoteAnnexStallDetection (Remote.gitconfig r) of
+		Nothing -> go (Just ProbeStallDetection)
+		Just StallDetectionDisabled -> go Nothing
+		Just sd -> runTransferrer sd r key f d Download witness
   where
 	go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key f $ \dest ->
 		download' (Remote.uuid r) key f sd d (go' dest) witness
@@ -400,9 +401,3 @@ lessActiveFirst :: M.Map Remote Integer -> Remote -> Remote -> Ordering
 lessActiveFirst active a b
 	| Remote.cost a == Remote.cost b = comparing (`M.lookup` active) a b
 	| otherwise = comparing Remote.cost a b
-
-stallDetection :: Remote -> Annex (Maybe StallDetection)
-stallDetection r = maybe globalcfg (pure . Just) remotecfg
-  where
-	globalcfg = annexStallDetection <$> Annex.getGitConfig
-	remotecfg = remoteAnnexStallDetection $ Remote.gitconfig r
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index add60706d6..f49a995ac4 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -24,7 +24,6 @@ import Assistant.Alert
 import Assistant.Alert.Utility
 import Assistant.Commits
 import Assistant.Drop
-import Annex.Transfer (stallDetection)
 import Types.Transfer
 import Logs.Transfer
 import Logs.Location
@@ -126,7 +125,8 @@ genTransfer t info = case transferRemote info of
 			( do
 				debug [ "Transferring:" , describeTransfer t info ]
 				notifyTransfer
-				sd <- liftAnnex $ stallDetection remote
+				let sd = remoteAnnexStallDetection
+					(Remote.gitconfig remote)
 				return $ Just (t, info, go remote sd)
 			, do
 				debug [ "Skipping unnecessary transfer:",
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 5cdde68f37..5c94743e89 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -123,7 +123,6 @@ data GitConfig = GitConfig
 	, annexRetry :: Maybe Integer
 	, annexForwardRetry :: Maybe Integer
 	, annexRetryDelay :: Maybe Seconds
-	, annexStallDetection :: Maybe StallDetection
 	, annexAllowedUrlSchemes :: S.Set Scheme
 	, annexAllowedIPAddresses :: String
 	, annexAllowUnverifiedDownloads :: Bool
@@ -217,9 +216,6 @@ extractGitConfig configsource r = GitConfig
 	, annexForwardRetry = getmayberead (annexConfig "forward-retry")
 	, annexRetryDelay = Seconds
 		<$> getmayberead (annexConfig "retrydelay")
-	, annexStallDetection =
-		either (const Nothing) id . parseStallDetection
-			=<< getmaybe (annexConfig "stalldetection")
 	, annexAllowedUrlSchemes = S.fromList $ map mkScheme $
 		maybe ["http", "https", "ftp"] words $
 			getmaybe (annexConfig "security.allowed-url-schemes")
-- 
2.30.2