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

diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index c57dbaf3ecf81f099b35e467daf001cac50f6e2f..c6597baec26b44edb2df453937dccd7b001921f2 100644 (file)
--- 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 add60706d6e6c345ab79e8310723ab3331331845..f49a995ac4640ba7f0b5c5f4db2d7aef7b624f7a 100644 (file)
--- 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 5cdde68f3756adf9d06f6392023af68d1f52a592..5c94743e891e28726a3e5225d063d42fa5980e1a 100644 (file)
--- 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")