diff --git a/Annex/Difference.hs b/Annex/Difference.hs index be621dc6fc..4d13c7211c 100644 --- a/Annex/Difference.hs +++ b/Annex/Difference.hs @@ -54,5 +54,5 @@ setDifferences = do else return ds ) forM_ (listDifferences ds') $ \d -> - setConfig (ConfigKey $ differenceConfigKey d) (differenceConfigVal d) + setConfig (differenceConfigKey d) (differenceConfigVal d) recordDifferences ds' u diff --git a/Annex/Environment.hs b/Annex/Environment.hs index 0e101d2e76..3da7ce980b 100644 --- a/Annex/Environment.hs +++ b/Annex/Environment.hs @@ -47,6 +47,6 @@ ensureCommit a = either retry return =<< tryNonAsync a where retry _ = do name <- liftIO $ either (const "unknown") id <$> myUserName - setConfig (ConfigKey "user.name") name - setConfig (ConfigKey "user.email") name + setConfig "user.name" name + setConfig "user.email" name a diff --git a/Annex/Fixup.hs b/Annex/Fixup.hs index 4585433c72..547458c08f 100644 --- a/Annex/Fixup.hs +++ b/Annex/Fixup.hs @@ -19,7 +19,6 @@ import Utility.SafeCommand import Utility.Directory import Utility.Exception import Utility.Monad -import Utility.FileSystemEncoding import Utility.PartialPrelude import System.IO @@ -56,7 +55,7 @@ fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) { location = l { worktree = Just (parentDir d) } , gitGlobalOpts = gitGlobalOpts r ++ [ Param "-c" - , Param $ decodeBS' coreBare ++ "=" ++ boolConfig False + , Param $ fromConfigKey coreBare ++ "=" ++ boolConfig False ] } fixupDirect r = r diff --git a/Annex/Init.hs b/Annex/Init.hs index 38847c4e0d..ac6718dde7 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -205,7 +205,7 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do - filesystem. -} whenM (coreSymlinks <$> Annex.getGitConfig) $ do warning "Disabling core.symlinks." - setConfig (ConfigKey "core.symlinks") + setConfig "core.symlinks" (Git.Config.boolConfig False) probeLockSupport :: Annex Bool @@ -275,5 +275,5 @@ initSharedClone True = do - affect it. -} propigateSecureHashesOnly :: Annex () propigateSecureHashesOnly = - maybe noop (setConfig (ConfigKey "annex.securehashesonly")) + maybe noop (setConfig "annex.securehashesonly") =<< getGlobalConfig "annex.securehashesonly" diff --git a/Annex/UUID.hs b/Annex/UUID.hs index 23593a46f7..f3fc4c8acf 100644 --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -14,6 +14,7 @@ {-# LANGUAGE OverloadedStrings #-} module Annex.UUID ( + configkeyUUID, getUUID, getRepoUUID, getUncachedUUID, @@ -34,6 +35,7 @@ import Annex.Common import qualified Annex import qualified Git import qualified Git.Config +import Git.Types import Config import qualified Data.UUID as U @@ -41,8 +43,8 @@ import qualified Data.UUID.V4 as U4 import qualified Data.UUID.V5 as U5 import Data.String -configkey :: ConfigKey -configkey = annexConfig "uuid" +configkeyUUID :: ConfigKey +configkeyUUID = annexConfig "uuid" {- Generates a random UUID, that does not include the MAC address. -} genUUID :: IO UUID @@ -83,20 +85,16 @@ getRepoUUID r = do removeRepoUUID :: Annex () removeRepoUUID = do - unsetConfig configkey + unsetConfig configkeyUUID storeUUID NoUUID getUncachedUUID :: Git.Repo -> UUID -getUncachedUUID = toUUID . Git.Config.get key "" - where - (ConfigKey key) = configkey +getUncachedUUID = toUUID . Git.Config.get configkeyUUID "" -- Does the repo's config have a key for the UUID? -- True even when the key has no value. isUUIDConfigured :: Git.Repo -> Bool -isUUIDConfigured = isJust . Git.Config.getMaybe key - where - (ConfigKey key) = configkey +isUUIDConfigured = isJust . Git.Config.getMaybe configkeyUUID {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex () @@ -106,7 +104,7 @@ prepUUID = whenM ((==) NoUUID <$> getUUID) $ storeUUID :: UUID -> Annex () storeUUID u = do Annex.changeGitConfig $ \c -> c { annexUUID = u } - storeUUIDIn configkey u + storeUUIDIn configkeyUUID u storeUUIDIn :: ConfigKey -> UUID -> Annex () storeUUIDIn configfield = setConfig configfield . fromUUID @@ -114,7 +112,7 @@ storeUUIDIn configfield = setConfig configfield . fromUUID {- Only sets the configkey in the Repo; does not change .git/config -} setUUID :: Git.Repo -> UUID -> IO Git.Repo setUUID r u = do - let s = encodeBS' $ show configkey ++ "=" ++ fromUUID u + let s = encodeBS' $ show configkeyUUID ++ "=" ++ fromUUID u Git.Config.store s r -- Dummy uuid for the whole web. Do not alter. diff --git a/Annex/Version.hs b/Annex/Version.hs index e7cab2a3ac..91295fec92 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -12,6 +12,7 @@ module Annex.Version where import Annex.Common import Config +import Git.Types import Types.RepoVersion import qualified Annex diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 53b89c3489..793f22df47 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -12,6 +12,7 @@ import Annex.UUID import Annex.Init import qualified Annex.Branch import qualified Git.Config +import Git.Types import Remote.GCrypt (coreGCryptId) import qualified CmdLine.GitAnnexShell.Fields as Fields import CmdLine.GitAnnexShell.Checks @@ -28,11 +29,12 @@ seek = withNothing (commandAction start) start :: CommandStart start = do u <- findOrGenUUID - showConfig "annex.uuid" $ fromUUID u - showConfig coreGCryptId =<< fromRepo (Git.Config.get coreGCryptId "") + showConfig configkeyUUID $ fromUUID u + showConfig coreGCryptId . decodeBS' + =<< fromRepo (Git.Config.get coreGCryptId mempty) stop where - showConfig k v = liftIO $ putStrLn $ k ++ "=" ++ v + showConfig k v = liftIO $ putStrLn $ fromConfigKey k ++ "=" ++ v {- The repository may not yet have a UUID; automatically initialize it - when there's a git-annex branch available or if the autoinit field was diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 57832cee92..aa7aa092f7 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -46,7 +46,8 @@ start key = do fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart fieldTransfer direction key a = do liftIO $ debugM "fieldTransfer" "transfer start" - afile <- AssociatedFile <$> Fields.getField Fields.associatedFile + afile <- AssociatedFile . (fmap toRawFilePath) + <$> Fields.getField Fields.associatedFile ok <- maybe (a $ const noop) -- Using noRetry here because we're the sender. (\u -> runner (Transfer direction (toUUID u) (fromKey id key)) afile noRetry a) diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs index 520d79b479..402f1ef8ec 100644 --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -41,7 +41,8 @@ start (k:[]) = do case deserializeKey k of Nothing -> error "bad key" (Just key) -> whenM (inAnnex key) $ do - afile <- AssociatedFile <$> Fields.getField Fields.associatedFile + afile <- AssociatedFile . (fmap toRawFilePath) + <$> Fields.getField Fields.associatedFile u <- maybe (error "missing remoteuuid") toUUID <$> Fields.getField Fields.remoteUUID let t = Transfer diff --git a/Config.hs b/Config.hs index 94a22f720a..e3925c9746 100644 --- a/Config.hs +++ b/Config.hs @@ -27,18 +27,13 @@ import qualified Data.ByteString as S type UnqualifiedConfigKey = S.ByteString -newtype ConfigKey = ConfigKey S.ByteString - -instance Show ConfigKey where - show (ConfigKey s) = decodeBS' s - {- Looks up a setting in git config. This is not as efficient as using the - GitConfig type. -} getConfig :: ConfigKey -> S.ByteString -> Annex S.ByteString -getConfig (ConfigKey key) d = fromRepo $ Git.Config.get key d +getConfig key d = fromRepo $ Git.Config.get key d getConfigMaybe :: ConfigKey -> Annex (Maybe S.ByteString) -getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key +getConfigMaybe key = fromRepo $ Git.Config.getMaybe key {- Changes a git config setting in both internal state and .git/config -} setConfig :: ConfigKey -> String -> Annex () @@ -55,7 +50,7 @@ reloadConfig = Annex.changeGitRepo =<< inRepo Git.Config.reRead {- Unsets a git config setting. (Leaves it in state.) -} unsetConfig :: ConfigKey -> Annex () -unsetConfig (ConfigKey key) = void $ inRepo $ Git.Config.unset key +unsetConfig key = void $ inRepo $ Git.Config.unset key class RemoteNameable r where getRemoteName :: r -> RemoteName diff --git a/Config/Smudge.hs b/Config/Smudge.hs index 08568f57c9..68e39c4b8d 100644 --- a/Config/Smudge.hs +++ b/Config/Smudge.hs @@ -13,6 +13,7 @@ import Annex.Common import qualified Annex import qualified Git import qualified Git.Command +import Git.Types import Config configureSmudgeFilter :: Annex () diff --git a/Git/Config.hs b/Git/Config.hs index 215c7b40c8..8e42314bc1 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -22,15 +22,15 @@ import qualified Git.Construct import Utility.UserInfo {- Returns a single git config setting, or a default value if not set. -} -get :: S.ByteString -> S.ByteString -> Repo -> S.ByteString +get :: ConfigKey -> S.ByteString -> Repo -> S.ByteString get key defaultValue repo = M.findWithDefault defaultValue key (config repo) {- Returns a list with each line of a multiline config setting. -} -getList :: S.ByteString -> Repo -> [S.ByteString] +getList :: ConfigKey -> Repo -> [S.ByteString] getList key repo = M.findWithDefault [] key (fullconfig repo) {- Returns a single git config setting, if set. -} -getMaybe :: S.ByteString -> Repo -> Maybe S.ByteString +getMaybe :: ConfigKey -> Repo -> Maybe S.ByteString getMaybe key repo = M.lookup key (config repo) {- Runs git config and populates a repo with its config. @@ -100,7 +100,7 @@ store s repo = do {- Stores a single config setting in a Repo, returning the new version of - the Repo. Config settings can be updated incrementally. -} -store' :: S.ByteString -> S.ByteString -> Repo -> Repo +store' :: ConfigKey -> S.ByteString -> Repo -> Repo store' k v repo = repo { config = M.singleton k v `M.union` config repo , fullconfig = M.unionWith (++) (M.singleton k [v]) (fullconfig repo) @@ -137,7 +137,7 @@ updateLocation' r l = do {- Parses git config --list or git config --null --list output into a - config map. -} -parse :: S.ByteString -> M.Map S.ByteString [S.ByteString] +parse :: S.ByteString -> M.Map ConfigKey [S.ByteString] parse s | S.null s = M.empty -- --list output will have a '=' in the first line @@ -152,7 +152,7 @@ parse s firstline = S.takeWhile (/= nl) s sep c = M.fromListWith (++) - . map (\(k,v) -> (k, [S.drop 1 v])) + . map (\(k,v) -> (ConfigKey k, [S.drop 1 v])) . map (S.break (== c)) {- Checks if a string from git config is a true value. -} @@ -178,7 +178,7 @@ boolConfig' False = "false" isBare :: Repo -> Bool isBare r = fromMaybe False $ isTrue' =<< getMaybe coreBare r -coreBare :: S.ByteString +coreBare :: ConfigKey coreBare = "core.bare" {- Runs a command to get the configuration of a repo, @@ -205,8 +205,8 @@ fromFile r f = fromPipe r "git" {- Changes a git config setting in the specified config file. - (Creates the file if it does not already exist.) -} -changeFile :: FilePath -> S.ByteString -> S.ByteString -> IO Bool -changeFile f k v = boolSystem "git" +changeFile :: FilePath -> ConfigKey -> S.ByteString -> IO Bool +changeFile f (ConfigKey k) v = boolSystem "git" [ Param "config" , Param "--file" , File f @@ -220,9 +220,9 @@ changeFile f k v = boolSystem "git" - If unsetting the config fails, including in a read-only repo, or - when the config is not set, returns Nothing. -} -unset :: S.ByteString -> Repo -> IO (Maybe Repo) -unset k r = ifM (Git.Command.runBool ps r) - ( return $ Just $ r { config = M.delete k (config r) } +unset :: ConfigKey -> Repo -> IO (Maybe Repo) +unset ck@(ConfigKey k) r = ifM (Git.Command.runBool ps r) + ( return $ Just $ r { config = M.delete ck (config r) } , return Nothing ) where diff --git a/Git/Construct.hs b/Git/Construct.hs index 44ae822e8b..3c907b5840 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -28,7 +28,6 @@ import System.Posix.User #endif import qualified Data.Map as M import Network.URI -import qualified Data.ByteString as S import Common import Git.Types @@ -139,7 +138,7 @@ remoteNamed n constructor = do {- Sets the name of a remote based on the git config key, such as - "remote.foo.url". -} -remoteNamedFromKey :: S.ByteString -> IO Repo -> IO Repo +remoteNamedFromKey :: ConfigKey -> IO Repo -> IO Repo remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName {- Constructs a new Repo for one of a Repo's remotes using a given diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index 94c0b3794a..7b9b46d423 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -100,14 +100,15 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust parse (Just b) = words (decodeBS' b) parse Nothing = [] -remoteParticipantConfigKey :: RemoteName -> S.ByteString +remoteParticipantConfigKey :: RemoteName -> ConfigKey remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants" -remotePublishParticipantConfigKey :: RemoteName -> S.ByteString +remotePublishParticipantConfigKey :: RemoteName -> ConfigKey remotePublishParticipantConfigKey = remoteConfigKey "gcrypt-publish-participants" -remoteSigningKey :: RemoteName -> S.ByteString +remoteSigningKey :: RemoteName -> ConfigKey remoteSigningKey = remoteConfigKey "gcrypt-signingkey" -remoteConfigKey :: S.ByteString -> RemoteName -> S.ByteString -remoteConfigKey key remotename = "remote." <> encodeBS' remotename <> "." <> key +remoteConfigKey :: S.ByteString -> RemoteName -> ConfigKey +remoteConfigKey key remotename = ConfigKey $ + "remote." <> encodeBS' remotename <> "." <> key diff --git a/Git/Remote.hs b/Git/Remote.hs index 7ffaf10fd8..08e67fd624 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -24,12 +24,13 @@ import Git.FilePath #endif {- Is a git config key one that specifies the location of a remote? -} -isRemoteKey :: S.ByteString -> Bool -isRemoteKey k = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k +isRemoteKey :: ConfigKey -> Bool +isRemoteKey (ConfigKey k) = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k {- Get a remote's name from the config key that specifies its location. -} -remoteKeyToRemoteName :: S.ByteString -> RemoteName -remoteKeyToRemoteName = decodeBS' . S.intercalate "." . dropFromEnd 1 . drop 1 . S8.split '.' +remoteKeyToRemoteName :: ConfigKey -> RemoteName +remoteKeyToRemoteName (ConfigKey k) = decodeBS' $ + S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k {- Construct a legal git remote name out of an arbitrary input string. - @@ -83,9 +84,9 @@ parseRemoteLocation s repo = ret $ calcloc s where replacement = decodeBS' $ S.drop (S.length prefix) $ S.take (S.length bestkey - S.length suffix) bestkey - (bestkey, bestvalue) = maximumBy longestvalue insteadofs + (ConfigKey bestkey, bestvalue) = maximumBy longestvalue insteadofs longestvalue (_, a) (_, b) = compare b a - insteadofs = filterconfig $ \(k, v) -> + insteadofs = filterconfig $ \(ConfigKey k, v) -> prefix `S.isPrefixOf` k && suffix `S.isSuffixOf` k && v `S.isPrefixOf` encodeBS l diff --git a/Git/Types.hs b/Git/Types.hs index 961df6eb52..c8688c625c 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -1,6 +1,6 @@ {- git data types - - - Copyright 2010-2018 Joey Hess + - Copyright 2010-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -10,11 +10,12 @@ module Git.Types where import Network.URI +import Data.String import qualified Data.Map as M import qualified Data.ByteString as S import System.Posix.Types import Utility.SafeCommand - +import Utility.FileSystemEncoding {- Support repositories on local disk, and repositories accessed via an URL. - @@ -35,9 +36,9 @@ data RepoLocation data Repo = Repo { location :: RepoLocation - , config :: M.Map S.ByteString S.ByteString + , config :: M.Map ConfigKey S.ByteString -- a given git config key can actually have multiple values - , fullconfig :: M.Map S.ByteString [S.ByteString] + , fullconfig :: M.Map ConfigKey [S.ByteString] -- remoteName holds the name used for this repo in some other -- repo's list of remotes, when this repo is such a remote , remoteName :: Maybe RemoteName @@ -48,6 +49,18 @@ data Repo = Repo , gitGlobalOpts :: [CommandParam] } deriving (Show, Eq, Ord) +newtype ConfigKey = ConfigKey S.ByteString + deriving (Ord, Eq) + +fromConfigKey :: ConfigKey -> String +fromConfigKey (ConfigKey s) = decodeBS' s + +instance Show ConfigKey where + show = fromConfigKey + +instance IsString ConfigKey where + fromString = ConfigKey . encodeBS' + type RemoteName = String {- A git ref. Can be a sha1, or a branch or tag name. -} diff --git a/Remote.hs b/Remote.hs index 363876c29e..771e9b67ba 100644 --- a/Remote.hs +++ b/Remote.hs @@ -74,7 +74,7 @@ import Logs.Web import Remote.List import Config import Config.DynamicConfig -import Git.Types (RemoteName) +import Git.Types (RemoteName, ConfigKey(..)) import Utility.Aeson {- Map from UUIDs of Remotes to a calculated value. -} diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 931adce3b4..7fe83a0a5a 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -30,6 +30,7 @@ import Types.GitConfig import Types.Crypto import Types.Creds import Types.Transfer +import Git.Types (ConfigKey(..), fromConfigKey) import qualified Git import qualified Git.Command import qualified Git.Config @@ -99,7 +100,7 @@ gen baser u c gc rs = do (Just remotename, Just c') -> do setGcryptEncryption c' remotename storeUUIDIn (remoteConfig baser "uuid") u' - setConfig (ConfigKey $ Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid + setConfig (Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid gen' r u' c' gc rs _ -> do warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r @@ -256,7 +257,7 @@ setupRepo gcryptid r | otherwise = localsetup r where localsetup r' = do - let setconfig k v = liftIO $ Git.Command.run [Param "config", Param (decodeBS' k), Param v] r' + let setconfig k v = liftIO $ Git.Command.run [Param "config", Param (fromConfigKey k), Param v] r' setconfig coreGCryptId gcryptid setconfig denyNonFastForwards (Git.Config.boolConfig False) return AccessDirect @@ -293,7 +294,7 @@ setupRepo gcryptid r (\f p -> liftIO (boolSystem f p), return False) "gcryptsetup" [ Param gcryptid ] [] - denyNonFastForwards = "receive.denyNonFastForwards" + denyNonFastForwards = ConfigKey "receive.denyNonFastForwards" accessShell :: Remote -> Bool accessShell = accessShellConfig . gitconfig @@ -330,7 +331,7 @@ setGcryptEncryption c remotename = do Nothing -> noop Just (KeyIds { keyIds = ks}) -> do setConfig participants (unwords ks) - let signingkey = ConfigKey $ Git.GCrypt.remoteSigningKey remotename + let signingkey = Git.GCrypt.remoteSigningKey remotename cmd <- gpgCmd <$> Annex.getGitConfig skeys <- M.keys <$> liftIO (secretKeys cmd) case filter (`elem` ks) skeys of @@ -339,7 +340,7 @@ setGcryptEncryption c remotename = do setConfig (remoteconfig Git.GCrypt.remotePublishParticipantConfigKey) (Git.Config.boolConfig True) where - remoteconfig n = ConfigKey $ n remotename + remoteconfig n = n remotename store :: Remote -> Remote.Rsync.RsyncOpts -> Storer store r rsyncopts k s p = do @@ -439,7 +440,7 @@ getGCryptUUID fast r = do (genUUIDInNameSpace gCryptNameSpace <$>) . fst <$> getGCryptId fast r dummycfg -coreGCryptId :: S.ByteString +coreGCryptId :: ConfigKey coreGCryptId = "core.gcrypt-id" {- gcrypt repos set up by git-annex as special remotes have a diff --git a/Remote/Git.hs b/Remote/Git.hs index a04e07cfdd..f4f2ddfcb1 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -88,7 +88,7 @@ list autoinit = do rs <- mapM (tweakurl c) =<< Annex.getGitRemotes mapM (configRead autoinit) rs where - annexurl n = "remote." <> encodeBS' n <> ".annexurl" + annexurl n = Git.ConfigKey ("remote." <> encodeBS' n <> ".annexurl") tweakurl c r = do let n = fromJust $ Git.remoteName r case M.lookup (annexurl n) c of diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index 73609026ab..624f90c3e7 100644 --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -155,7 +155,7 @@ mySetup _ mu _ c gc = do -- (so it's also usable by git as a non-special remote), -- and set remote.name.annex-git-lfs = true gitConfigSpecialRemote u c' [("git-lfs", "true")] - setConfig (ConfigKey ("remote." <> encodeBS' (getRemoteName c) <> ".url")) url + setConfig (Git.ConfigKey ("remote." <> encodeBS' (getRemoteName c) <> ".url")) url return (c', u) where url = fromMaybe (giveup "Specify url=") (M.lookup "url" c) @@ -187,8 +187,8 @@ configKnownUrl r set "config-uuid" (fromUUID cu) r' Nothing -> return r' set k v r' = do - let ck@(ConfigKey k') = remoteConfig r' k - setConfig ck v + let k' = remoteConfig r' k + setConfig k' v return $ Git.Config.store' k' (encodeBS' v) r' data LFSHandle = LFSHandle diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 7f16ec579d..40934c6f08 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -53,6 +53,7 @@ import Annex.Content import Messages.Progress import qualified Git import qualified Git.Construct +import Git.Types import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L @@ -70,7 +71,9 @@ findSpecialRemotes s = do remotepairs = M.toList . M.filterWithKey match construct (k,_) = Git.Construct.remoteNamedFromKey k (pure Git.Construct.fromUnknown) - match k _ = "remote." `S.isPrefixOf` k && (".annex-" <> encodeBS' s) `S.isSuffixOf` k + match (ConfigKey k) _ = + "remote." `S.isPrefixOf` k + && (".annex-" <> encodeBS' s) `S.isSuffixOf` k {- Sets up configuration for a special remote in .git/config. -} gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex () diff --git a/Test/Framework.hs b/Test/Framework.hs index 187b54ef0e..b02bcc384c 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -23,6 +23,7 @@ import qualified Types.RepoVersion import qualified Backend import qualified Git.CurrentRepo import qualified Git.Construct +import qualified Git.Types import qualified Types.KeySource import qualified Types.Backend import qualified Types @@ -89,7 +90,7 @@ inmainrepo a = do with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion) with_ssh_origin cloner a = cloner $ do origindir <- absPath . decodeBS' - =<< annexeval (Config.getConfig (Config.ConfigKey (encodeBS' config)) (toRawFilePath "/dev/null")) + =<< annexeval (Config.getConfig (Git.Types.ConfigKey (encodeBS' config)) (toRawFilePath "/dev/null")) let originurl = "localhost:" ++ origindir boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed" a diff --git a/Types/Difference.hs b/Types/Difference.hs index 678b6f4bf6..a974e332a5 100644 --- a/Types/Difference.hs +++ b/Types/Difference.hs @@ -22,6 +22,7 @@ module Types.Difference ( import Utility.PartialPrelude import qualified Git import qualified Git.Config +import Git.Types import Data.Maybe import Data.Monoid @@ -99,7 +100,7 @@ getDifferences r = mkDifferences $ S.fromList $ Just True -> Just d _ -> Nothing -differenceConfigKey :: Difference -> B.ByteString +differenceConfigKey :: Difference -> ConfigKey differenceConfigKey ObjectHashLower = tunable "objecthashlower" differenceConfigKey OneLevelObjectHash = tunable "objecthash1" differenceConfigKey OneLevelBranchHash = tunable "branchhash1" @@ -107,8 +108,8 @@ differenceConfigKey OneLevelBranchHash = tunable "branchhash1" differenceConfigVal :: Difference -> String differenceConfigVal _ = Git.Config.boolConfig True -tunable :: B.ByteString -> B.ByteString -tunable k = "annex.tune." <> k +tunable :: B.ByteString -> ConfigKey +tunable k = ConfigKey ("annex.tune." <> k) hasDifference :: Difference -> Differences -> Bool hasDifference _ UnknownDifferences = False diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index ad058171af..73dd70cfcc 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -211,7 +211,7 @@ extractGitConfig r = GitConfig configurable d Nothing = DefaultConfig d configurable _ (Just v) = HasConfig v - annex k = "annex." <> k + annex k = ConfigKey $ "annex." <> k onemegabyte = 1000000 @@ -350,8 +350,9 @@ extractRemoteGitConfig r remotename = do (Git.Config.getMaybe (remotekey k) r) getoptions k = fromMaybe [] $ words <$> getmaybe k - key k = "annex." <> k - remotekey k = "remote." <> encodeBS' remotename <> ".annex-" <> k + key k = ConfigKey $ "annex." <> k + remotekey k = ConfigKey $ + "remote." <> encodeBS' remotename <> ".annex-" <> k notempty :: Maybe String -> Maybe String notempty Nothing = Nothing diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index c238101ff3..2e6ca9b0b4 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -46,7 +46,7 @@ setIndirect = do -- unset it when enabling direct mode, caching in -- core.indirect-worktree moveconfig indirectworktree coreworktree - setConfig (ConfigKey Git.Config.coreBare) val + setConfig Git.Config.coreBare val moveconfig src dest = getConfigMaybe src >>= \case Nothing -> noop Just wt -> do diff --git a/git-annex.hs b/git-annex.hs index 30c12995a1..4992f4c76e 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -12,7 +12,7 @@ import System.FilePath import Network.Socket (withSocketsDo) import qualified CmdLine.GitAnnex ---import qualified CmdLine.GitAnnexShell +import qualified CmdLine.GitAnnexShell import qualified CmdLine.GitRemoteTorAnnex import qualified Test import qualified Benchmark @@ -33,7 +33,7 @@ main = withSocketsDo $ do run ps =<< getProgName where run ps n = case takeFileName n of - "git-annex-shell" -> error "STUBBED OUT FIXME" -- CmdLine.GitAnnexShell.run ps + "git-annex-shell" -> CmdLine.GitAnnexShell.run ps "git-remote-tor-annex" -> CmdLine.GitRemoteTorAnnex.run ps _ -> CmdLine.GitAnnex.run Test.optParser Test.runner Benchmark.mkGenerator ps