added an optional cost= configuration to all special remotes
authorJoey Hess <joeyh@joeyh.name>
Thu, 12 Jan 2023 17:42:28 +0000 (13:42 -0400)
committerJoey Hess <joeyh@joeyh.name>
Thu, 12 Jan 2023 17:42:28 +0000 (13:42 -0400)
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
25 files changed:
Annex/SpecialRemote/Config.hs
CHANGELOG
Config.hs
Remote/Adb.hs
Remote/BitTorrent.hs
Remote/Borg.hs
Remote/Bup.hs
Remote/Ddar.hs
Remote/Directory.hs
Remote/External.hs
Remote/GCrypt.hs
Remote/Git.hs
Remote/GitLFS.hs
Remote/Glacier.hs
Remote/Hook.hs
Remote/HttpAlso.hs
Remote/P2P.hs
Remote/Rsync.hs
Remote/S3.hs
Remote/Tahoe.hs
Remote/WebDAV.hs
doc/git-annex-initremote.mdwn
doc/tips/using_the_web_as_a_special_remote.mdwn
doc/todo/Allow_for_URLs_prioritization_WITHIN___40__web__41___remote.mdwn
doc/todo/Allow_for_URLs_prioritization_WITHIN___40__web__41___remote/comment_11_a7087acb84b3139418c597496e18f4a1._comment [new file with mode: 0644]

index 2f921d49515cc187f8d48516c050521c11df2531..f1475577fcc2ecf890285439b2bc4c72bcffa923 100644 (file)
@@ -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)
index 8d9bec07c004a3fc689c35600953642b5f29f7de..beea589e4543057767d64dfbc7f86a5ebd75b9d4 100644 (file)
--- a/CHANGELOG
+++ b/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
 
index 0af6810e31b26fac32940275f8584ea9087c42bb..e4d563cfae79fc170ab91ac0a798de1285564f04 100644 (file)
--- a/Config.hs
+++ b/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
-
-remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
-remoteCost' = liftIO . getDynamicConfig . remoteAnnexCost
+{- 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 -> 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)
index 4f51887b4a9835cebe93df2aaf5a9eaf83919848..d4144f1988a4a61fafa577e1706750c3853bdd70 100644 (file)
@@ -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
index b67d438335e4729258407ea43d78d6120672f644..8bcae6e2f17467ebd209eec2fa9e82a2eb7190e4 100644 (file)
@@ -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
index 2d347e35857317327633adec4b27e0c342acc0ae..30414db79e64d5ffb021e8dae5e676c7d19d7fe1 100644 (file)
@@ -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 $
                if borgLocal borgrepo
                        then nearlyCheapRemoteCost
                        else expensiveRemoteCost
index e4608e8a50380b6585bf44c4597c1d8f48187999..b2c11dece4ec5fdae4b0f60f7ee0f6e23446be26 100644 (file)
@@ -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 $
                if bupLocal buprepo
                        then nearlyCheapRemoteCost
                        else expensiveRemoteCost
index c4c0571e9ebce44ec3ad10db4a78ca82e9cad50d..bdbb2e222ea4180abd58a597b744b27fb1319e9b 100644 (file)
@@ -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 $
                if ddarLocal ddarrepo
                        then nearlyCheapRemoteCost
                        else expensiveRemoteCost
index c0361b4d0f6bed345ca915ff0730ce73c4acd359..dcefa0a9e72e2b0cec139f1047dff8dc2f4ad593 100644 (file)
@@ -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 $
index 7eb5a4be66890f1e1851e4ffc02cc1b477624441..83f1b0410b1fbebad49593d9a6935001ff290bc6 100644 (file)
@@ -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 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
index e6d301167a7922bfce89c6270de36c213689ef76..fb5b5aafbcbf656f68e9ed87ede481c2914d506c 100644 (file)
@@ -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
index 81d00f02ae85748d596e146108bb28759ecd39c0..17b78d8e2a5cf4ff1da10eb5937b8d438b9c4b68 100644 (file)
@@ -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 defcst
                Just addr -> Remote.P2P.chainGen addr r u rc gc rs
   where
        defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
