From 727767e1e2fb85102e7611c8dfd1d9dbc6e437c5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Jan 2019 16:34:04 -0400 Subject: [PATCH] make everything build again after ByteString Key changes --- Annex/Content.hs | 4 +-- Annex/Export.hs | 5 ++-- Annex/Locations.hs | 11 --------- Annex/Transfer.hs | 2 +- Assistant/Threads/SanityChecker.hs | 4 ++- Backend.hs | 11 +++++---- Backend/Hash.hs | 39 ++++++++++++++++-------------- Backend/Utilities.hs | 10 +++++--- Backend/WORM.hs | 6 +++-- CHANGELOG | 4 ++- CmdLine/GitAnnex/Options.hs | 2 +- Command/Find.hs | 4 +-- Command/Fsck.hs | 4 +-- Command/Info.hs | 2 +- Command/Version.hs | 2 +- Crypto.hs | 11 ++++++--- Limit.hs | 2 +- Remote/External/Types.hs | 4 +-- Remote/Helper/Export.hs | 2 +- Test.hs | 1 - Test/Framework.hs | 2 +- Types/Backend.hs | 4 ++- Upgrade/V1.hs | 15 ++++++------ 23 files changed, 79 insertions(+), 72 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 6b010333e4..f8d0006c7a 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -405,7 +405,7 @@ warnUnverifiableInsecure k = warning $ unwords , "this safety check.)" ] where - kv = formatKeyVariety (keyVariety k) + kv = decodeBS (formatKeyVariety (keyVariety k)) data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify @@ -544,7 +544,7 @@ checkSecureHashes key | cryptographicallySecure (keyVariety key) = return True | otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig) ( do - warning $ "annex.securehashesonly blocked adding " ++ formatKeyVariety (keyVariety key) ++ " key to annex objects" + warning $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (keyVariety key)) ++ " key to annex objects" return False , return True ) diff --git a/Annex/Export.hs b/Annex/Export.hs index e376e87b84..47a6a75249 100644 --- a/Annex/Export.hs +++ b/Annex/Export.hs @@ -15,6 +15,7 @@ import qualified Git import qualified Types.Remote as Remote import Config import Messages +import Utility.FileSystemEncoding import qualified Data.Map as M import Control.Applicative @@ -35,8 +36,8 @@ exportKey sha = mk <$> catKey sha where mk (Just k) = AnnexKey k mk Nothing = GitKey $ Key - { keyName = Git.fromRef sha - , keyVariety = SHA1Key (HasExt False) + { keyName = encodeBS $ Git.fromRef sha + , keyVariety = SHA1Key (HasExt False) mempty , keySize = Nothing , keyMtime = Nothing , keyChunkSize = Nothing diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 8fd3dfce01..7f3be1953a 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -76,8 +76,6 @@ module Annex.Locations ( hashDirLower, preSanitizeKeyName, reSanitizeKeyName, - - prop_isomorphic_fileKey ) where import Data.Char @@ -85,7 +83,6 @@ import Data.Default import Common import Key -import Types.Key import Types.UUID import Types.GitConfig import Types.Difference @@ -529,14 +526,6 @@ fileKey = file2key . unesc [] unesc r ('&':'a':cs) = unesc ('&':r) cs unesc r (c:cs) = unesc (c:r) cs -{- for quickcheck -} -prop_isomorphic_fileKey :: String -> Bool -prop_isomorphic_fileKey s - | null s = True -- it's not legal for a key to have no keyName - | otherwise= Just k == fileKey (keyFile k) - where - k = stubKey { keyName = s, keyVariety = OtherKey "test" } - {- A location to store a key on a special remote that uses a filesystem. - A directory hash is used, to protect against filesystems that dislike - having many items in a single directory. diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 47863473e7..8841266dd9 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -178,7 +178,7 @@ checkSecureHashes t a | cryptographicallySecure variety = a | otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig) ( do - warning $ "annex.securehashesonly blocked transfer of " ++ formatKeyVariety variety ++ " key" + warning $ "annex.securehashesonly blocked transfer of " ++ decodeBS (formatKeyVariety variety) ++ " key" return observeFailure , a ) diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 43812e5d41..893c700f86 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Assistant.Threads.SanityChecker ( sanityCheckerStartupThread, @@ -52,6 +53,7 @@ import Utility.DiskFree import Data.Time.Clock.POSIX import qualified Data.Text as T +import qualified Data.ByteString as S {- This thread runs once at startup, and most other threads wait for it - to finish. (However, the webapp thread does not, to prevent the UI @@ -309,7 +311,7 @@ cleanReallyOldTmp = do cleanjunk check f = case fileKey (takeFileName f) of Nothing -> cleanOld check f Just k - | "GPGHMAC" `isPrefixOf` formatKeyVariety (keyVariety k) -> + | "GPGHMAC" `S.isPrefixOf` formatKeyVariety (keyVariety k) -> cleanOld check f | otherwise -> noop diff --git a/Backend.hs b/Backend.hs index af033a63b6..2932253aec 100644 --- a/Backend.hs +++ b/Backend.hs @@ -29,6 +29,7 @@ import qualified Backend.WORM import qualified Backend.URL import qualified Data.Map as M +import qualified Data.ByteString.Char8 as S8 list :: [Backend] list = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends @@ -46,7 +47,7 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend Annex.changeState $ \s -> s { Annex.backend = Just b } return b valid name = not (null name) - lookupname = lookupBackendVariety . parseKeyVariety + lookupname = lookupBackendVariety . parseKeyVariety . encodeBS {- Generates a key for a file. -} genKey :: KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend)) @@ -57,7 +58,7 @@ genKey source preferredbackend = do Just k -> Just (makesane k, b) where -- keyNames should not contain newline characters. - makesane k = k { keyName = map fixbadchar (keyName k) } + makesane k = k { keyName = S8.map fixbadchar (keyName k) } fixbadchar c | c == '\n' = '_' | otherwise = c @@ -66,7 +67,7 @@ getBackend :: FilePath -> Key -> Annex (Maybe Backend) getBackend file k = case maybeLookupBackendVariety (keyVariety k) of Just backend -> return $ Just backend Nothing -> do - warning $ "skipping " ++ file ++ " (unknown backend " ++ formatKeyVariety (keyVariety k) ++ ")" + warning $ "skipping " ++ file ++ " (unknown backend " ++ decodeBS (formatKeyVariety (keyVariety k)) ++ ")" return Nothing {- Looks up the backend that should be used for a file. @@ -75,7 +76,7 @@ getBackend file k = case maybeLookupBackendVariety (keyVariety k) of chooseBackend :: FilePath -> Annex (Maybe Backend) chooseBackend f = Annex.getState Annex.forcebackend >>= go where - go Nothing = maybeLookupBackendVariety . parseKeyVariety + go Nothing = maybeLookupBackendVariety . parseKeyVariety . encodeBS <$> checkAttr "annex.backend" f go (Just _) = Just <$> defaultBackend @@ -83,7 +84,7 @@ chooseBackend f = Annex.getState Annex.forcebackend >>= go lookupBackendVariety :: KeyVariety -> Backend lookupBackendVariety v = fromMaybe unknown $ maybeLookupBackendVariety v where - unknown = giveup $ "unknown backend " ++ formatKeyVariety v + unknown = giveup $ "unknown backend " ++ decodeBS (formatKeyVariety v) maybeLookupBackendVariety :: KeyVariety -> Maybe Backend maybeLookupBackendVariety v = M.lookup v varietyMap diff --git a/Backend/Hash.hs b/Backend/Hash.hs index 7d8e335854..b8977301b3 100644 --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -1,11 +1,12 @@ {- git-annex hashing backends - - - Copyright 2011-2018 Joey Hess + - Copyright 2011-2019 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Backend.Hash ( backends, @@ -19,6 +20,8 @@ import Types.Backend import Types.KeySource import Utility.Hash +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.Char @@ -71,15 +74,15 @@ genBackendE hash = (genBackend hash) } hashKeyVariety :: Hash -> HasExt -> KeyVariety -hashKeyVariety MD5Hash = MD5Key -hashKeyVariety SHA1Hash = SHA1Key -hashKeyVariety (SHA2Hash size) = SHA2Key size -hashKeyVariety (SHA3Hash size) = SHA3Key size -hashKeyVariety (SkeinHash size) = SKEINKey size +hashKeyVariety MD5Hash he = MD5Key he mempty +hashKeyVariety SHA1Hash he = SHA1Key he mempty +hashKeyVariety (SHA2Hash size) he = SHA2Key size he mempty +hashKeyVariety (SHA3Hash size) he = SHA3Key size he mempty +hashKeyVariety (SkeinHash size) he = SKEINKey size he mempty #if MIN_VERSION_cryptonite(0,23,0) -hashKeyVariety (Blake2bHash size) = Blake2bKey size -hashKeyVariety (Blake2sHash size) = Blake2sKey size -hashKeyVariety (Blake2spHash size) = Blake2spKey size +hashKeyVariety (Blake2bHash size) he = Blake2bKey size he mempty +hashKeyVariety (Blake2sHash size) he = Blake2sKey size he mempty +hashKeyVariety (Blake2spHash size) he = Blake2spKey size he mempty #endif {- A key is a hash of its contents. -} @@ -89,7 +92,7 @@ keyValue hash source = do filesize <- liftIO $ getFileSize file s <- hashFile hash file return $ Just $ stubKey - { keyName = s + { keyName = encodeBS s , keyVariety = hashKeyVariety hash (HasExt False) , keySize = Just filesize } @@ -102,7 +105,7 @@ keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig let ext = selectExtension maxlen (keyFilename source) return $ Just $ k - { keyName = keyName k ++ ext + { keyName = keyName k <> encodeBS ext , keyVariety = hashKeyVariety hash (HasExt True) } @@ -132,7 +135,7 @@ checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do check <$> hashFile hash file _ -> return True where - expected = keyHash key + expected = decodeBS (keyHash key) check s | s == expected = True {- A bug caused checksums to be prefixed with \ in some @@ -145,8 +148,8 @@ checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do warning $ "hardware fault: " ++ show e return False -keyHash :: Key -> String -keyHash key = dropExtensions (keyName key) +keyHash :: Key -> S.ByteString +keyHash = fst . splitKeyNameExtension validInExtension :: Char -> Bool validInExtension c @@ -163,8 +166,8 @@ validInExtension c -} needsUpgrade :: Key -> Bool needsUpgrade key = or - [ "\\" `isPrefixOf` keyHash key - , any (not . validInExtension) (takeExtensions $ keyName key) + [ "\\" `S8.isPrefixOf` keyHash key + , any (not . validInExtension) (decodeBS $ snd $ splitKeyNameExtension key) , not (hasExt (keyVariety key)) && keyHash key /= keyName key ] @@ -184,7 +187,7 @@ trivialMigrate' oldkey newbackend afile maxextlen AssociatedFile Nothing -> Nothing AssociatedFile (Just file) -> Just $ oldkey { keyName = keyHash oldkey - ++ selectExtension maxextlen file + <> encodeBS (selectExtension maxextlen file) , keyVariety = newvariety } {- Upgrade to fix bad previous migration that created a @@ -285,5 +288,5 @@ testKeyBackend = let b = genBackendE (SHA2Hash (HashSize 256)) in b { getKey = (fmap addE) <$$> getKey b } where - addE k = k { keyName = keyName k ++ longext } + addE k = k { keyName = keyName k <> longext } longext = ".this-is-a-test-key" diff --git a/Backend/Utilities.hs b/Backend/Utilities.hs index 6b31b8d12d..bfb0f1043c 100644 --- a/Backend/Utilities.hs +++ b/Backend/Utilities.hs @@ -1,6 +1,6 @@ {- git-annex backend utilities - - - Copyright 2012 Joey Hess + - Copyright 2012-2019 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,17 +10,19 @@ module Backend.Utilities where import Annex.Common import Utility.Hash +import qualified Data.ByteString as S + {- Generates a keyName from an input string. Takes care of sanitizing it. - If it's not too long, the full string is used as the keyName. - Otherwise, it's truncated, and its md5 is prepended to ensure a unique - key. -} -genKeyName :: String -> String +genKeyName :: String -> S.ByteString genKeyName s -- Avoid making keys longer than the length of a SHA256 checksum. - | bytelen > sha256len = + | bytelen > sha256len = encodeBS' $ truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++ show (md5 (encodeBL s)) - | otherwise = s' + | otherwise = encodeBS' s' where s' = preSanitizeKeyName s bytelen = length (decodeW8 s') diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 689cc1d904..eb565bf618 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -14,6 +14,8 @@ import Types.KeySource import Backend.Utilities import Git.FilePath +import qualified Data.ByteString.Char8 as S8 + backends :: [Backend] backends = [backend] @@ -45,12 +47,12 @@ keyValue source = do {- Old WORM keys could contain spaces, and can be upgraded to remove them. -} needsUpgrade :: Key -> Bool -needsUpgrade key = ' ' `elem` keyName key +needsUpgrade key = ' ' `S8.elem` keyName key removeSpaces :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key) removeSpaces oldkey newbackend _ | migratable = return $ Just $ oldkey - { keyName = reSanitizeKeyName (keyName oldkey) } + { keyName = encodeBS $ reSanitizeKeyName $ decodeBS $ keyName oldkey } | otherwise = return Nothing where migratable = oldvariety == newvariety diff --git a/CHANGELOG b/CHANGELOG index 7e898d3834..21c7d5c4e2 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -13,7 +13,9 @@ git-annex (7.20181212) UNRELEASED; urgency=medium * Fix doubled progress display when downloading an url when -J is used. * importfeed: Better error message when downloading the feed fails. * Some optimisations, including a 10x faster timestamp parser, - and improved parsing and serialization of git-annex branch data. + a 7x faster key parser, and improved parsing and serialization of + git-annex branch data. + * Stricter parser for keys doesn't allow doubled fields or out of order fields. * The benchmark command, which only had some old benchmarking of the sqlite databases before, now allows benchmarking any other git-annex commands. * Support being built with ghc 8.6.3 (MonadFail). diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index 4f99782588..3c90513d8b 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -410,4 +410,4 @@ completeRemotes = completer $ mkCompleter $ \input -> do completeBackends :: HasCompleter f => Mod f a completeBackends = completeWith $ - map (formatKeyVariety . Backend.backendVariety) Backend.list + map (decodeBS . formatKeyVariety . Backend.backendVariety) Backend.list diff --git a/Command/Find.hs b/Command/Find.hs index 9c7b82016d..ddeec41ccf 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -89,10 +89,10 @@ showFormatted format unformatted vars = keyVars :: Key -> [(String, String)] keyVars key = [ ("key", key2file key) - , ("backend", formatKeyVariety $ keyVariety key) + , ("backend", decodeBS $ formatKeyVariety $ keyVariety key) , ("bytesize", size show) , ("humansize", size $ roughSize storageUnits True) - , ("keyname", keyName key) + , ("keyname", decodeBS $ keyName key) , ("hashdirlower", hashDirLower def key) , ("hashdirmixed", hashDirMixed def key) , ("mtime", whenavail show $ keyMtime key) diff --git a/Command/Fsck.hs b/Command/Fsck.hs index f51bda5eb1..48a97acfad 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -250,7 +250,7 @@ verifyLocationLog key keystatus ai = do - config was set. -} when (present && not (cryptographicallySecure (keyVariety key))) $ whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $ - warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ formatKeyVariety (keyVariety key) ++ " key" + warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (keyVariety key)) ++ " key" {- In direct mode, modified files will show up as not present, - but that is expected and not something to do anything about. -} @@ -424,7 +424,7 @@ checkKeyUpgrade backend key ai (AssociatedFile (Just file)) = [ actionItemDesc ai key , ": Can be upgraded to an improved key format. " , "You can do so by running: git annex migrate --backend=" - , formatKeyVariety (keyVariety key) ++ " " + , decodeBS (formatKeyVariety (keyVariety key)) ++ " " , file ] return True diff --git a/Command/Info.hs b/Command/Info.hs index 73c6efdbba..1ffb9011ca 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -481,7 +481,7 @@ disk_size = simpleStat "available local disk space" $ backend_usage :: Stat backend_usage = stat "backend usage" $ json fmt $ - ObjectMap . (M.mapKeys formatKeyVariety) . backendsKeys + ObjectMap . (M.mapKeys (decodeBS . formatKeyVariety)) . backendsKeys <$> cachedReferencedData where fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . sort . M.toList . fromObjectMap diff --git a/Command/Version.hs b/Command/Version.hs index 9b0ae66576..080f9fa429 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -59,7 +59,7 @@ showPackageVersion = do vinfo "build flags" $ unwords buildFlags vinfo "dependency versions" $ unwords dependencyVersions vinfo "key/value backends" $ unwords $ - map (formatKeyVariety . B.backendVariety) Backend.list + map (decodeBS . formatKeyVariety . B.backendVariety) Backend.list vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes vinfo "operating system" $ unwords [os, arch] vinfo "supported repository versions" $ diff --git a/Crypto.hs b/Crypto.hs index a375286194..41bb63e404 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -9,6 +9,7 @@ -} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} module Crypto ( @@ -33,6 +34,7 @@ module Crypto ( prop_HmacSha1WithCipher_sane ) where +import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.ByteString.UTF8 (fromString) import qualified Data.Map as M @@ -159,16 +161,17 @@ type EncKey = Key -> Key - on content. It does need to be repeatable. -} encryptKey :: Mac -> Cipher -> EncKey encryptKey mac c k = stubKey - { keyName = macWithCipher mac c (key2file k) - , keyVariety = OtherKey (encryptedBackendNamePrefix ++ showMac mac) + { keyName = encodeBS (macWithCipher mac c (key2file k)) + , keyVariety = OtherKey $ + encryptedBackendNamePrefix <> encodeBS (showMac mac) } -encryptedBackendNamePrefix :: String +encryptedBackendNamePrefix :: S.ByteString encryptedBackendNamePrefix = "GPG" isEncKey :: Key -> Bool isEncKey k = case keyVariety k of - OtherKey s -> encryptedBackendNamePrefix `isPrefixOf` s + OtherKey s -> encryptedBackendNamePrefix `S.isPrefixOf` s _ -> False type Feeder = Handle -> IO () diff --git a/Limit.hs b/Limit.hs index d85bb21e44..57d0d34c4c 100644 --- a/Limit.hs +++ b/Limit.hs @@ -257,7 +257,7 @@ limitInBackend :: MkLimit Annex limitInBackend name = Right $ const $ checkKey check where check key = pure $ keyVariety key == variety - variety = parseKeyVariety name + variety = parseKeyVariety (encodeBS name) {- Adds a limit to skip files not using a secure hash. -} addSecureHash :: Annex () diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 11c314e3f3..7c13b79d83 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -99,10 +99,10 @@ newtype SafeKey = SafeKey Key mkSafeKey :: Key -> Either String SafeKey mkSafeKey k - | any isSpace (keyName k) = Left $ concat + | any isSpace (decodeBS $ keyName k) = Left $ concat [ "Sorry, this file cannot be stored on an external special remote because its key's name contains a space. " , "To avoid this problem, you can run: git-annex migrate --backend=" - , formatKeyVariety (keyVariety k) + , decodeBS (formatKeyVariety (keyVariety k)) , " and pass it the name of the file" ] | otherwise = Right (SafeKey k) diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs index 82e490b12a..86f43d2fe5 100644 --- a/Remote/Helper/Export.hs +++ b/Remote/Helper/Export.hs @@ -208,5 +208,5 @@ adjustExportable r = case M.lookup "exporttree" (config r) of ea <- exportActions r retrieveExport ea k l dest p else do - warning $ "exported content cannot be verified due to using the " ++ formatKeyVariety (keyVariety k) ++ " backend" + warning $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (keyVariety k)) ++ " backend" return False diff --git a/Test.hs b/Test.hs index 88a3cfecdd..7a730e75c1 100644 --- a/Test.hs +++ b/Test.hs @@ -159,7 +159,6 @@ properties :: TestTree properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" [ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip , testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip - , testProperty "prop_isomorphic_fileKey" Annex.Locations.prop_isomorphic_fileKey , testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode , testProperty "prop_isomorphic_key_decode" Key.prop_isomorphic_key_decode , testProperty "prop_isomorphic_shellEscape" Utility.SafeCommand.prop_isomorphic_shellEscape diff --git a/Test/Framework.hs b/Test/Framework.hs index a4202ec8fc..8f1a664c68 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -562,7 +562,7 @@ backendWORM :: Types.Backend backendWORM = backend_ "WORM" backend_ :: String -> Types.Backend -backend_ = Backend.lookupBackendVariety . Types.Key.parseKeyVariety +backend_ = Backend.lookupBackendVariety . Types.Key.parseKeyVariety . encodeBS getKey :: Types.Backend -> FilePath -> IO Types.Key getKey b f = fromJust <$> annexeval go diff --git a/Types/Backend.hs b/Types/Backend.hs index 10b7b47fc8..ff3f8785ad 100644 --- a/Types/Backend.hs +++ b/Types/Backend.hs @@ -12,6 +12,8 @@ module Types.Backend where import Types.Key import Types.KeySource +import Utility.FileSystemEncoding + data BackendA a = Backend { backendVariety :: KeyVariety , getKey :: KeySource -> a (Maybe Key) @@ -28,7 +30,7 @@ data BackendA a = Backend } instance Show (BackendA a) where - show backend = "Backend { name =\"" ++ formatKeyVariety (backendVariety backend) ++ "\" }" + show backend = "Backend { name =\"" ++ decodeBS (formatKeyVariety (backendVariety backend)) ++ "\" }" instance Eq (BackendA a) where a == b = backendVariety a == backendVariety b diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 026bf2704c..99be467567 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -11,6 +11,7 @@ import System.Posix.Types import Data.Char import Data.Default import Data.ByteString.Builder +import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Annex.Common @@ -133,7 +134,7 @@ oldlog2key l where len = length l - 4 k = readKey1 (take len l) - sane = (not . null $ keyName k) && (not . null $ formatKeyVariety $ keyVariety k) + sane = (not . S.null $ keyName k) && (not . S.null $ formatKeyVariety $ keyVariety k) -- WORM backend keys: "WORM:mtime:size:filename" -- all the rest: "backend:key" @@ -145,8 +146,8 @@ readKey1 :: String -> Key readKey1 v | mixup = fromJust $ file2key $ intercalate ":" $ Prelude.tail bits | otherwise = stubKey - { keyName = n - , keyVariety = parseKeyVariety b + { keyName = encodeBS n + , keyVariety = parseKeyVariety (encodeBS b) , keySize = s , keyMtime = t } @@ -165,11 +166,11 @@ readKey1 v showKey1 :: Key -> String showKey1 Key { keyName = n , keyVariety = v, keySize = s, keyMtime = t } = - intercalate ":" $ filter (not . null) [b, showifhere t, showifhere s, n] + intercalate ":" $ filter (not . null) [b, showifhere t, showifhere s, decodeBS n] where showifhere Nothing = "" showifhere (Just x) = show x - b = formatKeyVariety v + b = decodeBS $ formatKeyVariety v keyFile1 :: Key -> FilePath keyFile1 key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ showKey1 key @@ -202,8 +203,8 @@ lookupFile1 file = do Just backend -> return $ Just (k, backend) where k = fileKey1 l - bname = formatKeyVariety (keyVariety k) - kname = keyName k + bname = decodeBS (formatKeyVariety (keyVariety k)) + kname = decodeBS (keyName k) skip = "skipping " ++ file ++ " (unknown backend " ++ bname ++ ")"