{- 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.
-}
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
autoEnableField :: RemoteConfigField
autoEnableField = Accepted "autoenable"
+costField :: RemoteConfigField
+costField = Accepted "cost"
+
encryptionField :: RemoteConfigField
encryptionField = Accepted "encryption"
(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)
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)
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
{- 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.
-}
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. -}
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)
import Types.Export
import Types.Import
import qualified Git
+import Config
import Config.Cost
import Remote.Helper.Special
import Remote.Helper.ExportImport
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
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
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
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
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
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 $
-- 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)
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
{- 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
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
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
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
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)
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)
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
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
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
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
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
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
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
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
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,
[[!meta author=yoh]]
[[!tag projects/dandi]]
+
+> [[fixed|done]] --[[Joey]]
--- /dev/null
+[[!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
+"""]]