add directional stalldetection and bwlimit configs

Sponsored-by: Dartmouth College's DANDI project

12 files changed, 105 insertions, 30 deletions

diff --git a/Annex/Import.hs b/Annex/Import.hs
index 959158466b..eaf41f4f79 100644
--- a/Annex/Import.hs
+++ b/Annex/Import.hs
@@ -798,7 +798,6 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
 					, providedMimeEncoding = Nothing
 					, providedLinkType = Nothing
 					}
-				let bwlimit = remoteAnnexBwLimit (Remote.gitconfig remote)
 				islargefile <- checkMatcher' matcher mi mempty
 				metered Nothing sz bwlimit $ const $ if islargefile
 					then doimportlarge importkey cidmap loc cid sz f
@@ -895,7 +894,6 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
 			Left e -> do
 				warning (UnquotedString (show e))
 				return Nothing
-		let bwlimit = remoteAnnexBwLimit (Remote.gitconfig remote)
 		checkDiskSpaceToGet tmpkey Nothing Nothing $
 			notifyTransfer Download af $
 				download' (Remote.uuid remote) tmpkey af Nothing stdRetry $ \p ->
@@ -924,6 +922,9 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
 				else gitShaKey <$> hashFile tmpfile
 	
 	ia = Remote.importActions remote
+				
+	bwlimit = remoteAnnexBwLimitDownload (Remote.gitconfig remote)
+			<|> remoteAnnexBwLimit (Remote.gitconfig remote)
 
 	locworktreefile loc = fromRepo $ fromTopFilePath $ asTopFilePath $
 		case importtreeconfig of
diff --git a/Annex/StallDetection.hs b/Annex/StallDetection.hs
index 21b958ce58..9b885c2ecf 100644
--- a/Annex/StallDetection.hs
+++ b/Annex/StallDetection.hs
@@ -5,10 +5,16 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Annex.StallDetection (detectStalls, StallDetection) where
+module Annex.StallDetection (
+	getStallDetection,
+	detectStalls,
+	StallDetection,
+) where
 
 import Annex.Common
 import Types.StallDetection
+import Types.Direction
+import Types.Remote (gitconfig)
 import Utility.Metered
 import Utility.HumanTime
 import Utility.DataUnits
@@ -18,6 +24,14 @@ import Control.Concurrent.STM
 import Control.Monad.IO.Class (MonadIO)
 import Data.Time.Clock
 
+getStallDetection :: Direction -> Remote -> Maybe StallDetection
+getStallDetection Download r = 
+	remoteAnnexStallDetectionDownload (gitconfig r)
+		<|> remoteAnnexStallDetection (gitconfig r)
+getStallDetection Upload r =
+	remoteAnnexStallDetectionUpload (gitconfig r)
+		<|> remoteAnnexStallDetection (gitconfig r)
+
 {- This may be safely canceled (with eg uninterruptibleCancel),
  - as long as the passed action can be safely canceled. -}
 detectStalls :: (Monad m, MonadIO m) => Maybe StallDetection -> TVar (Maybe BytesProcessed) -> m () -> m ()
@@ -120,7 +134,7 @@ upscale input@(BwRate minsz duration) timepassedsecs
 		(Duration (ceiling (fromIntegral dsecs * scale)))
 	| otherwise = input
   where
-	scale = max 1 $
+	scale = max (1 :: Double) $
 		(fromIntegral timepassedsecs / fromIntegral (max dsecs 1))
 		* fromIntegral allowedvariation
 	
diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index 4cc9b56e5a..d31863f2b8 100644
--- a/Annex/Transfer.hs
+++ b/Annex/Transfer.hs
@@ -56,7 +56,7 @@ import Data.Ord
 -- Upload, supporting canceling detected stalls.
 upload :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
 upload r key f d witness = 
-	case remoteAnnexStallDetection (Remote.gitconfig r) of
+	case getStallDetection Upload r of
 		Nothing -> go (Just ProbeStallDetection)
 		Just StallDetectionDisabled -> go Nothing
 		Just sd -> runTransferrer sd r key f d Upload witness
