diff --git a/Annex/Init.hs b/Annex/Init.hs index c034bfac0c..3accd18ff3 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -23,6 +23,7 @@ import qualified Annex import qualified Git import qualified Git.Config import qualified Git.Objects +import Git.Types (fromConfigValue) import qualified Annex.Branch import Logs.UUID import Logs.Trust.Basic @@ -275,5 +276,5 @@ initSharedClone True = do - affect it. -} propigateSecureHashesOnly :: Annex () propigateSecureHashesOnly = - maybe noop (setConfig "annex.securehashesonly" . decodeBS') + maybe noop (setConfig "annex.securehashesonly" . fromConfigValue) =<< getGlobalConfig "annex.securehashesonly" diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index daef02d85f..9fc0d272ae 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -65,15 +65,10 @@ import qualified Command.AddUnused import qualified Command.Unlock import qualified Command.Lock import qualified Command.PreCommit -{- import qualified Command.PostReceive --} import qualified Command.Find -{- import qualified Command.FindRef --} import qualified Command.Whereis -{- import qualified Command.List import qualified Command.Log import qualified Command.Merge @@ -97,17 +92,13 @@ import qualified Command.Schedule import qualified Command.Ungroup import qualified Command.Config import qualified Command.Vicfg --} import qualified Command.Sync -{- import qualified Command.Mirror import qualified Command.AddUrl import qualified Command.ImportFeed import qualified Command.RmUrl --} import qualified Command.Import import qualified Command.Export -{- import qualified Command.Map import qualified Command.Direct import qualified Command.Indirect @@ -116,9 +107,7 @@ import qualified Command.Forget import qualified Command.P2P import qualified Command.Proxy import qualified Command.DiffDriver --} import qualified Command.Smudge -{- import qualified Command.Undo import qualified Command.Version import qualified Command.RemoteDaemon @@ -132,7 +121,6 @@ import qualified Command.WebApp import qualified Command.Test import qualified Command.FuzzTest import qualified Command.TestRemote --} import qualified Command.Benchmark cmds :: Parser TestOptions -> TestRunner -> MkBenchmarkGenerator -> [Command] @@ -148,12 +136,10 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.Unlock.editcmd , Command.Lock.cmd , Command.Sync.cmd -{- , Command.Mirror.cmd , Command.AddUrl.cmd , Command.ImportFeed.cmd , Command.RmUrl.cmd --} , Command.Import.cmd , Command.Export.cmd , Command.Init.cmd @@ -165,12 +151,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.Multicast.cmd , Command.Reinject.cmd , Command.Unannex.cmd -{- , Command.Uninit.cmd , Command.Reinit.cmd --} , Command.PreCommit.cmd -{- , Command.PostReceive.cmd , Command.NumCopies.cmd , Command.Trust.cmd @@ -185,7 +168,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.Ungroup.cmd , Command.Config.cmd , Command.Vicfg.cmd --} , Command.LookupKey.cmd , Command.CalcKey.cmd , Command.ContentLocation.cmd @@ -215,11 +197,8 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.DropUnused.cmd , Command.AddUnused.cmd , Command.Find.cmd -{- , Command.FindRef.cmd --} , Command.Whereis.cmd -{- , Command.List.cmd , Command.Log.cmd , Command.Merge.cmd @@ -236,9 +215,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.P2P.cmd , Command.Proxy.cmd , Command.DiffDriver.cmd --} , Command.Smudge.cmd -{- , Command.Undo.cmd , Command.Version.cmd , Command.RemoteDaemon.cmd @@ -252,7 +229,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.Test.cmd testoptparser testrunner , Command.FuzzTest.cmd , Command.TestRemote.cmd --} , Command.Benchmark.cmd $ mkbenchmarkgenerator $ cmds testoptparser testrunner (\_ _ -> return noop) ] diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index a968aae9d5..1d814037e5 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -156,7 +156,7 @@ startRemote r o file uri sz = do performRemote r o uri file' sz performRemote :: Remote -> AddUrlOptions -> URLString -> FilePath -> Maybe Integer -> CommandPerform -performRemote r o uri file sz = ifAnnexed file adduri geturi +performRemote r o uri file sz = ifAnnexed (toRawFilePath file) adduri geturi where loguri = setDownloader uri OtherDownloader adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize @@ -180,7 +180,7 @@ downloadRemoteFile r o uri file sz = checkCanAdd file $ do setTempUrl urlkey loguri let downloader = \dest p -> fst <$> Remote.retrieveKeyFile r urlkey - (AssociatedFile (Just file)) dest p + (AssociatedFile (Just (toRawFilePath file))) dest p ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file removeTempUrl urlkey return ret @@ -212,7 +212,7 @@ startWeb o urlstring = go $ fromMaybe bad $ parseURI urlstring performWeb o urlstring file urlinfo performWeb :: AddUrlOptions -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform -performWeb o url file urlinfo = ifAnnexed file addurl geturl +performWeb o url file urlinfo = ifAnnexed (toRawFilePath file) addurl geturl where geturl = next $ isJust <$> addUrlFile (downloadOptions o) url urlinfo file addurl = addUrlChecked o url file webUUID $ \k -> @@ -258,7 +258,7 @@ addUrlFile o url urlinfo file = downloadWeb :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) downloadWeb o url urlinfo file = - go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file)) + go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just (toRawFilePath file))) where urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing downloader f p = downloadUrl urlkey p [url] f @@ -278,7 +278,7 @@ downloadWeb o url urlinfo file = -- first, and check if that is already an annexed file, -- to avoid unnecessary work in that case. | otherwise = youtubeDlFileNameHtmlOnly url >>= \case - Right dest -> ifAnnexed dest + Right dest -> ifAnnexed (toRawFilePath dest) (alreadyannexed dest) (dl dest) Left _ -> normalfinish tmp @@ -345,7 +345,7 @@ downloadWith :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLStr downloadWith downloader dummykey u url file = go =<< downloadWith' downloader dummykey u url afile where - afile = AssociatedFile (Just file) + afile = AssociatedFile (Just (toRawFilePath file)) go Nothing = return Nothing go (Just tmp) = finishDownloadWith tmp u url file @@ -401,7 +401,7 @@ addWorkTree u url file key mtmp = case mtmp of -- than the work tree file. liftIO $ renameFile file tmp go - else void $ Command.Add.addSmall file + else void $ Command.Add.addSmall (toRawFilePath file) where go = do maybeShowJSON $ JSONChunk [("key", serializeKey key)] diff --git a/Command/Config.hs b/Command/Config.hs index 15ab85daeb..6764ca5e92 100644 --- a/Command/Config.hs +++ b/Command/Config.hs @@ -10,6 +10,9 @@ module Command.Config where import Command import Logs.Config import Config +import Git.Types (ConfigKey(..), fromConfigValue) + +import qualified Data.ByteString as S cmd :: Command cmd = noMessages $ command "config" SectionSetup @@ -17,9 +20,9 @@ cmd = noMessages $ command "config" SectionSetup paramNothing (seek <$$> optParser) data Action - = SetConfig ConfigName ConfigValue - | GetConfig ConfigName - | UnsetConfig ConfigName + = SetConfig ConfigKey ConfigValue + | GetConfig ConfigKey + | UnsetConfig ConfigKey type Name = String type Value = String @@ -48,19 +51,19 @@ optParser _ = setconfig <|> getconfig <|> unsetconfig ) seek :: Action -> CommandSeek -seek (SetConfig name val) = commandAction $ - startingUsualMessages name (ActionItemOther (Just val)) $ do - setGlobalConfig name val - setConfig (ConfigKey name) val +seek (SetConfig ck@(ConfigKey name) val) = commandAction $ + startingUsualMessages (decodeBS' name) (ActionItemOther (Just (fromConfigValue val))) $ do + setGlobalConfig ck val + setConfig ck (fromConfigValue val) next $ return True -seek (UnsetConfig name) = commandAction $ - startingUsualMessages name (ActionItemOther (Just "unset")) $do - unsetGlobalConfig name - unsetConfig (ConfigKey name) +seek (UnsetConfig ck@(ConfigKey name)) = commandAction $ + startingUsualMessages (decodeBS' name) (ActionItemOther (Just "unset")) $do + unsetGlobalConfig ck + unsetConfig ck next $ return True -seek (GetConfig name) = commandAction $ +seek (GetConfig ck) = commandAction $ startingCustomOutput (ActionItemOther Nothing) $ do - getGlobalConfig name >>= \case + getGlobalConfig ck >>= \case Nothing -> return () - Just v -> liftIO $ putStrLn v + Just (ConfigValue v) -> liftIO $ S.putStrLn v next $ return True diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 793f22df47..bb33f7102b 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -30,7 +30,7 @@ start :: CommandStart start = do u <- findOrGenUUID showConfig configkeyUUID $ fromUUID u - showConfig coreGCryptId . decodeBS' + showConfig coreGCryptId . fromConfigValue =<< fromRepo (Git.Config.get coreGCryptId mempty) stop where diff --git a/Command/DiffDriver.hs b/Command/DiffDriver.hs index f4251c0929..ecc05ca093 100644 --- a/Command/DiffDriver.hs +++ b/Command/DiffDriver.hs @@ -85,9 +85,9 @@ fixupReq req@(Req {}) = check rOldFile rOldMode (\r f -> r { rOldFile = f }) req >>= check rNewFile rNewMode (\r f -> r { rNewFile = f }) where - check getfile getmode setfile r = case readTreeItemType (getmode r) of + check getfile getmode setfile r = case readTreeItemType (encodeBS' (getmode r)) of Just TreeSymlink -> do - v <- getAnnexLinkTarget' (getfile r) False + v <- getAnnexLinkTarget' (toRawFilePath (getfile r)) False case parseLinkTargetOrPointer =<< v of Nothing -> return r Just k -> withObjectLoc k (pure . setfile r) diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index 5e0812516e..ba232f3167 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.FuzzTest where import Command @@ -13,6 +15,7 @@ import qualified Git.Config import Config import Utility.ThreadScheduler import Utility.DiskFree +import Git.Types (fromConfigKey) import Data.Time.Clock import System.Random (getStdRandom, random, randomR) @@ -32,25 +35,23 @@ start :: CommandStart start = do guardTest logf <- fromRepo gitAnnexFuzzTestLogFile - showStart "fuzztest" logf + showStart "fuzztest" (toRawFilePath logf) logh <- liftIO $ openFile logf WriteMode void $ forever $ fuzz logh stop guardTest :: Annex () -guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $ +guardTest = unlessM (fromMaybe False . Git.Config.isTrue' <$> getConfig key mempty) $ giveup $ unlines [ "Running fuzz tests *writes* to and *deletes* files in" , "this repository, and pushes those changes to other" , "repositories! This is a developer tool, not something" , "to play with." , "" - , "Refusing to run fuzz tests, since " ++ keyname ++ " is not set!" + , "Refusing to run fuzz tests, since " ++ fromConfigKey key ++ " is not set!" ] where key = annexConfig "eat-my-repository" - (ConfigKey keyname) = key - fuzz :: Handle -> Annex () fuzz logh = do diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 2eca658649..dc4fb8749c 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -67,7 +67,7 @@ seek o = do getFeed :: ImportFeedOptions -> Cache -> URLString -> CommandSeek getFeed opts cache url = do - showStart "importfeed" url + showStart' "importfeed" (Just url) downloadFeed url >>= \case Nothing -> showEndResult =<< feedProblem url "downloading the feed failed" @@ -222,7 +222,7 @@ performDownload opts cache todownload = case location todownload of case dest of Nothing -> return True Just f -> do - showStart "addurl" url + showStart' "addurl" (Just url) ks <- getter f if null ks then do @@ -244,7 +244,7 @@ performDownload opts cache todownload = case location todownload of - to be re-downloaded. -} makeunique url n file = ifM alreadyexists ( ifM forced - ( ifAnnexed f checksameurl tryanother + ( ifAnnexed (toRawFilePath f) checksameurl tryanother , tryanother ) , return $ Just f diff --git a/Command/Info.hs b/Command/Info.hs index 0c429dee72..a0099ca06d 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -152,7 +152,7 @@ itemInfo o p = ifM (isdir p) v' <- Remote.nameToUUID' p case v' of Right u -> uuidInfo o u - Left _ -> ifAnnexed p + Left _ -> ifAnnexed (toRawFilePath p) (fileInfo o p) (treeishInfo o p) ) @@ -161,7 +161,7 @@ itemInfo o p = ifM (isdir p) noInfo :: String -> Annex () noInfo s = do - showStart "info" s + showStart "info" (encodeBS' s) showNote $ "not a directory or an annexed file or a treeish or a remote or a uuid" showEndFail @@ -311,8 +311,8 @@ showStat :: Stat -> StatState () showStat s = maybe noop calc =<< s where calc (desc, a) = do - (lift . showHeader) desc - lift . showRaw =<< a + (lift . showHeader . encodeBS') desc + lift . showRaw . encodeBS' =<< a repo_list :: TrustLevel -> Stat repo_list level = stat n $ nojson $ lift $ do @@ -435,7 +435,7 @@ transfer_list = stat desc $ nojson $ lift $ do desc = "transfers in progress" line uuidmap t i = unwords [ formatDirection (transferDirection t) ++ "ing" - , actionItemDesc $ mkActionItem + , fromRawFilePath $ actionItemDesc $ mkActionItem (transferKey t, associatedFile i) , if transferDirection t == Upload then "to" else "from" , maybe (fromUUID $ transferUUID t) Remote.name $ @@ -444,7 +444,7 @@ transfer_list = stat desc $ nojson $ lift $ do jsonify t i = object $ map (\(k, v) -> (packString k, v)) $ [ ("transfer", toJSON' (formatDirection (transferDirection t))) , ("key", toJSON' (transferKey t)) - , ("file", toJSON' afile) + , ("file", toJSON' (fromRawFilePath <$> afile)) , ("remote", toJSON' (fromUUID (transferUUID t) :: String)) ] where @@ -566,7 +566,7 @@ getDirStatInfo o dir = do where initial = (emptyKeyInfo, emptyKeyInfo, emptyNumCopiesStats, M.empty) update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) = - ifM (matcher $ MatchingFile $ FileInfo file file) + ifM (matcher $ MatchingFile $ FileInfo file' file') ( do !presentdata' <- ifM (inAnnex key) ( return $ addKey key presentdata @@ -577,11 +577,13 @@ getDirStatInfo o dir = do then return (numcopiesstats, repodata) else do locs <- Remote.keyLocations key - nc <- updateNumCopiesStats file numcopiesstats locs + nc <- updateNumCopiesStats file' numcopiesstats locs return (nc, updateRepoData key locs repodata) return $! (presentdata', referenceddata', numcopiesstats', repodata') , return vs ) + where + file' = fromRawFilePath file getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo) getTreeStatInfo o r = do diff --git a/Command/Inprogress.hs b/Command/Inprogress.hs index e571fa8d3b..45d68da745 100644 --- a/Command/Inprogress.hs +++ b/Command/Inprogress.hs @@ -42,7 +42,7 @@ seek o = do (commandAction . (whenAnnexed (start s))) =<< workTreeItems (inprogressFiles o) -start :: S.Set Key -> FilePath -> Key -> CommandStart +start :: S.Set Key -> RawFilePath -> Key -> CommandStart start s _file k | S.member k s = start' k | otherwise = stop diff --git a/Command/List.hs b/Command/List.hs index ae9e6a70f1..7b41a304ec 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -72,7 +72,7 @@ getList o printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex () printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l -start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart +start :: [(UUID, RemoteName, TrustLevel)] -> RawFilePath -> Key -> CommandStart start l file key = do ls <- S.fromList <$> keyLocations key liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file @@ -88,8 +88,8 @@ lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length trust UnTrusted = " (untrusted)" trust _ = "" -format :: [(TrustLevel, Present)] -> FilePath -> String -format remotes file = thereMap ++ " " ++ file +format :: [(TrustLevel, Present)] -> RawFilePath -> String +format remotes file = thereMap ++ " " ++ fromRawFilePath file where thereMap = concatMap there remotes there (UnTrusted, True) = "x" diff --git a/Command/Log.hs b/Command/Log.hs index 554afa947a..19ededcc02 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -92,10 +92,10 @@ seek o = do ([], True) -> commandAction (startAll o outputter) (_, True) -> giveup "Cannot specify both files and --all" -start :: LogOptions -> (FilePath -> Outputter) -> FilePath -> Key -> CommandStart +start :: LogOptions -> (FilePath -> Outputter) -> RawFilePath -> Key -> CommandStart start o outputter file key = do (changes, cleanup) <- getKeyLog key (passthruOptions o) - showLogIncremental (outputter file) changes + showLogIncremental (outputter (fromRawFilePath file)) changes void $ liftIO cleanup stop @@ -201,7 +201,7 @@ getKeyLog key os = do top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top config <- Annex.getGitConfig - let logfile = p locationLogFile config key + let logfile = p fromRawFilePath (locationLogFile config key) getGitLog [logfile] (Param "--remove-empty" : os) {- Streams the git log for all git-annex branch changes. -} @@ -220,7 +220,7 @@ getGitLog fs os = do [ Param $ Git.fromRef Annex.Branch.fullname , Param "--" ] ++ map Param fs - return (parseGitRawLog ls, cleanup) + return (parseGitRawLog (map decodeBL' ls), cleanup) -- Parses chunked git log --raw output, which looks something like: -- @@ -250,7 +250,7 @@ parseGitRawLog = parse epoch (tss, cl') -> (parseTimeStamp tss, cl') mrc = do (old, new) <- parseRawChangeLine cl - key <- locationLogFileKey c2 + key <- locationLogFileKey (toRawFilePath c2) return $ RefChange { changetime = ts , oldref = old diff --git a/Command/Migrate.hs b/Command/Migrate.hs index ca65cbef1e..0f964bb749 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -28,16 +28,16 @@ cmd = withGlobalOptions [annexedMatchingOptions] $ seek :: CmdParams -> CommandSeek seek = withFilesInGit (commandAction . (whenAnnexed start)) <=< workTreeItems -start :: FilePath -> Key -> CommandStart +start :: RawFilePath -> Key -> CommandStart start file key = do forced <- Annex.getState Annex.force - v <- Backend.getBackend file key + v <- Backend.getBackend (fromRawFilePath file) key case v of Nothing -> stop Just oldbackend -> do exists <- inAnnex key newbackend <- maybe defaultBackend return - =<< chooseBackend file + =<< chooseBackend (fromRawFilePath file) if (newbackend /= oldbackend || upgradableKey oldbackend key || forced) && exists then starting "migrate" (mkActionItem (key, file)) $ perform file key oldbackend newbackend @@ -63,7 +63,7 @@ upgradableKey backend key = isNothing (fromKey keySize key) || backendupgradable - data cannot get corrupted after the fsck but before the new key is - generated. -} -perform :: FilePath -> Key -> Backend -> Backend -> CommandPerform +perform :: RawFilePath -> Key -> Backend -> Backend -> CommandPerform perform file oldkey oldbackend newbackend = go =<< genkey (fastMigrate oldbackend) where go Nothing = stop @@ -85,7 +85,7 @@ perform file oldkey oldbackend newbackend = go =<< genkey (fastMigrate oldbacken genkey Nothing = do content <- calcRepo $ gitAnnexLocation oldkey let source = KeySource - { keyFilename = file + { keyFilename = fromRawFilePath file , contentLocation = content , inodeCache = Nothing } diff --git a/Command/Mirror.hs b/Command/Mirror.hs index be7b7c5920..ecfff8fdba 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -47,7 +47,7 @@ seek o = startConcurrency transferStages $ (withFilesInGit (commandAction . (whenAnnexed $ start o))) =<< workTreeItems (mirrorFiles o) -start :: MirrorOptions -> FilePath -> Key -> CommandStart +start :: MirrorOptions -> RawFilePath -> Key -> CommandStart start o file k = startKey o afile (k, ai) where afile = AssociatedFile (Just file) @@ -75,4 +75,4 @@ startKey o afile (key, ai) = case fromToOptions o of where getnumcopies = case afile of AssociatedFile Nothing -> getNumCopies - AssociatedFile (Just af) -> getFileNumCopies af + AssociatedFile (Just af) -> getFileNumCopies (fromRawFilePath af) diff --git a/Command/P2P.hs b/Command/P2P.hs index ae86f59076..e1896c7a3f 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.P2P where import Command diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index 3d8d8ca2df..04c3165ce5 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -42,9 +42,11 @@ batchParser s = case separate (== ' ') (reverse s) of | otherwise -> Right (reverse rf, reverse ru) start :: (FilePath, URLString) -> CommandStart -start (file, url) = flip whenAnnexed file $ \_ key -> - starting "rmurl" (mkActionItem (key, AssociatedFile (Just file))) $ +start (file, url) = flip whenAnnexed file' $ \_ key -> + starting "rmurl" (mkActionItem (key, AssociatedFile (Just file'))) $ next $ cleanup url key + where + file' = toRawFilePath file cleanup :: String -> Key -> CommandCleanup cleanup url key = do diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index eef6ccaea1..292697a781 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -236,7 +236,7 @@ testExportTree st (Just _) ea k1 k2 = ] where testexportdirectory = "testremote-export" - testexportlocation = mkExportLocation (testexportdirectory "location") + testexportlocation = mkExportLocation (toRawFilePath (testexportdirectory "location")) check desc a = testCase desc $ Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed" storeexport k = do @@ -252,7 +252,7 @@ testExportTree st (Just _) ea k1 k2 = removeexport k = Remote.removeExport ea k testexportlocation removeexportdirectory = case Remote.removeExportDirectory ea of Nothing -> return True - Just a -> a (mkExportDirectory testexportdirectory) + Just a -> a (mkExportDirectory (toRawFilePath testexportdirectory)) testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree] testUnavailable st r k = @@ -326,7 +326,7 @@ randKey sz = withTmpFile "randkey" $ \f h -> do return k getReadonlyKey :: Remote -> FilePath -> Annex Key -getReadonlyKey r f = lookupFile f >>= \case +getReadonlyKey r f = lookupFile (toRawFilePath f) >>= \case Nothing -> giveup $ f ++ " is not an annexed file" Just k -> do unlessM (inAnnex k) $ diff --git a/Command/Undo.hs b/Command/Undo.hs index 8a1939394e..fd4b3b263d 100644 --- a/Command/Undo.hs +++ b/Command/Undo.hs @@ -27,9 +27,9 @@ seek :: CmdParams -> CommandSeek seek ps = do -- Safety first; avoid any undo that would touch files that are not -- in the index. - (fs, cleanup) <- inRepo $ LsFiles.notInRepo False ps + (fs, cleanup) <- inRepo $ LsFiles.notInRepo False (map toRawFilePath ps) unless (null fs) $ - giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs + giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords (map fromRawFilePath fs) void $ liftIO $ cleanup -- Committing staged changes before undo allows later diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 4e842f4ea7..70bccac542 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -31,6 +31,7 @@ import Types.StandardGroups import Types.ScheduledActivity import Types.NumCopies import Remote +import Git.Types (ConfigKey(..), fromConfigKey, fromConfigValue) cmd :: Command cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch" @@ -70,7 +71,7 @@ data Cfg = Cfg , cfgRequiredContentMap :: M.Map UUID PreferredContentExpression , cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression , cfgScheduleMap :: M.Map UUID [ScheduledActivity] - , cfgGlobalConfigs :: M.Map ConfigName ConfigValue + , cfgGlobalConfigs :: M.Map ConfigKey ConfigValue , cfgNumCopies :: Maybe NumCopies } @@ -218,9 +219,9 @@ genCfg cfg descs = unlines $ intercalate [""] [ com "Other global configuration" ] (\(s, g) -> gline g s) - (\g -> gline g "") + (\g -> gline g mempty) where - gline g val = [ unwords ["config", g, "=", val] ] + gline k v = [ unwords ["config", fromConfigKey k, "=", fromConfigValue v] ] line setting u val = [ com $ "(for " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs)) ++ ")" @@ -308,7 +309,7 @@ parseCfg defcfg = go [] defcfg . lines let m = M.insert u l (cfgScheduleMap cfg) in Right $ cfg { cfgScheduleMap = m } | setting == "config" = - let m = M.insert f val (cfgGlobalConfigs cfg) + let m = M.insert (ConfigKey (encodeBS' f)) (ConfigValue (encodeBS' val)) (cfgGlobalConfigs cfg) in Right $ cfg { cfgGlobalConfigs = m } | setting == "numcopies" = case readish val of Nothing -> Left "parse error (expected an integer)" diff --git a/Config.hs b/Config.hs index e3925c9746..68c657aa47 100644 --- a/Config.hs +++ b/Config.hs @@ -29,10 +29,10 @@ type UnqualifiedConfigKey = S.ByteString {- 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 -> ConfigValue -> Annex ConfigValue getConfig key d = fromRepo $ Git.Config.get key d -getConfigMaybe :: ConfigKey -> Annex (Maybe S.ByteString) +getConfigMaybe :: ConfigKey -> Annex (Maybe ConfigValue) getConfigMaybe key = fromRepo $ Git.Config.getMaybe key {- Changes a git config setting in both internal state and .git/config -} diff --git a/Git/AutoCorrect.hs b/Git/AutoCorrect.hs index ac45a4b367..06823a182f 100644 --- a/Git/AutoCorrect.hs +++ b/Git/AutoCorrect.hs @@ -46,7 +46,7 @@ fuzzymatches input showchoice choices = fst $ unzip $ -} prepare :: String -> (c -> String) -> [c] -> Maybe Repo -> IO () prepare input showmatch matches r = - case readish . decodeBS' . Git.Config.get "help.autocorrect" "0" =<< r of + case readish . fromConfigValue . Git.Config.get "help.autocorrect" "0" =<< r of Just n | n == 0 -> list | n < 0 -> warn Nothing diff --git a/Git/Config.hs b/Git/Config.hs index 8e42314bc1..5276e46835 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -21,16 +21,16 @@ import qualified Git.Command import qualified Git.Construct import Utility.UserInfo -{- Returns a single git config setting, or a default value if not set. -} -get :: ConfigKey -> S.ByteString -> Repo -> S.ByteString -get key defaultValue repo = M.findWithDefault defaultValue key (config repo) +{- Returns a single git config setting, or a fallback value if not set. -} +get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue +get key fallback repo = M.findWithDefault fallback key (config repo) -{- Returns a list with each line of a multiline config setting. -} -getList :: ConfigKey -> Repo -> [S.ByteString] +{- Returns a list of values. -} +getList :: ConfigKey -> Repo -> [ConfigValue] getList key repo = M.findWithDefault [] key (fullconfig repo) {- Returns a single git config setting, if set. -} -getMaybe :: ConfigKey -> Repo -> Maybe S.ByteString +getMaybe :: ConfigKey -> Repo -> Maybe ConfigValue 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' :: ConfigKey -> S.ByteString -> Repo -> Repo +store' :: ConfigKey -> ConfigValue -> 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) @@ -128,7 +128,7 @@ updateLocation' :: Repo -> RepoLocation -> IO Repo updateLocation' r l = do l' <- case getMaybe "core.worktree" r of Nothing -> return l - Just d -> do + Just (ConfigValue d) -> do {- core.worktree is relative to the gitdir -} top <- absPath $ gitdir l let p = absPathFrom top (fromRawFilePath d) @@ -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 ConfigKey [S.ByteString] +parse :: S.ByteString -> M.Map ConfigKey [ConfigValue] parse s | S.null s = M.empty -- --list output will have a '=' in the first line @@ -152,15 +152,15 @@ parse s firstline = S.takeWhile (/= nl) s sep c = M.fromListWith (++) - . map (\(k,v) -> (ConfigKey k, [S.drop 1 v])) + . map (\(k,v) -> (ConfigKey k, [ConfigValue (S.drop 1 v)])) . map (S.break (== c)) {- Checks if a string from git config is a true value. -} isTrue :: String -> Maybe Bool -isTrue = isTrue' . encodeBS' +isTrue = isTrue' . ConfigValue . encodeBS' -isTrue' :: S.ByteString -> Maybe Bool -isTrue' s +isTrue' :: ConfigValue -> Maybe Bool +isTrue' (ConfigValue s) | s' == "true" = Just True | s' == "false" = Just False | otherwise = Nothing diff --git a/Git/ConfigTypes.hs b/Git/ConfigTypes.hs index db5a1285d1..f01a2cef40 100644 --- a/Git/ConfigTypes.hs +++ b/Git/ConfigTypes.hs @@ -14,6 +14,7 @@ import qualified Data.ByteString.Char8 as S8 import Common import Git +import Git.Types import qualified Git.Config data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int @@ -21,23 +22,27 @@ data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int getSharedRepository :: Repo -> SharedRepository getSharedRepository r = - case S8.map toLower $ Git.Config.get "core.sharedrepository" "" r of - "1" -> GroupShared - "2" -> AllShared - "group" -> GroupShared - "true" -> GroupShared - "all" -> AllShared - "world" -> AllShared - "everybody" -> AllShared - v -> maybe UnShared UmaskShared (readish (decodeBS' v)) + case Git.Config.getMaybe "core.sharedrepository" r of + Nothing -> UnShared + Just (ConfigValue v) -> case S8.map toLower v of + "1" -> GroupShared + "2" -> AllShared + "group" -> GroupShared + "true" -> GroupShared + "all" -> AllShared + "world" -> AllShared + "everybody" -> AllShared + _ -> maybe UnShared UmaskShared (readish (decodeBS' v)) data DenyCurrentBranch = UpdateInstead | RefusePush | WarnPush | IgnorePush deriving (Eq) getDenyCurrentBranch :: Repo -> DenyCurrentBranch -getDenyCurrentBranch r = - case S8.map toLower $ Git.Config.get "receive.denycurrentbranch" "" r of - "updateinstead" -> UpdateInstead - "warn" -> WarnPush - "ignore" -> IgnorePush - _ -> RefusePush +getDenyCurrentBranch r = + case Git.Config.getMaybe "receive.denycurrentbranch" r of + Just (ConfigValue v) -> case S8.map toLower v of + "updateinstead" -> UpdateInstead + "warn" -> WarnPush + "ignore" -> IgnorePush + _ -> RefusePush + Nothing -> RefusePush diff --git a/Git/Construct.hs b/Git/Construct.hs index 3c907b5840..7a58a5d444 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -128,7 +128,7 @@ fromRemotes repo = mapM construct remotepairs filterconfig f = filter f $ M.toList $ config repo filterkeys f = filterconfig (\(k,_) -> f k) remotepairs = filterkeys isRemoteKey - construct (k,v) = remoteNamedFromKey k (fromRemoteLocation (decodeBS' v) repo) + construct (k,v) = remoteNamedFromKey k (fromRemoteLocation (fromConfigValue v) repo) {- Sets the name of a remote when constructing the Repo to represent it. -} remoteNamed :: String -> IO Repo -> IO Repo diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index 7b9b46d423..7a70a2eaf8 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -79,9 +79,9 @@ type GCryptId = String - which is stored in the repository (in encrypted form) - and cached in a per-remote gcrypt-id configuration setting. -} remoteRepoId :: Repo -> Maybe RemoteName -> Maybe GCryptId -remoteRepoId r n = decodeBS' <$> getRemoteConfig "gcrypt-id" r n +remoteRepoId r n = fromConfigValue <$> getRemoteConfig "gcrypt-id" r n -getRemoteConfig :: S.ByteString -> Repo -> Maybe RemoteName -> Maybe S.ByteString +getRemoteConfig :: S.ByteString -> Repo -> Maybe RemoteName -> Maybe ConfigValue getRemoteConfig field repo remotename = do n <- remotename Config.getMaybe (remoteConfigKey field n) repo @@ -96,8 +96,8 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust ] where defaultkey = "gcrypt.participants" - parse (Just "simple") = [] - parse (Just b) = words (decodeBS' b) + parse (Just (ConfigValue "simple")) = [] + parse (Just (ConfigValue b)) = words (decodeBS' b) parse Nothing = [] remoteParticipantConfigKey :: RemoteName -> ConfigKey diff --git a/Git/Remote.hs b/Git/Remote.hs index 08e67fd624..5ff88a84fd 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -84,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 - (ConfigKey bestkey, bestvalue) = maximumBy longestvalue insteadofs + (ConfigKey bestkey, ConfigValue bestvalue) = maximumBy longestvalue insteadofs longestvalue (_, a) (_, b) = compare b a - insteadofs = filterconfig $ \(ConfigKey k, v) -> + insteadofs = filterconfig $ \(ConfigKey k, ConfigValue 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 c8688c625c..45adc1f377 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -6,11 +6,13 @@ -} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Git.Types where import Network.URI import Data.String +import Data.Default import qualified Data.Map as M import qualified Data.ByteString as S import System.Posix.Types @@ -36,9 +38,9 @@ data RepoLocation data Repo = Repo { location :: RepoLocation - , config :: M.Map ConfigKey S.ByteString + , config :: M.Map ConfigKey ConfigValue -- a given git config key can actually have multiple values - , fullconfig :: M.Map ConfigKey [S.ByteString] + , fullconfig :: M.Map ConfigKey [ConfigValue] -- 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 @@ -52,15 +54,30 @@ data Repo = Repo newtype ConfigKey = ConfigKey S.ByteString deriving (Ord, Eq) +newtype ConfigValue = ConfigValue S.ByteString + deriving (Ord, Eq, Semigroup, Monoid) + +instance Default ConfigValue where + def = ConfigValue mempty + fromConfigKey :: ConfigKey -> String fromConfigKey (ConfigKey s) = decodeBS' s instance Show ConfigKey where show = fromConfigKey +fromConfigValue :: ConfigValue -> String +fromConfigValue (ConfigValue s) = decodeBS' s + +instance Show ConfigValue where + show = fromConfigValue + instance IsString ConfigKey where fromString = ConfigKey . encodeBS' +instance IsString ConfigValue where + fromString = ConfigValue . encodeBS' + type RemoteName = String {- A git ref. Can be a sha1, or a branch or tag name. -} diff --git a/Logs/Config.hs b/Logs/Config.hs index 068a12a061..1271c9826c 100644 --- a/Logs/Config.hs +++ b/Logs/Config.hs @@ -6,8 +6,8 @@ -} module Logs.Config ( - ConfigKey, - ConfigValue, + ConfigKey(..), + ConfigValue(..), setGlobalConfig, unsetGlobalConfig, getGlobalConfig, @@ -18,7 +18,7 @@ import Annex.Common import Logs import Logs.MapLog import qualified Annex.Branch -import Git.Types (ConfigKey(..)) +import Git.Types (ConfigKey(..), ConfigValue(..)) import qualified Data.Map as M import qualified Data.ByteString as S @@ -26,8 +26,6 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Attoparsec.ByteString.Lazy as A import Data.ByteString.Builder -type ConfigValue = S.ByteString - setGlobalConfig :: ConfigKey -> ConfigValue -> Annex () setGlobalConfig name new = do curr <- getGlobalConfig name @@ -44,7 +42,8 @@ unsetGlobalConfig :: ConfigKey -> Annex () unsetGlobalConfig name = do curr <- getGlobalConfig name when (curr /= Nothing) $ - setGlobalConfig' name mempty -- set to empty string to unset + -- set to empty string to unset + setGlobalConfig' name (ConfigValue mempty) -- Reads the global config log every time. getGlobalConfig :: ConfigKey -> Annex (Maybe ConfigValue) @@ -53,15 +52,17 @@ getGlobalConfig name = M.lookup name <$> loadGlobalConfig buildGlobalConfig :: MapLog ConfigKey ConfigValue -> Builder buildGlobalConfig = buildMapLog configkeybuilder valuebuilder where - configkeybuilder (ConfigKey f) = byteString f - valuebuilder = byteString + configkeybuilder (ConfigKey k) = byteString k + valuebuilder (ConfigValue v) = byteString v parseGlobalConfig :: L.ByteString -> MapLog ConfigKey ConfigValue parseGlobalConfig = parseMapLog configkeyparser valueparser where configkeyparser = ConfigKey <$> A.takeByteString - valueparser = A.takeByteString + valueparser = ConfigValue <$> A.takeByteString loadGlobalConfig :: Annex (M.Map ConfigKey ConfigValue) -loadGlobalConfig = M.filter (not . S.null) . simpleMap . parseGlobalConfig +loadGlobalConfig = M.filter (\(ConfigValue v) -> not (S.null v)) + . simpleMap + . parseGlobalConfig <$> Annex.Branch.get configLog diff --git a/Remote.hs b/Remote.hs index 771e9b67ba..fb096736ee 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, ConfigKey(..)) +import Git.Types (RemoteName, ConfigKey(..), fromConfigValue) import Utility.Aeson {- Map from UUIDs of Remotes to a calculated value. -} @@ -150,7 +150,7 @@ byNameOrGroup :: RemoteName -> Annex [Remote] byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." <> encodeBS' n)) where go (Just l) = catMaybes - <$> mapM (byName . Just) (splitc ' ' (decodeBS' l)) + <$> mapM (byName . Just) (splitc ' ' (fromConfigValue l)) go Nothing = maybeToList <$> byName (Just n) diff --git a/Remote/Bup.hs b/Remote/Bup.hs index dfce6a188d..8fa00cbc41 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -16,7 +16,7 @@ import Annex.Common import qualified Annex import Types.Remote import Types.Creds -import Git.Types (fromConfigKey) +import Git.Types (ConfigValue(..), fromConfigKey) import qualified Git import qualified Git.Command import qualified Git.Config @@ -213,7 +213,7 @@ storeBupUUID u buprepo = do giveup "ssh failed" else liftIO $ do r' <- Git.Config.read r - let olduuid = Git.Config.get configkeyUUID mempty r' + let ConfigValue olduuid = Git.Config.get configkeyUUID mempty r' when (S.null olduuid) $ Git.Command.run [ Param "config" diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 7fe83a0a5a..4682637eaf 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -30,7 +30,7 @@ import Types.GitConfig import Types.Crypto import Types.Creds import Types.Transfer -import Git.Types (ConfigKey(..), fromConfigKey) +import Git.Types (ConfigKey(..), fromConfigKey, fromConfigValue) import qualified Git import qualified Git.Command import qualified Git.Config @@ -462,7 +462,7 @@ getGCryptId fast r gc | otherwise = return (Nothing, r) where extract Nothing = (Nothing, r) - extract (Just r') = (decodeBS' <$> Git.Config.getMaybe coreGCryptId r', r') + extract (Just r') = (fromConfigValue <$> Git.Config.getMaybe coreGCryptId r', r') getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString)) getConfigViaRsync r gc = do diff --git a/Remote/Git.hs b/Remote/Git.hs index f4f2ddfcb1..7dc85aa629 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -95,7 +95,7 @@ list autoinit = do Nothing -> return r Just url -> inRepo $ \g -> Git.Construct.remoteNamed n $ - Git.Construct.fromRemoteLocation (decodeBS' url) g + Git.Construct.fromRemoteLocation (Git.fromConfigValue url) g {- Git remotes are normally set up using standard git command, not - git-annex initremote and enableremote. diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index 624f90c3e7..fb4f2fce8c 100644 --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -189,7 +189,7 @@ configKnownUrl r set k v r' = do let k' = remoteConfig r' k setConfig k' v - return $ Git.Config.store' k' (encodeBS' v) r' + return $ Git.Config.store' k' (Git.ConfigValue (encodeBS' v)) r' data LFSHandle = LFSHandle { downloadEndpoint :: Maybe LFS.Endpoint diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 1cc426f466..f0a67d808e 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -11,7 +11,7 @@ import Annex.Common import Types.Remote import Types.Creds import qualified Git -import Git.Types (fromConfigKey) +import Git.Types (fromConfigKey, fromConfigValue) import Config import Config.Cost import Annex.UUID @@ -108,10 +108,10 @@ hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv) lookupHook :: HookName -> Action -> Annex (Maybe String) lookupHook hookname action = do - command <- decodeBS' <$> getConfig hook mempty + command <- fromConfigValue <$> getConfig hook mempty if null command then do - fallback <- decodeBS' <$> getConfig hookfallback mempty + fallback <- fromConfigValue <$> getConfig hookfallback mempty if null fallback then do warning $ "missing configuration for " ++ fromConfigKey hook ++ " or " ++ fromConfigKey hookfallback diff --git a/Test.hs b/Test.hs index bbe0f37431..4752ff07e2 100644 --- a/Test.hs +++ b/Test.hs @@ -204,17 +204,12 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" - of git-annex. They are always run before the unitTests. -} initTests :: TestTree initTests = testGroup "Init Tests" - [] -{- [ testCase "init" test_init , testCase "add" test_add ] --} unitTests :: String -> TestTree unitTests note = testGroup ("Unit Tests " ++ note) - [] -{- [ testCase "add dup" test_add_dup , testCase "add extras" test_add_extras , testCase "export_import" test_export_import @@ -629,7 +624,7 @@ test_lock_force = intmpclonerepo $ do git_annex "get" [annexedfile] @? "get of file failed" git_annex "unlock" [annexedfile] @? "unlock failed" annexeval $ do - Just k <- Annex.WorkTree.lookupFile annexedfile + Just k <- Annex.WorkTree.lookupFile (toRawFilePath annexedfile) Database.Keys.removeInodeCaches k Database.Keys.closeDb liftIO . nukeFile =<< Annex.fromRepo Annex.Locations.gitAnnexKeysDbIndexCache @@ -1151,7 +1146,7 @@ test_mixed_conflict_resolution = do @? (what ++ " too many variant files in: " ++ show v) indir d $ do git_annex "get" (conflictor:v) @? ("get failed in " ++ what) - git_annex_expectoutput "find" [conflictor] [Git.FilePath.toInternalGitPath subfile] + git_annex_expectoutput "find" [conflictor] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath subfile))] git_annex_expectoutput "find" v v {- Check merge conflict resolution when both repos start with an annexed @@ -1348,7 +1343,7 @@ test_conflict_resolution_symlink_bit = unlessM (hasUnlockedFiles <$> getTestMode where conflictor = "conflictor" check_is_link f what = do - git_annex_expectoutput "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f] + git_annex_expectoutput "find" ["--include=*", f] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath f))] l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f] all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l @? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) @@ -1603,7 +1598,7 @@ test_crypto = do (c,k) <- annexeval $ do uuid <- Remote.nameToUUID "foo" rs <- Logs.Remote.readRemoteLog - Just k <- Annex.WorkTree.lookupFile annexedfile + Just k <- Annex.WorkTree.lookupFile (toRawFilePath annexedfile) return (fromJust $ M.lookup uuid rs, k) let key = if scheme `elem` ["hybrid","pubkey"] then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId] @@ -1781,5 +1776,3 @@ test_export_import_subdir = intmpclonerepo $ do -- Make sure that import did not import the file to the top -- of the repo. checkdoesnotexist annexedfile - --} diff --git a/Test/Framework.hs b/Test/Framework.hs index b02bcc384c..8f3a773bd3 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -89,8 +89,9 @@ inmainrepo a = do with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion) with_ssh_origin cloner a = cloner $ do - origindir <- absPath . decodeBS' - =<< annexeval (Config.getConfig (Git.Types.ConfigKey (encodeBS' config)) (toRawFilePath "/dev/null")) + let k = Git.Types.ConfigKey (encodeBS' config) + let v = Git.Types.ConfigValue (toRawFilePath "/dev/null") + origindir <- absPath . Git.Types.fromConfigValue =<< annexeval (Config.getConfig k v) let originurl = "localhost:" ++ origindir boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed" a diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 73dd70cfcc..df2cd6bb1f 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -203,9 +203,9 @@ extractGitConfig r = GitConfig getbool k d = fromMaybe d $ getmaybebool k getmaybebool k = Git.Config.isTrue' =<< getmaybe' k getmayberead k = readish =<< getmaybe k - getmaybe = fmap decodeBS' . getmaybe' + getmaybe = fmap fromConfigValue . getmaybe' getmaybe' k = Git.Config.getMaybe k r - getlist k = map decodeBS' $ Git.Config.getList k r + getlist k = map fromConfigValue $ Git.Config.getList k r getwords k = fromMaybe [] $ words <$> getmaybe k configurable d Nothing = DefaultConfig d @@ -345,7 +345,7 @@ extractRemoteGitConfig r remotename = do getbool k d = fromMaybe d $ getmaybebool k getmaybebool k = Git.Config.isTrue' =<< getmaybe' k getmayberead k = readish =<< getmaybe k - getmaybe = fmap decodeBS' . getmaybe' + getmaybe = fmap fromConfigValue . getmaybe' getmaybe' k = mplus (Git.Config.getMaybe (key k) r) (Git.Config.getMaybe (remotekey k) r) getoptions k = fromMaybe [] $ words <$> getmaybe k diff --git a/Types/UUID.hs b/Types/UUID.hs index 726875b3a8..92f5ed9e17 100644 --- a/Types/UUID.hs +++ b/Types/UUID.hs @@ -17,6 +17,7 @@ import Data.String import Data.ByteString.Builder import qualified Data.Semigroup as Sem +import Git.Types (ConfigValue(..)) import Utility.FileSystemEncoding import Utility.QuickCheck import qualified Utility.SimpleProtocol as Proto @@ -52,6 +53,12 @@ instance FromUUID String where instance ToUUID String where toUUID s = toUUID (encodeBS' s) +instance FromUUID ConfigValue where + fromUUID s = (ConfigValue (fromUUID s)) + +instance ToUUID ConfigValue where + toUUID (ConfigValue v) = toUUID v + -- There is no matching FromUUID U.UUID because a git-annex UUID may -- be NoUUID or perhaps contain something not allowed in a canonical UUID. instance ToUUID U.UUID where diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index 2e6ca9b0b4..3f67959976 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -51,7 +51,7 @@ setIndirect = do Nothing -> noop Just wt -> do unsetConfig src - setConfig dest (decodeBS' wt) + setConfig dest (fromConfigValue wt) reloadConfig {- Converts a directBranch back to the original branch. diff --git a/git-annex.cabal b/git-annex.cabal index 1b695b10ae..5d8ba73914 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -407,16 +407,16 @@ Executable git-annex if flag(S3) Build-Depends: aws (>= 0.20) CPP-Options: -DWITH_S3 - Other-Modules-temp-disabled: Remote.S3 + Other-Modules: Remote.S3 if flag(WebDAV) Build-Depends: DAV (>= 1.0) CPP-Options: -DWITH_WEBDAV - Other-Modules-temp-disabled: + Other-Modules: Remote.WebDAV Remote.WebDAV.DavLocation if flag(S3) || flag(WebDAV) - Other-Modules-temp-disabled: + Other-Modules: Remote.Helper.Http if flag(Assistant) && ! os(solaris) && ! os(gnu) @@ -602,7 +602,7 @@ Executable git-annex if flag(DebugLocks) CPP-Options: -DDEBUGLOCKS - Other-Modules-Temp-Disabled: + Other-Modules: Annex Annex.Action Annex.AdjustedBranch @@ -860,6 +860,7 @@ Executable git-annex Git.RefLog Git.Remote Git.Remote.Remove + Git.Repair Git.Sha Git.Ssh Git.Status