index 7cc79c7a5a916b3fff75abb6cc5f14630bbfece0..0ad4a63f7d80d1ddbaabddb3093a94afdccb9fa1 100644 (file)
@@ -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 expensiveRemoteCost
        let specialcfg = (specialRemoteCfg c)
                -- chunking would not improve git-lfs
                { chunkConfig = NoChunks
index 37d4f1e44fc293e844804dfdda1218daf41d07ad..e97ad12da4d9ac6cd1847c903b98c87798a9170d 100644 (file)
@@ -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)
index 3c715ac5fe64d37c45b0b9e11b0ad348fdc54e8a..b27bcaa34196e786b6d7425bc3bcd7ff7302898f 100644 (file)
@@ -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 expensiveRemoteCost
        return $ Just $ specialRemote c
                (store hooktype)
                (retrieve hooktype)
index c423ba8fad43020aa98a633f740645755b134c7c..e77fb9a49885c7dc9d34e0220a5dee2de0df92fb 100644 (file)
@@ -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 expensiveRemoteCost
        let url = getRemoteConfigValue urlField c
        ll <- liftIO newLearnedLayout
        return $ Just $ this url ll c cst
index 15c2ea1f3e002c0146b55acffdd1c2479ce47d5e..3ab66b56349e419d1dbab22d6a2eccb106b4da4e 100644 (file)
@@ -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 veryExpensiveRemoteCost
        let protorunner = runProto u addr connpool
        let withconn = withConnection u addr connpool
        let this = Remote 
index fc1a048e9cb89b414c4a4e3784154d98b548b078..99b774221d0ec24d62737c4c4c18b05f0ae3d8f1 100644 (file)
@@ -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 expensiveRemoteCost
        (transport, url) <- rsyncTransport gc $
                fromMaybe (giveup "missing rsyncurl") $ remoteAnnexRsyncUrl gc
        protectsargs <- liftIO probeRsyncProtectsArgs
index b4e63dbaa63b1573722bb2b68aa71d98ef73fa1b..f5014202eb08fe3672d00072ac80236155592a6d 100644 (file)
@@ -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 expensiveRemoteCost
        info <- extractS3Info c
        hdl <- mkS3HandleVar c gc u
        magic <- liftIO initMagicMime
index 22edac48101da28938e5793e45cde173edfd5b71..d5b6a0902ef50936ce496f5b2a64204c0cd67b4e 100644 (file)
@@ -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 expensiveRemoteCost
        hdl <- liftIO $ TahoeHandle
                <$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc)
                <*> newEmptyTMVarIO
index 9499f4bd76aa8b3ca3efe106dfa3888d0e83d7e5..d48c2353d6f208e5456ac7f3d6da02c8dcf2d7ca 100644 (file)
@@ -72,7 +72,7 @@ gen r u rc gc rs = do
        c <- parsedRemoteConfig remote rc
        new
                <$> pure c
-               <*> remoteCost gc expensiveRemoteCost
+               <*> remoteCost gc expensiveRemoteCost
                <*> mkDavHandleVar c gc u
   where
        new c cst hdl = Just $ specialRemote c
index 4142a915f84abb13e30a2a6a7618c8ddc95600e5..3a0006a464763b43059860ffff99ec7da8cec655 100644 (file)
@@ -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
index f29fc70b122c9941127e6681120f45788c169cd3..aacf91f2c81d7227359507c20be4dd2ecacc37ff 100644 (file)
@@ -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,
index 06feaf9c8aad6a3989db401476a615157b1aebc3..a67469d545b1c8c9a6756c2d5758889a0d2445b5 100644 (file)
@@ -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]]
diff --git a/doc/todo/Allow_for_URLs_prioritization_WITHIN___40__web__41___remote/comment_11_a7087acb84b3139418c597496e18f4a1._comment b/doc/todo/Allow_for_URLs_prioritization_WITHIN___40__web__41___remote/comment_11_a7087acb84b3139418c597496e18f4a1._comment
new file mode 100644 (file)
index 0000000..4b01ae9
--- /dev/null
@@ -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
+"""]]