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

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
+	-- adb operates over USB or wifi, so is not as cheap
+	-- as local, but not too expensive
+	cst <- remoteCost gc c semiExpensiveRemoteCost
 	let this = Remote
 		{ uuid = u
-		-- adb operates over USB or wifi, so is not as cheap
-		-- as local, but not too expensive
-		, cost = semiExpensiveRemoteCost
+		, 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