added an optional cost= configuration to all special remotes

Note that when this is specified and an older git-annex is used to
enableremote such a special remote, it will simply ignore the cost= field
and use whatever the default cost is.

In passing, fixed adb to support the remote.name.cost and
remote.name.cost-command configs.

Sponsored-by: Dartmouth College's DANDI project

Annex/SpecialRemote/Config.hs

@@ -1,6 +1,6 @@
 {- git-annex special remote configuration
  -
- - Copyright 2019-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -17,9 +17,11 @@ import Types.UUID
 import Types.ProposedAccepted
 import Types.RemoteConfig
 import Types.GitConfig
+import Config.Cost
 
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Text.Read
 import Data.Typeable
 import GHC.Stack
 
@@ -56,6 +58,9 @@ typeField = Accepted "type"
 autoEnableField :: RemoteConfigField
 autoEnableField = Accepted "autoenable"
 
+costField :: RemoteConfigField
+costField = Accepted "cost"
+
 encryptionField :: RemoteConfigField
 encryptionField = Accepted "encryption"
 
@@ -106,6 +111,8 @@ commonFieldParsers =
 		(FieldDesc "type of special remote")
 	, trueFalseParser autoEnableField (Just False)
 		(FieldDesc "automatically enable special remote")
+	, costParser costField
+		(FieldDesc "default cost of this special remote")
 	, yesNoParser exportTreeField (Just False)
 		(FieldDesc "export trees of files to this remote")
 	, yesNoParser importTreeField (Just False)
@@ -252,6 +259,13 @@ trueFalseParser' "true" = Just True
 trueFalseParser' "false" = Just False
 trueFalseParser' _ = Nothing
 
+costParser :: RemoteConfigField -> FieldDesc -> RemoteConfigFieldParser
+costParser f fd = genParser readcost f Nothing fd
+	(Just (ValueDesc "a number"))
+  where
+	readcost :: String -> Maybe Cost
+	readcost = readMaybe
+
 genParser
 	:: Typeable t
 	=> (String -> Maybe t)

CHANGELOG

@@ -20,6 +20,8 @@ git-annex (10.20221213) UNRELEASED; urgency=medium
     these provide additional names for the web special remote, and may
     also have their own additional configuration and cost.
   * web: Add urlinclude and urlexclude configuration settings.
+  * Added an optional cost= configuration to all special remotes.
+  * adb: Support the remote.name.cost and remote.name.cost-command configs.
 
  -- Joey Hess <id@joeyh.name>  Mon, 12 Dec 2022 13:04:54 -0400
 

Config.hs

@@ -1,6 +1,6 @@
 {- Git configuration
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -24,7 +24,9 @@ import Config.Cost
 import Config.DynamicConfig
 import Types.Availability
 import Types.GitConfig
+import Types.RemoteConfig
 import Git.Types
+import Annex.SpecialRemote.Config
 
 {- Looks up a setting in git config. This is not as efficient as using the
  - GitConfig type. -}
@@ -51,14 +53,17 @@ reloadConfig = Annex.changeGitRepo =<< inRepo Git.Config.reRead
 unsetConfig :: ConfigKey -> Annex ()
 unsetConfig key = void $ inRepo $ Git.Config.unset key
 
-{- Calculates cost for a remote. Either the specific default, or as configured 
- - by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
- - is set and prints a number, that is used. -}
-remoteCost :: RemoteGitConfig -> Cost -> Annex Cost
-remoteCost c d = fromMaybe d <$> remoteCost' c
+{- Gets cost for a remote. As configured by
+ - remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
+ - is set and prints a number, that is used. If neither is set,
+ - using the cost field from the ParsedRemoteConfig, and if it is not set,
+ - the specified default. -}
+remoteCost :: RemoteGitConfig -> ParsedRemoteConfig -> Cost -> Annex Cost
+remoteCost gc pc d = fromMaybe d <$> remoteCost' gc pc
 
-remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
-remoteCost' = liftIO . getDynamicConfig . remoteAnnexCost
+remoteCost' :: RemoteGitConfig -> ParsedRemoteConfig -> Annex (Maybe Cost)
+remoteCost' gc pc = maybe (getRemoteConfigValue costField pc) Just
+	<$> liftIO (getDynamicConfig $ remoteAnnexCost gc)
 
 setRemoteCost :: Git.Repo -> Cost -> Annex ()
 setRemoteCost r c = setConfig (remoteAnnexConfig r "cost") (show c)

Remote/Adb.hs

@@ -15,6 +15,7 @@ import Types.Creds
 import Types.Export
 import Types.Import
 import qualified Git
+import Config
 import Config.Cost
 import Remote.Helper.Special
 import Remote.Helper.ExportImport
@@ -70,11 +71,12 @@ oldandroidField = Accepted "oldandroid"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	let this = Remote
-		{ uuid = u
 	-- adb operates over USB or wifi, so is not as cheap
 	-- as local, but not too expensive
-		, cost = semiExpensiveRemoteCost
+	cst <- remoteCost gc c semiExpensiveRemoteCost
+	let this = Remote
+		{ uuid = u
+		, cost = cst
 		, name = Git.repoDescribe r
 		, storeKey = storeKeyDummy
 		, retrieveKeyFile = retrieveKeyFileDummy

Remote/BitTorrent.hs

@@ -60,8 +60,8 @@ list _autoinit = do
 
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r _ rc gc rs = do
-	cst <- remoteCost gc expensiveRemoteCost
 	c <- parsedRemoteConfig remote rc
+	cst <- remoteCost gc c expensiveRemoteCost
 	return $ Just Remote
 		{ uuid = bitTorrentUUID
 		, cost = cst

Remote/Borg.hs

@@ -75,7 +75,7 @@ appendonlyField = Accepted "appendonly"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc $
+	cst <- remoteCost gc c $
 		if borgLocal borgrepo
 			then nearlyCheapRemoteCost
 			else expensiveRemoteCost

Remote/Bup.hs

@@ -65,7 +65,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
 	bupr <- liftIO $ bup2GitRemote buprepo
-	cst <- remoteCost gc $
+	cst <- remoteCost gc c $
 		if bupLocal buprepo
 			then nearlyCheapRemoteCost
 			else expensiveRemoteCost

Remote/Ddar.hs

@@ -55,7 +55,7 @@ ddarrepoField = Accepted "ddarrepo"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc $
+	cst <- remoteCost gc c $
 		if ddarLocal ddarrepo
 			then nearlyCheapRemoteCost
 			else expensiveRemoteCost

Remote/Directory.hs

@@ -73,7 +73,7 @@ ignoreinodesField = Accepted "ignoreinodes"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc cheapRemoteCost
+	cst <- remoteCost gc c cheapRemoteCost
 	let chunkconfig = getChunkConfig c
 	cow <- liftIO newCopyCoWTried
 	let ii = IgnoreInodes $ fromMaybe True $

Remote/External.hs

@@ -67,7 +67,7 @@ gen r u rc gc rs
 	-- readonly mode only downloads urls; does not use external program
 	| externaltype == "readonly" = do
 		c <- parsedRemoteConfig remote rc
-		cst <- remoteCost gc expensiveRemoteCost
+		cst <- remoteCost gc c expensiveRemoteCost
 		let rmt = mk c cst GloballyAvailable
 			Nothing
 			(externalInfo externaltype)
@@ -86,7 +86,7 @@ gen r u rc gc rs
 		external <- newExternal externaltype (Just u) c (Just gc)
 			(Git.remoteName r) (Just rs)
 		Annex.addCleanupAction (RemoteCleanup u) $ stopExternal external
-		cst <- getCost external r gc
+		cst <- getCost external r gc c
 		avail <- getAvailability external r gc
 		exportsupported <- if exportTree c
 			then checkExportSupported' external
@@ -755,9 +755,9 @@ respErrorMessage req err
 {- Caches the cost in the git config to avoid needing to start up an
  - external special remote every time time just to ask it what its
  - cost is. -}
-getCost :: External -> Git.Repo -> RemoteGitConfig -> Annex Cost
-getCost external r gc =
-	(go =<< remoteCost' gc) `catchNonAsync` const (pure defcst)
+getCost :: External -> Git.Repo -> RemoteGitConfig -> ParsedRemoteConfig -> Annex Cost
+getCost external r gc pc =
+	(go =<< remoteCost' gc pc) `catchNonAsync` const (pure defcst)
   where
 	go (Just c) = return c
 	go Nothing = do

Remote/GCrypt.hs

@@ -127,8 +127,10 @@ gen baser u rc gc rs = do
 
 gen' :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen' r u c gc rs = do
-	cst <- remoteCost gc $
-		if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
+	cst <- remoteCost gc c $
+		if repoCheap r
+			then nearlyCheapRemoteCost
+			else expensiveRemoteCost
 	let (rsynctransport, rsyncurl, accessmethod) = rsyncTransportToObjects r gc
 	protectsargs <- liftIO Remote.Rsync.probeRsyncProtectsArgs
 	let rsyncopts = Remote.Rsync.genRsyncOpts protectsargs c gc rsynctransport rsyncurl

Remote/Git.hs

@@ -174,7 +174,7 @@ gen r u rc gc rs
 		Nothing -> do
 			st <- mkState r u gc
 			c <- parsedRemoteConfig remote rc
-			go st c <$> remoteCost gc defcst
+			go st c <$> remoteCost gc c defcst
 		Just addr -> Remote.P2P.chainGen addr r u rc gc rs
   where
 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost

Remote/GitLFS.hs

@@ -93,7 +93,7 @@ gen r u rc gc rs = do
 		else pure r
 	sem <- liftIO $ MSemN.new 1
 	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc
-	cst <- remoteCost gc expensiveRemoteCost
+	cst <- remoteCost gc c expensiveRemoteCost
 	let specialcfg = (specialRemoteCfg c)
 		-- chunking would not improve git-lfs
 		{ chunkConfig = NoChunks

Remote/Glacier.hs

@@ -63,9 +63,10 @@ fileprefixField :: RemoteConfigField
 fileprefixField = Accepted "fileprefix"
 
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
-gen r u rc gc rs = new 
-	<$> parsedRemoteConfig remote rc
-	<*> remoteCost gc veryExpensiveRemoteCost
+gen r u rc gc rs = do
+	c <- parsedRemoteConfig remote rc
+	cst <- remoteCost gc c veryExpensiveRemoteCost
+	return (new c cst)
   where
 	new c cst = Just $ specialRemote' specialcfg c
 		(store this)

Remote/Hook.hs

@@ -50,7 +50,7 @@ hooktypeField = Accepted "hooktype"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc expensiveRemoteCost
+	cst <- remoteCost gc c expensiveRemoteCost
 	return $ Just $ specialRemote c
 		(store hooktype)
 		(retrieve hooktype)

Remote/HttpAlso.hs

@@ -50,7 +50,7 @@ urlField = Accepted "url"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc expensiveRemoteCost
+	cst <- remoteCost gc c expensiveRemoteCost
 	let url = getRemoteConfigValue urlField c
 	ll <- liftIO newLearnedLayout
 	return $ Just $ this url ll c cst

Remote/P2P.hs

@@ -48,7 +48,7 @@ chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig ->
 chainGen addr r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
 	connpool <- mkConnectionPool
-	cst <- remoteCost gc veryExpensiveRemoteCost
+	cst <- remoteCost gc c veryExpensiveRemoteCost
 	let protorunner = runProto u addr connpool
 	let withconn = withConnection u addr connpool
 	let this = Remote 

Remote/Rsync.hs

@@ -75,7 +75,7 @@ rsyncUrlField = Accepted "rsyncurl"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc expensiveRemoteCost
+	cst <- remoteCost gc c expensiveRemoteCost
 	(transport, url) <- rsyncTransport gc $
 		fromMaybe (giveup "missing rsyncurl") $ remoteAnnexRsyncUrl gc
 	protectsargs <- liftIO probeRsyncProtectsArgs

Remote/S3.hs

@@ -187,7 +187,7 @@ mungekeysField = Accepted "mungekeys"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc expensiveRemoteCost
+	cst <- remoteCost gc c expensiveRemoteCost
 	info <- extractS3Info c
 	hdl <- mkS3HandleVar c gc u
 	magic <- liftIO initMagicMime

Remote/Tahoe.hs

@@ -79,7 +79,7 @@ furlField = Accepted "introducer-furl"
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
 gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
-	cst <- remoteCost gc expensiveRemoteCost
+	cst <- remoteCost gc c expensiveRemoteCost
 	hdl <- liftIO $ TahoeHandle
 		<$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc)
 		<*> newEmptyTMVarIO

Remote/WebDAV.hs

@@ -72,7 +72,7 @@ gen r u rc gc rs = do
 	c <- parsedRemoteConfig remote rc
 	new
 		<$> pure c
-		<*> remoteCost gc expensiveRemoteCost
+		<*> remoteCost gc c expensiveRemoteCost
 		<*> mkDavHandleVar c gc u
   where
 	new c cst hdl = Just $ specialRemote c

doc/git-annex-initremote.mdwn

@@ -106,6 +106,12 @@ want to use `git annex renameremote`.
   when the special remote does not need anything special to be done to get
   it enabled.
 
+* `cost`
+
+  Specify this to override the default cost of the special remote.
+  This configuration can be overridden by the local git config,
+  eg remote.name.annex-cost.
+
 * `uuid`
 
   Normally, git-annex initremote generates a new UUID for the new special

doc/tips/using_the_web_as_a_special_remote.mdwn

@@ -128,13 +128,12 @@ about, and git-annex may use any of those urls for downloading a file.
 If some urls are especially fast, or especially slow, you might want to
 configure which urls git-annex prefers to use first, or should only use as
 a last resory. To accomplish that, you can create additional remotes, that
-are web special remotes, and are configured to only be used for some urls.
-Then it's simply a matter of configuring the cost of those remotes.
+are web special remotes, and are configured to only be used for some urls,
+and have a different cost than the web special remote.
 
 For example, suppose that you want to prioritize using urls on "fasthost.com".
 
-    git-annex initremote --sameas=web fasthost type=web urlinclude='*//fasthost.com/*'
-    git config remote.fasthost.annex-cost 150
+    git-annex initremote --sameas=web fasthost type=web urlinclude='*//fasthost.com/*' cost=150
 
 Now, `git-annex get` of a file that is on both fasthost.com and another url
 will prefer to use the fasthost special remote, rather than the web special
@@ -145,8 +144,7 @@ remote, and use the other url.
 Suppose that you want to avoid using urls on "slowhost.com", except
 as a last resort.
     
-    git-annex initremote --sameas=web slowhost type=web urlinclude='*//slowhost.com/*'
-    git config remote.slowhost.annex-cost 300
+    git-annex initremote --sameas=web slowhost type=web urlinclude='*//slowhost.com/*' cost=300
 
 Now, `git-annex get` of a file that is on both slowhost.com and another url
 will first try the fasthost remote. If fasthost does not support the url,

doc/todo/Allow_for_URLs_prioritization_WITHIN___40__web__41___remote.mdwn

@@ -30,3 +30,5 @@ PS somehow I have some odd memory of seeing some config option to provide git-an
 
 [[!meta author=yoh]]
 [[!tag projects/dandi]]
+
+> [[fixed|done]] --[[Joey]]

doc/todo/Allow_for_URLs_prioritization_WITHIN___40__web__41___remote/comment_11_a7087acb84b3139418c597496e18f4a1._comment

@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 11"""
+ date="2023-01-12T17:38:38Z"
+ content="""
+Went ahead and implememented cost=, so now all you need is:
+
+	git-annex initremote --sameas=web dandiapi type=web urlinclude='*//api.dandiarchive.org/*' cost=300
+"""]]