@@ -75,7 +75,7 @@ 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 = 
-	case remoteAnnexStallDetection (Remote.gitconfig r) of
+	case getStallDetection Download r of
 		Nothing -> go (Just ProbeStallDetection)
 		Just StallDetectionDisabled -> go Nothing
 		Just sd -> runTransferrer sd r key f d Download witness
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index bf14118f64..c16871f468 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -33,6 +33,7 @@ import qualified Remote
 import qualified Types.Remote as Remote
 import Annex.Content
 import Annex.Wanted
+import Annex.StallDetection
 import Utility.Batch
 import Types.NumCopies
 
@@ -126,8 +127,7 @@ genTransfer t info = case transferRemote info of
 				qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
 				debug [ "Transferring:" , describeTransfer qp t info ]
 				notifyTransfer
-				let sd = remoteAnnexStallDetection
-					(Remote.gitconfig remote)
+				let sd = getStallDetection (transferDirection t) remote
 				return $ Just (t, info, go remote sd)
 			, do
 				qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
diff --git a/CHANGELOG b/CHANGELOG
index c38ba6ecb5..e01b60df1b 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -18,6 +18,9 @@ git-annex (10.20231228) UNRELEASED; urgency=medium
   * external: Monitor file size when getting content from external
     special remotes and use that to update the progress meter,
     in case the external special remote program does not report progress.
+  * Added configs annex.stalldetection-download, annex.stalldetection-upload,
+    annex.bwlimit-download, annex.bwlimit-upload,
+    and similar per-remote configs.
 
  -- Joey Hess <id@joeyh.name>  Fri, 29 Dec 2023 11:52:06 -0400
 
diff --git a/Remote/Git.hs b/Remote/Git.hs
index f7fe1f9199..bba505e378 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -484,7 +484,8 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key file dest meterupdate vc
 	| not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ do
 		u <- getUUID
 		hardlink <- wantHardLink
-		let bwlimit = remoteAnnexBwLimit (gitconfig r)
+		let bwlimit = remoteAnnexBwLimitDownload (gitconfig r)
+			<|> remoteAnnexBwLimit (gitconfig r)
 		-- run copy from perspective of remote
 		onLocalFast st $ Annex.Content.prepSendAnnex' key >>= \case
 			Just (object, _sz, check) -> do
@@ -552,7 +553,8 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
 		checkio <- Annex.withCurrentState check
 		u <- getUUID
 		hardlink <- wantHardLink
-		let bwlimit = remoteAnnexBwLimit (gitconfig r)
+		let bwlimit = remoteAnnexBwLimitUpload (gitconfig r)
+			<|> remoteAnnexBwLimit (gitconfig r)
 		-- run copy from perspective of remote
 		res <- onLocalFast st $ ifM (Annex.Content.inAnnex key)
 			( return True
diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index c76f4d4d02..ed9d3bffa4 100644
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -35,7 +35,7 @@ type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) ->
 store :: RemoteGitConfig -> ProtoRunner Bool -> Key -> AssociatedFile -> MeterUpdate -> Annex ()
 store gc runner k af p = do
 	let sizer = KeySizer k (fmap (toRawFilePath . fst3) <$> prepSendAnnex k)
