type based git config handling for remotes

Still a couple of places that use git config ad-hoc, but this is most of it
done.

3 files changed, 127 insertions, 66 deletions

diff --git a/Types/Config.hs b/Types/Config.hs
deleted file mode 100644
index 898c153d5..000000000
--- a/Types/Config.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{- git-annex configuration
- -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Types.Config ( 
-	Config(..),
-	extractConfig,
-) where
-
-import Common
-import qualified Git
-import qualified Git.Config
-import Utility.DataUnits
-
-{- Main git-annex settings. Each setting corresponds to a git-config key
- - such as annex.foo -}
-data Config = Config
-	{ annexNumCopies :: Int
-	, annexDiskReserve :: Integer
-	, annexDirect :: Bool
-	, annexBackends :: [String]
-	, annexQueueSize :: Maybe Int
-	, annexBloomCapacity :: Maybe Int
-	, annexBloomAccuracy :: Maybe Int
-	, annexSshCaching :: Maybe Bool
-	, annexAlwaysCommit :: Bool
-	, annexDelayAdd :: Maybe Int
-	, annexHttpHeaders :: [String]
-	, annexHttpHeadersCommand :: Maybe String
-	}
-
-extractConfig :: Git.Repo -> Config
-extractConfig r = Config
-	{ annexNumCopies = get "numcopies" 1
-	, annexDiskReserve = fromMaybe onemegabyte $
-		readSize dataUnits =<< getmaybe "diskreserve"
-	, annexDirect = getbool "direct" False
-	, annexBackends = fromMaybe [] $
-		words <$> getmaybe "backends"
-	, annexQueueSize = getmayberead "queuesize"
-	, annexBloomCapacity = getmayberead "bloomcapacity"
-	, annexBloomAccuracy = getmayberead "bloomaccuracy"
-	, annexSshCaching = getmaybebool "sshcaching"
-	, annexAlwaysCommit = getbool "alwayscommit" True
-	, annexDelayAdd = getmayberead "delayadd"
-	, annexHttpHeaders = getlist "http-headers"
-	, annexHttpHeadersCommand = getmaybe "http-headers-command"
-	}
-  where
-	get k def = fromMaybe def $ getmayberead k
-	getbool k def = fromMaybe def $ getmaybebool k
-	getmaybebool k = Git.Config.isTrue =<< getmaybe k
-	getmayberead k = readish =<< getmaybe k
-	getmaybe k = Git.Config.getMaybe (key k) r
-	getlist k = Git.Config.getList (key k) r
-	key k = "annex." ++ k
-			
-	onemegabyte = 1000000
-
-{- Per-remote git-annex settings. Each setting corresponds to a git-config
- - key such as annex.<remote>.foo -}
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
new file mode 100644
index 000000000..f93ef1529
--- /dev/null
+++ b/Types/GitConfig.hs
@@ -0,0 +1,122 @@
+{- git-annex configuration
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.GitConfig ( 
+	GitConfig(..),
+	extractGitConfig,
+	RemoteGitConfig(..),
+	extractRemoteGitConfig,
+) where
+
+import Common
+import qualified Git
+import qualified Git.Config
+import Utility.DataUnits
+
+{- Main git-annex settings. Each setting corresponds to a git-config key
+ - such as annex.foo -}
+data GitConfig = GitConfig
+	{ annexVersion :: Maybe String
+	, annexNumCopies :: Int
+	, annexDiskReserve :: Integer
+	, annexDirect :: Bool
+	, annexBackends :: [String]
+	, annexQueueSize :: Maybe Int
+	, annexBloomCapacity :: Maybe Int
+	, annexBloomAccuracy :: Maybe Int
+	, annexSshCaching :: Maybe Bool
+	, annexAlwaysCommit :: Bool
+	, annexDelayAdd :: Maybe Int
+	, annexHttpHeaders :: [String]
+	, annexHttpHeadersCommand :: Maybe String
+	}
+
+extractGitConfig :: Git.Repo -> GitConfig
+extractGitConfig r = GitConfig
+	{ annexVersion = notempty $ getmaybe "version"
+	, annexNumCopies = get "numcopies" 1
+	, annexDiskReserve = fromMaybe onemegabyte $
+		readSize dataUnits =<< getmaybe "diskreserve"
+	, annexDirect = getbool "direct" False
+	, annexBackends = fromMaybe [] $ words <$> getmaybe "backends"
+	, annexQueueSize = getmayberead "queuesize"
+	, annexBloomCapacity = getmayberead "bloomcapacity"
+	, annexBloomAccuracy = getmayberead "bloomaccuracy"
+	, annexSshCaching = getmaybebool "sshcaching"
+	, annexAlwaysCommit = getbool "alwayscommit" True
+	, annexDelayAdd = getmayberead "delayadd"
+	, annexHttpHeaders = getlist "http-headers"
+	, annexHttpHeadersCommand = getmaybe "http-headers-command"
+	}
+  where
+	get k def = fromMaybe def $ getmayberead k
+	getbool k def = fromMaybe def $ getmaybebool k
+	getmaybebool k = Git.Config.isTrue =<< getmaybe k
+	getmayberead k = readish =<< getmaybe k
+	getmaybe k = Git.Config.getMaybe (key k) r
+	getlist k = Git.Config.getList (key k) r
+
+	key k = "annex." ++ k
+			
+	onemegabyte = 1000000
+
+{- Per-remote git-annex settings. Each setting corresponds to a git-config
+ - key such as <remote>.annex-foo, or if that is not set, a default from
+ - annex.foo -}
+data RemoteGitConfig = RemoteGitConfig
+	{ remoteAnnexCost :: Maybe Int
+	, remoteAnnexCostCommand :: Maybe String
+	, remoteAnnexIgnore :: Bool
+	, remoteAnnexSync :: Bool
+	, remoteAnnexTrustLevel :: Maybe String
+	, remoteAnnexStartCommand :: Maybe String
+	, remoteAnnexStopCommand :: Maybe String
+
+	-- these settings are specific to particular types of remotes
+	, remoteAnnexSshOptions :: [String]
+	, remoteAnnexRsyncOptions :: [String]
+	, remoteAnnexRsyncUrl :: Maybe String
+	, remoteAnnexBupRepo :: Maybe String
+	, remoteAnnexBupSplitOptions :: [String]
+	, remoteAnnexDirectory :: Maybe FilePath
+	, remoteAnnexHookType :: Maybe String
+	}
+
+extractRemoteGitConfig :: Git.Repo -> String -> RemoteGitConfig
+extractRemoteGitConfig r remotename = RemoteGitConfig
+	{ remoteAnnexCost = getmayberead "cost"
+	, remoteAnnexCostCommand = notempty $ getmaybe "cost-command"
+	, remoteAnnexIgnore = getbool "ignore" False
+	, remoteAnnexSync = getbool "sync" True
+	, remoteAnnexTrustLevel = notempty $ getmaybe "trustlevel"
+	, remoteAnnexStartCommand = notempty $ getmaybe "start-command"
+	, remoteAnnexStopCommand = notempty $ getmaybe "stop-command"
+
+	, remoteAnnexSshOptions = getoptions "ssh-options"
+	, remoteAnnexRsyncOptions = getoptions "rsync-options"
+	, remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl"
+	, remoteAnnexBupRepo = getmaybe "buprepo"
+	, remoteAnnexBupSplitOptions = getoptions "bup-split-options"
+	, remoteAnnexDirectory = notempty $ getmaybe "directory"
+	, remoteAnnexHookType = notempty $ getmaybe "hooktype"
+	}
+  where
+	getbool k def = fromMaybe def $ getmaybebool k
+	getmaybebool k = Git.Config.isTrue =<< getmaybe k
+	getmayberead k = readish =<< getmaybe k
+	getmaybe k = maybe (Git.Config.getMaybe (key k) r) Just $
+		Git.Config.getMaybe (remotekey k) r
+	getoptions k = fromMaybe [] $ words <$> getmaybe k
+
+	key k = "annex." ++ k
+	remotekey k = "remote." ++ remotename ++ ".annex-" ++ k
+
+notempty :: Maybe String -> Maybe String	
+notempty Nothing = Nothing
+notempty (Just "") = Nothing
+notempty (Just s) = Just s
+
diff --git a/Types/Remote.hs b/Types/Remote.hs
index f01ae01f6..05763e4d3 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -16,6 +16,7 @@ import qualified Git
 import Types.Key
 import Types.UUID
 import Types.Meters
+import Types.GitConfig
 
 type RemoteConfigKey = String
 type RemoteConfig = M.Map RemoteConfigKey String
@@ -27,7 +28,7 @@ data RemoteTypeA a = RemoteType {
 	-- enumerates remotes of this type
 	enumerate :: a [Git.Repo],
 	-- generates a remote of this type
-	generate :: Git.Repo -> UUID -> RemoteConfig -> a (RemoteA a),
+	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
 	-- initializes or changes a remote
 	setup :: UUID -> RemoteConfig -> a RemoteConfig
 }
@@ -64,8 +65,10 @@ data RemoteA a = Remote {
 	whereisKey :: Maybe (Key -> a [String]),
 	-- a Remote has a persistent configuration store
 	config :: RemoteConfig,
-	-- git configuration for the remote
+	-- git repo for the Remote
 	repo :: Git.Repo,
+	-- a Remote's configuration from git
+	gitconfig :: RemoteGitConfig,
 	-- a Remote can be assocated with a specific local filesystem path
 	localpath :: Maybe FilePath,
 	-- a Remote can be known to be readonly