-	let bwlimit = remoteAnnexBwLimit gc
+	let bwlimit = remoteAnnexBwLimitUpload gc <|> remoteAnnexBwLimit gc
 	metered (Just p) sizer bwlimit $ \_ p' ->
 		runner (P2P.put k af p') >>= \case
 			Just True -> return ()
@@ -45,7 +45,7 @@ store gc runner k af p = do
 retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 retrieve gc runner k af dest p verifyconfig = do
 	iv <- startVerifyKeyContentIncrementally verifyconfig k
-	let bwlimit = remoteAnnexBwLimit gc
+	let bwlimit = remoteAnnexBwLimitDownload gc <|> remoteAnnexBwLimit gc
 	metered (Just p) k bwlimit $ \m p' -> 
 		runner (P2P.get dest k iv af m p') >>= \case
 			Just (True, v) -> return v
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 5b86df46d8..4cb6124159 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -212,9 +212,9 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 			then whereisKey baser
 			else Nothing
 		, exportActions = (exportActions baser)
-			{ storeExport = \f k l p -> displayprogress p k (Just f) $
+			{ storeExport = \f k l p -> displayprogress uploadbwlimit p k (Just f) $
 				storeExport (exportActions baser) f k l
-			, retrieveExport = \k l f p -> displayprogress p k Nothing $
+			, retrieveExport = \k l f p -> displayprogress downloadbwlimit p k Nothing $
 				retrieveExport (exportActions baser) k l f
 			}
 		}
@@ -223,7 +223,7 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 
 	-- chunk, then encrypt, then feed to the storer
 	storeKeyGen k p enc = sendAnnex k rollback $ \src _sz ->
-		displayprogress p k (Just src) $ \p' ->
+		displayprogress uploadbwlimit p k (Just src) $ \p' ->
 			storeChunks (uuid baser) chunkconfig enck k src p'
 				enc encr storer checkpresent
 	  where
@@ -232,7 +232,7 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 
 	-- call retriever to get chunks; decrypt them; stream to dest file
 	retrieveKeyFileGen k dest p vc enc =
-		displayprogress p k Nothing $ \p' ->
+		displayprogress downloadbwlimit p k Nothing $ \p' ->
 			retrieveChunks retriever (uuid baser) vc
 				chunkconfig enck k dest p' enc encr
 	  where
@@ -250,9 +250,13 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 
 	chunkconfig = chunkConfig cfg
 
-	displayprogress p k srcfile a
+	downloadbwlimit = remoteAnnexBwLimitDownload (gitconfig baser)
+		<|> remoteAnnexBwLimit (gitconfig baser)
+	uploadbwlimit = remoteAnnexBwLimitUpload (gitconfig baser)
+		<|> remoteAnnexBwLimit (gitconfig baser)
+
+	displayprogress bwlimit p k srcfile a
 		| displayProgress cfg = do
-			let bwlimit = remoteAnnexBwLimit (gitconfig baser)
 			metered (Just p) (KeySizer k (pure (fmap toRawFilePath srcfile))) bwlimit (const a)
 		| otherwise = a p
 
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 0c531fbf06..d2bf3cf1cd 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -1,6 +1,6 @@
 {- git-annex configuration
  -
- - Copyright 2012-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -359,7 +359,11 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexForwardRetry :: Maybe Integer
 	, remoteAnnexRetryDelay :: Maybe Seconds
 	, remoteAnnexStallDetection :: Maybe StallDetection
+	, remoteAnnexStallDetectionUpload :: Maybe StallDetection
+	, remoteAnnexStallDetectionDownload :: Maybe StallDetection
 	, remoteAnnexBwLimit :: Maybe BwRate
+	, remoteAnnexBwLimitUpload :: Maybe BwRate
+	, remoteAnnexBwLimitDownload :: Maybe BwRate
 	, remoteAnnexAllowUnverifiedDownloads :: Bool
 	, remoteAnnexConfigUUID :: Maybe UUID
 
@@ -426,11 +430,17 @@ extractRemoteGitConfig r remotename = do
 		, remoteAnnexRetryDelay = Seconds
 			<$> getmayberead "retrydelay"
 		, remoteAnnexStallDetection =
-			either (const Nothing) Just . parseStallDetection
-				=<< getmaybe "stalldetection"
-		, remoteAnnexBwLimit = do
-			sz <- readSize dataUnits =<< getmaybe "bwlimit"
-			return (BwRate sz (Duration 1))
+			readStallDetection =<< getmaybe "stalldetection"
+		, remoteAnnexStallDetectionUpload =
+			readStallDetection =<< getmaybe "stalldetection-upload"
+		, remoteAnnexStallDetectionDownload =
+			readStallDetection =<< getmaybe "stalldetection-download"
+		, remoteAnnexBwLimit =
+			readBwRatePerSecond =<< getmaybe "bwlimit"
+		, remoteAnnexBwLimitUpload =
+			readBwRatePerSecond =<< getmaybe "bwlimit-upload"
+		, remoteAnnexBwLimitDownload =
+			readBwRatePerSecond =<< getmaybe "bwlimit-download"
 		, remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $
 			getmaybe ("security-allow-unverified-downloads")
 		, remoteAnnexConfigUUID = toUUID <$> getmaybe "config-uuid"
diff --git a/Types/StallDetection.hs b/Types/StallDetection.hs
index 13d88699f2..2278119f4e 100644
--- a/Types/StallDetection.hs
+++ b/Types/StallDetection.hs
@@ -1,6 +1,6 @@
 {- types for stall detection and banwdith rates
  -
- - Copyright 2020-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2020-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -39,6 +39,9 @@ parseStallDetection s = case isTrueFalse s of
 	Just True -> Right ProbeStallDetection
 	Just False -> Right StallDetectionDisabled
 
+readStallDetection :: String -> Maybe StallDetection
+readStallDetection = either (const Nothing) Just . parseStallDetection
+
 parseBwRate :: String -> Either String BwRate
 parseBwRate s = do
 	let (bs, ds) = separate (== '/') s
@@ -48,3 +51,8 @@ parseBwRate s = do
 		(readSize dataUnits bs)
 	d <- parseDuration ds
 	Right (BwRate b d)
+
+readBwRatePerSecond :: String -> Maybe BwRate
+readBwRatePerSecond s = do
+	sz <- readSize dataUnits s
+	return (BwRate sz (Duration 1))
diff --git a/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment b/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment
index e4e56806bb..993ea416a1 100644
--- a/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment
+++ b/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment
@@ -15,8 +15,11 @@ downloads but allow slow uploads. For example, `git-annex get` with
 the content on several remotes, where the download speed from one
 remote is often fast but occasionally slows down, and another remote
 is consistently medium speed.
-So you might set "10gb/1m" for that remote, knowing that if it is slow
-it will abort the download from it and fall back to the medium speed remote.
-But when sending content *to* the variable speed remote, would not want to
-give up only because it was a little slow.
+
+So you might set "10gb/1m" for downloads from remote, knowing that if it is
+slow it will abort the download from it and fall back to the medium speed
+remote. But when sending content *to* the variable speed remote, would not
+want to give up only because it was a little slow.
+
+Ok, added annex.stalldetection-download, annex.stalldetection-upload, etc.
 """]]
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 37f7de0b94..7b895701e4 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1521,7 +1521,19 @@ Remotes are configured using these settings in `.git/config`.
   for remotes where the transfer is run by a separate program than
   git-annex. 
 
-* `remote.<name>.annex-stalldetecton`, `annex.stalldetection`
+* `remote.<name>.annex-bwlimit-download`, `annex.bwlimit-download`
+
+  Limit bandwith for downloads from a remote.
+  
+  Overrides `remote.<name>.annex-bwlimit` and `annex.bwlimit`
+
+* `remote.<name>.annex-bwlimit-upload`, `annex.bwlimit-upload`
+  
+  Limit bandwith for uploads to a remote. 
+
+  Overrides `remote.<name>.annex-bwlimit` and `annex.bwlimit`
+
+* `remote.<name>.annex-stalldetection`, `annex.stalldetection`
 
   Configuring this lets stalled or too-slow transfers be detected, and
   dealt with, so rather than getting stuck, git-annex will cancel the
@@ -1567,6 +1579,24 @@ Remotes are configured using these settings in `.git/config`.
   connections to a remote than usual, or the communication with those
   processes may make it a bit slower.
 
+* `remote.<name>.annex-stalldetection-download`, `annex.stalldetection-download`
+
+  Stall detection for downloads from a remote.
+ 
+  For example, if a remote is often fast, but sometimes is very slow,
+  and there is another remote that is consistently medium speed
+  and that contains the same data, this could be set to treat the fast
+  remote as stalled when it's slow. Then a command like `git-annex get`
+  will fall back to downloading from the medium speed remote.
+
+  Overrides `remote.<name>.annex-stalldetection`, `annex.stalldetection`
+
+* `remote.<name>.annex-stalldetection-upload`, `annex.stalldetection-upload`
+
+  Stall detection for uploads to a remote.
+
+  Overrides `remote.<name>.annex-stalldetection`, `annex.stalldetection`
+
 * `remote.<name>.annex-checkuuid`
 
   This only affects remotes that have their url pointing to a directory on