From d3ab5e626b0614c209fffead77d27e40f599ead8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Jan 2019 13:03:35 -0400 Subject: [PATCH] rename key2file and file2key What these generate is not really suitable to be used as a filename, which is why keyFile and fileKey further escape it. These are just serializing Keys. Also removed a quickcheck test that was very unlikely to test anything useful, since it relied on random chance creating something that looks like a serialized key. The other test is sufficient for testing what that was intended to test anyway. --- Annex/DirHashes.hs | 4 +- Annex/Drop.hs | 2 +- Annex/Locations.hs | 4 +- Annex/VariantFile.hs | 4 +- Assistant/Unused.hs | 2 +- Assistant/WebApp/DashBoard.hs | 2 +- Command/Add.hs | 2 +- Command/AddUnused.hs | 2 +- Command/AddUrl.hs | 2 +- Command/CalcKey.hs | 2 +- Command/Dead.hs | 2 +- Command/ExamineKey.hs | 4 +- Command/Export.hs | 2 +- Command/Find.hs | 2 +- Command/Fsck.hs | 4 +- Command/Import.hs | 2 +- Command/Info.hs | 2 +- Command/Log.hs | 2 +- Command/LookupKey.hs | 2 +- Command/TestRemote.hs | 2 +- Command/TransferKeys.hs | 4 +- Command/Unused.hs | 2 +- Crypto.hs | 2 +- Database/Types.hs | 8 ++-- Key.hs | 72 +++++++++++++++-------------------- Logs.hs | 2 +- Logs/Smudge.hs | 4 +- Logs/Unused.hs | 6 +-- Remote/Adb.hs | 2 +- Remote/Bup.hs | 2 +- Remote/Ddar.hs | 8 ++-- Remote/Git.hs | 4 +- Remote/Glacier.hs | 6 +-- Remote/Helper/Ssh.hs | 6 +-- Remote/Hook.hs | 4 +- Remote/S3.hs | 2 +- Test.hs | 11 +++--- Test/Framework.hs | 2 +- Types/ActionItem.hs | 4 +- Types/Distribution.hs | 4 +- 40 files changed, 97 insertions(+), 108 deletions(-) diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs index a5721534fd..194b4932c5 100644 --- a/Annex/DirHashes.hs +++ b/Annex/DirHashes.hs @@ -65,14 +65,14 @@ hashDirs (HashLevels 1) sz s = addTrailingPathSeparator $ take sz s hashDirs _ sz s = addTrailingPathSeparator $ take sz s drop sz s hashDirLower :: HashLevels -> Hasher -hashDirLower n k = hashDirs n 3 $ take 6 $ show $ md5 $ key2file' $ nonChunkKey k +hashDirLower n k = hashDirs n 3 $ take 6 $ show $ md5 $ serializeKey' $ nonChunkKey k {- This was originally using Data.Hash.MD5 from MissingH. This new version - is faster, but ugly as it has to replicate the 4 Word32's that produced. -} hashDirMixed :: HashLevels -> Hasher hashDirMixed n k = hashDirs n 2 $ take 4 $ concatMap display_32bits_as_dir $ encodeWord32 $ map fromIntegral $ Data.ByteArray.unpack $ - Utility.Hash.md5 $ key2file' $ nonChunkKey k + Utility.Hash.md5 $ serializeKey' $ nonChunkKey k where encodeWord32 (b1:b2:b3:b4:rest) = (shiftL b4 24 .|. shiftL b3 16 .|. shiftL b2 8 .|. b1) diff --git a/Annex/Drop.hs b/Annex/Drop.hs index fbb9346308..ff59d2dec8 100644 --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -115,7 +115,7 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do liftIO $ debugM "drop" $ unwords [ "dropped" , case afile of - AssociatedFile Nothing -> key2file key + AssociatedFile Nothing -> serializeKey key AssociatedFile (Just af) -> af , "(from " ++ maybe "here" show u ++ ")" , "(copies now " ++ show (fromNumCopies have - 1) ++ ")" diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 7f3be1953a..053be6e3b4 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -506,7 +506,7 @@ reSanitizeKeyName = preSanitizeKeyName' True - can cause existing objects to get lost. -} keyFile :: Key -> FilePath -keyFile = concatMap esc . key2file +keyFile = concatMap esc . serializeKey where esc '&' = "&a" esc '%' = "&s" @@ -517,7 +517,7 @@ keyFile = concatMap esc . key2file {- Reverses keyFile, converting a filename fragment (ie, the basename of - the symlink target) into a key. -} fileKey :: FilePath -> Maybe Key -fileKey = file2key . unesc [] +fileKey = deserializeKey . unesc [] where unesc r [] = reverse r unesc r ('%':cs) = unesc ('/':r) cs diff --git a/Annex/VariantFile.hs b/Annex/VariantFile.hs index 228053da30..7eee545ec7 100644 --- a/Annex/VariantFile.hs +++ b/Annex/VariantFile.hs @@ -34,8 +34,8 @@ mkVariant file variant = takeDirectory file -} variantFile :: FilePath -> Key -> FilePath variantFile file key - | doubleconflict = mkVariant file (key2file key) - | otherwise = mkVariant file (shortHash $ key2file key) + | doubleconflict = mkVariant file (serializeKey key) + | otherwise = mkVariant file (shortHash $ serializeKey key) where doubleconflict = variantMarker `isInfixOf` file diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs index b47727cd09..1a4d2dc641 100644 --- a/Assistant/Unused.hs +++ b/Assistant/Unused.hs @@ -74,7 +74,7 @@ expireUnused duration = do now <- liftIO getPOSIXTime let oldkeys = M.keys $ M.filter (tooold now) m forM_ oldkeys $ \k -> do - debug ["removing old unused key", key2file k] + debug ["removing old unused key", serializeKey k] liftAnnex $ tryNonAsync $ do lockContentForRemoval k removeAnnex logStatus k InfoMissing diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index 0ed6978da2..09a1e5f047 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -44,7 +44,7 @@ transfersDisplay = do isrunning info = not $ transferPaused info || isNothing (startedTime info) desc transfer info = case associatedFile info of - AssociatedFile Nothing -> key2file $ transferKey transfer + AssociatedFile Nothing -> serializeKey $ transferKey transfer AssociatedFile (Just af) -> af {- Simplifies a list of transfers, avoiding display of redundant diff --git a/Command/Add.hs b/Command/Add.hs index 840adc8f25..dc6ea5ac75 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -150,7 +150,7 @@ perform file = do cleanup :: Key -> Bool -> CommandCleanup cleanup key hascontent = do - maybeShowJSON $ JSONChunk [("key", key2file key)] + maybeShowJSON $ JSONChunk [("key", serializeKey key)] when hascontent $ logStatus key InfoPresent return True diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index c83c74e726..0ac2316122 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -32,7 +32,7 @@ perform key = next $ do addLink file key Nothing return True where - file = "unused." ++ key2file key + file = "unused." ++ serializeKey key {- The content is not in the annex, but in another directory, and - it seems better to error out, rather than moving bad/tmp content into diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index ef6ea7e033..be008f63aa 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -400,7 +400,7 @@ addWorkTree u url file key mtmp = case mtmp of else void $ Command.Add.addSmall file where go = do - maybeShowJSON $ JSONChunk [("key", key2file key)] + maybeShowJSON $ JSONChunk [("key", serializeKey key)] setUrlPresent key url logChange key u InfoPresent ifM (addAnnexedFile file key mtmp) diff --git a/Command/CalcKey.hs b/Command/CalcKey.hs index 57e6f40c96..49da891536 100644 --- a/Command/CalcKey.hs +++ b/Command/CalcKey.hs @@ -21,6 +21,6 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $ run :: () -> String -> Annex Bool run _ file = genKey (KeySource file file Nothing) Nothing >>= \case Just (k, _) -> do - liftIO $ putStrLn $ key2file k + liftIO $ putStrLn $ serializeKey k return True Nothing -> return False diff --git a/Command/Dead.hs b/Command/Dead.hs index b750ff7dec..01f16f6b82 100644 --- a/Command/Dead.hs +++ b/Command/Dead.hs @@ -33,7 +33,7 @@ seek (DeadKeys ks) = commandActions $ map startKey ks startKey :: Key -> CommandStart startKey key = do - showStart' "dead" (Just $ key2file key) + showStart' "dead" (Just $ serializeKey key) keyLocations key >>= \case [] -> next $ performKey key _ -> giveup "This key is still known to be present in some locations; not marking as dead." diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index 2c79c1a658..07554d181e 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -21,6 +21,6 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $ run :: Maybe Utility.Format.Format -> String -> Annex Bool run format p = do - let k = fromMaybe (giveup "bad key") $ file2key p - showFormatted format (key2file k) (keyVars k) + let k = fromMaybe (giveup "bad key") $ deserializeKey p + showFormatted format (serializeKey k) (keyVars k) return True diff --git a/Command/Export.hs b/Command/Export.hs index 6f3548587c..25d664201c 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -66,7 +66,7 @@ optParser _ = ExportOptions -- to a stable temporary name based on the key. exportTempName :: ExportKey -> ExportLocation exportTempName ek = mkExportLocation $ - ".git-annex-tmp-content-" ++ key2file (asKey (ek)) + ".git-annex-tmp-content-" ++ serializeKey (asKey (ek)) seek :: ExportOptions -> CommandSeek seek o = do diff --git a/Command/Find.hs b/Command/Find.hs index ddeec41ccf..4164ba1ff9 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -88,7 +88,7 @@ showFormatted format unformatted vars = keyVars :: Key -> [(String, String)] keyVars key = - [ ("key", key2file key) + [ ("key", serializeKey key) , ("backend", decodeBS $ formatKeyVariety $ keyVariety key) , ("bytesize", size show) , ("humansize", size $ roughSize storageUnits True) diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 48a97acfad..066e89bb56 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -498,7 +498,7 @@ checkBackendOr' bad backend key file ai postcheck = checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool checkKeyNumCopies key afile numcopies = do let (desc, hasafile) = case afile of - AssociatedFile Nothing -> (key2file key, False) + AssociatedFile Nothing -> (serializeKey key, False) AssociatedFile (Just af) -> (af, True) locs <- loggedLocations key (untrustedlocations, otherlocations) <- trustPartition UnTrusted locs @@ -562,7 +562,7 @@ badContentDirect file key = do badContentRemote :: Remote -> FilePath -> Key -> Annex String badContentRemote remote localcopy key = do bad <- fromRepo gitAnnexBadDir - let destbad = bad key2file key + let destbad = bad serializeKey key movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad)) ( return False , do diff --git a/Command/Import.hs b/Command/Import.hs index 95b5bd1a13..46e5a893a6 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -86,7 +86,7 @@ start largematcher mode (srcfile, destfile) = ) where deletedup k = do - showNote $ "duplicate of " ++ key2file k + showNote $ "duplicate of " ++ serializeKey k verifyExisting k destfile ( do liftIO $ removeFile srcfile diff --git a/Command/Info.hs b/Command/Info.hs index 1ffb9011ca..cabb538336 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -410,7 +410,7 @@ key_size :: Key -> Stat key_size k = simpleStat "size" $ showSizeKeys $ foldKeys [k] key_name :: Key -> Stat -key_name k = simpleStat "key" $ pure $ key2file k +key_name k = simpleStat "key" $ pure $ serializeKey k content_present :: Key -> Stat content_present k = stat "present" $ json boolConfig $ lift $ inAnnex k diff --git a/Command/Log.hs b/Command/Log.hs index 6369fb61df..b626452456 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -144,7 +144,7 @@ showLogIncremental outputter ps = do - as showLogIncremental. -} showLog :: (String -> Outputter) -> [RefChange] -> Annex () showLog outputter cs = forM_ cs $ \c -> do - let keyname = key2file (changekey c) + let keyname = serializeKey (changekey c) new <- S.fromList <$> loggedLocationsRef (newref c) old <- S.fromList <$> loggedLocationsRef (oldref c) sequence_ $ compareChanges (outputter keyname) diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 1a2a57f220..c7c0a59ad7 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -23,7 +23,7 @@ run _ file = seekSingleGitFile file >>= \case Nothing -> return False Just file' -> catKeyFile file' >>= \case Just k -> do - liftIO $ putStrLn $ key2file k + liftIO $ putStrLn $ serializeKey k return True Nothing -> return False diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index baffbe131c..6a689791ab 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -178,7 +178,7 @@ test st r k = Nothing -> return True Just b -> case Backend.verifyKeyContent b of Nothing -> return True - Just verifier -> verifier k (key2file k) + Just verifier -> verifier k (serializeKey k) get = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 462480c6f0..daecec5df1 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -126,5 +126,5 @@ instance TCSerialized RemoteName where deserialize n = Just n instance TCSerialized Key where - serialize = key2file - deserialize = file2key + serialize = serializeKey + deserialize = deserializeKey diff --git a/Command/Unused.hs b/Command/Unused.hs index 0181903c7a..bd44d49706 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -118,7 +118,7 @@ number n (x:xs) = (n+1, x) : number (n+1) xs table :: [(Int, Key)] -> [String] table l = " NUMBER KEY" : map cols l where - cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ key2file k + cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ serializeKey k pad n s = s ++ replicate (n - length s) ' ' staleTmpMsg :: [(Int, Key)] -> String diff --git a/Crypto.hs b/Crypto.hs index 41bb63e404..c1477a3cbe 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -161,7 +161,7 @@ type EncKey = Key -> Key - on content. It does need to be repeatable. -} encryptKey :: Mac -> Cipher -> EncKey encryptKey mac c k = stubKey - { keyName = encodeBS (macWithCipher mac c (key2file k)) + { keyName = encodeBS (macWithCipher mac c (serializeKey k)) , keyVariety = OtherKey $ encryptedBackendNamePrefix <> encodeBS (showMac mac) } diff --git a/Database/Types.hs b/Database/Types.hs index 49a63f067e..d330b3f760 100644 --- a/Database/Types.hs +++ b/Database/Types.hs @@ -23,10 +23,10 @@ newtype SKey = SKey String deriving (Show, Read) toSKey :: Key -> SKey -toSKey = SKey . key2file +toSKey = SKey . serializeKey fromSKey :: SKey -> Key -fromSKey (SKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (file2key s) +fromSKey (SKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (deserializeKey s) derivePersistField "SKey" @@ -41,10 +41,10 @@ instance Show IKey where show (IKey s) = s toIKey :: Key -> IKey -toIKey = IKey . key2file +toIKey = IKey . serializeKey fromIKey :: IKey -> Key -fromIKey (IKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (file2key s) +fromIKey (IKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (deserializeKey s) derivePersistField "IKey" diff --git a/Key.hs b/Key.hs index d8c542e5a1..93aed8ecac 100644 --- a/Key.hs +++ b/Key.hs @@ -11,20 +11,19 @@ module Key ( Key(..), AssociatedFile(..), stubKey, - buildKeyFile, - keyFileParser, - file2key, - key2file, - file2key', - key2file', + buildKey, + keyParser, + serializeKey, + serializeKey, + deserializeKey', + deserializeKey', nonChunkKey, chunkKeyOffset, isChunkKey, isKeyPrefix, splitKeyNameExtension, - prop_isomorphic_key_encode, - prop_isomorphic_key_decode + prop_isomorphic_key_encode ) where import qualified Data.Text as T @@ -77,11 +76,13 @@ isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s fieldSep :: Char fieldSep = '-' -{- Builds a ByteString that is suitable for use as a filename representing - - a Key. The name field is always shown last, separated by doubled fieldSeps, - - and is the only field allowed to contain the fieldSep. -} -buildKeyFile :: Key -> Builder -buildKeyFile k = byteString (formatKeyVariety (keyVariety k)) +{- Builds a ByteString from a Key. + - + - The name field is always shown last, separated by doubled fieldSeps, + - and is the only field allowed to contain the fieldSep. + -} +buildKey :: Key -> Builder +buildKey k = byteString (formatKeyVariety (keyVariety k)) <> 's' ?: (integerDec <$> keySize k) <> 'm' ?: (integerDec . (\(CTime t) -> fromIntegral t) <$> keyMtime k) <> 'S' ?: (integerDec <$> keyChunkSize k) @@ -92,11 +93,11 @@ buildKeyFile k = byteString (formatKeyVariety (keyVariety k)) c ?: (Just b) = sepbefore (char7 c <> b) _ ?: Nothing = mempty -key2file :: Key -> FilePath -key2file = decodeBL' . key2file' +serializeKey :: Key -> String +serializeKey = decodeBL' . serializeKey' -key2file' :: Key -> L.ByteString -key2file' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . buildKeyFile +serializeKey' :: Key -> L.ByteString +serializeKey' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . buildKey {- This is a strict parser for security reasons; a key - can contain only 4 fields, which all consist only of numbers. @@ -107,8 +108,8 @@ key2file' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . bui - embed data used in a SHA1 collision attack, which would be a - problem since the keys are committed to git. -} -keyFileParser :: A.Parser Key -keyFileParser = do +keyParser :: A.Parser Key +keyParser = do -- key variety cannot be empty v <- (parseKeyVariety <$> A8.takeWhile1 (/= fieldSep)) s <- parsesize @@ -135,11 +136,11 @@ keyFileParser = do parsechunksize = parseopt $ A8.char 'S' *> A8.decimal parsechunknum = parseopt $ A8.char 'C' *> A8.decimal -file2key :: FilePath -> Maybe Key -file2key = file2key' . encodeBS' +deserializeKey :: String -> Maybe Key +deserializeKey = deserializeKey' . encodeBS' -file2key' :: S.ByteString -> Maybe Key -file2key' b = eitherToMaybe $ A.parseOnly keyFileParser b +deserializeKey' :: S.ByteString -> Maybe Key +deserializeKey' b = eitherToMaybe $ A.parseOnly keyParser b {- This splits any extension out of the keyName, returning the - keyName minus extension, and the extension (including leading dot). @@ -178,30 +179,19 @@ instance Arbitrary Key where <*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative instance Hashable Key where - hashIO32 = hashIO32 . key2file' - hashIO64 = hashIO64 . key2file' + hashIO32 = hashIO32 . deserializeKey' + hashIO64 = hashIO64 . deserializeKey' instance ToJSON' Key where - toJSON' = toJSON' . key2file + toJSON' = toJSON' . serializeKey instance FromJSON Key where - parseJSON (String t) = maybe mempty pure $ file2key $ T.unpack t + parseJSON (String t) = maybe mempty pure $ deserializeKey $ T.unpack t parseJSON _ = mempty instance Proto.Serializable Key where - serialize = key2file - deserialize = file2key + serialize = serializeKey + deserialize = deserializeKey prop_isomorphic_key_encode :: Key -> Bool -prop_isomorphic_key_encode k = Just k == (file2key . key2file) k - -prop_isomorphic_key_decode :: FilePath -> Bool -prop_isomorphic_key_decode f - | normalfieldorder = maybe True (\k -> key2file k == f) (file2key f) - | otherwise = True - where - -- file2key will accept the fields in any order, so don't - -- try the test unless the fields are in the normal order - normalfieldorder = fields `isPrefixOf` "smSC" - fields = map (f !!) $ filter (< length f) $ map succ $ - elemIndices fieldSep f +prop_isomorphic_key_encode k = Just k == (deserializeKey . serializeKey) k diff --git a/Logs.hs b/Logs.hs index 0af14eb26c..63d64efadd 100644 --- a/Logs.hs +++ b/Logs.hs @@ -124,7 +124,7 @@ urlLogFile config key = branchHashDir config key keyFile key ++ urlLogExt {- Old versions stored the urls elsewhere. -} oldurlLogs :: GitConfig -> Key -> [FilePath] oldurlLogs config key = - [ "remote/web" hdir key2file key ++ ".log" + [ "remote/web" hdir serializeKey key ++ ".log" , "remote/web" hdir keyFile key ++ ".log" ] where diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs index 3a1fca8d46..5586a357d9 100644 --- a/Logs/Smudge.hs +++ b/Logs/Smudge.hs @@ -16,7 +16,7 @@ smudgeLog :: Key -> TopFilePath -> Annex () smudgeLog k f = do logf <- fromRepo gitAnnexSmudgeLog appendLogFile logf gitAnnexSmudgeLock $ - key2file k ++ " " ++ getTopFilePath f + serializeKey k ++ " " ++ getTopFilePath f -- | Streams all smudged files, and then empties the log at the end. -- @@ -36,5 +36,5 @@ streamSmudged a = do parse l = let (ks, f) = separate (== ' ') l in do - k <- file2key ks + k <- deserializeKey ks return (k, asTopFilePath f) diff --git a/Logs/Unused.hs b/Logs/Unused.hs index ebf968f8c2..75279948a0 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -66,8 +66,8 @@ writeUnusedLog prefix l = do logfile <- fromRepo $ gitAnnexUnusedLog prefix writeLogFile logfile $ unlines $ map format $ M.toList l where - format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t - format (k, (i, Nothing)) = show i ++ " " ++ key2file k + format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t + format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k readUnusedLog :: FilePath -> Annex UnusedLog readUnusedLog prefix = do @@ -78,7 +78,7 @@ readUnusedLog prefix = do , return M.empty ) where - parse line = case (readish sint, file2key skey, parsePOSIXTime ts) of + parse line = case (readish sint, deserializeKey skey, parsePOSIXTime ts) of (Just int, Just key, mtimestamp) -> Just (key, (int, mtimestamp)) _ -> Nothing where diff --git a/Remote/Adb.hs b/Remote/Adb.hs index 13c1ebcbd4..4f00b1754f 100644 --- a/Remote/Adb.hs +++ b/Remote/Adb.hs @@ -186,7 +186,7 @@ checkKey' r serial aloc = do androidLocation :: AndroidPath -> Key -> AndroidPath androidLocation adir k = AndroidPath $ - fromAndroidPath (androidHashDir adir k) ++ key2file k + fromAndroidPath (androidHashDir adir k) ++ serializeKey k androidHashDir :: AndroidPath -> Key -> AndroidPath androidHashDir adir k = AndroidPath $ diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 8bc04574ea..12fa119f29 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -280,7 +280,7 @@ bupRef k | Git.Ref.legal True shown = shown | otherwise = "git-annex-" ++ show (sha2_256 (fromString shown)) where - shown = key2file k + shown = serializeKey k bupLocal :: BupRepo -> Bool bupLocal = notElem ':' diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs index da4db9865e..139adfa435 100644 --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -110,7 +110,7 @@ store ddarrepo = fileStorer $ \k src _p -> do let params = [ Param "c" , Param "-N" - , Param $ key2file k + , Param $ serializeKey k , Param $ ddarRepoLocation ddarrepo , File src ] @@ -138,7 +138,7 @@ ddarRemoteCall cs ddarrepo cmd params {- Specialized ddarRemoteCall that includes extraction command and flags -} ddarExtractRemoteCall :: ConsumeStdin -> DdarRepo -> Key -> Annex (String, [CommandParam]) ddarExtractRemoteCall cs ddarrepo k = - ddarRemoteCall cs ddarrepo 'x' [Param "--force-stdout", Param $ key2file k] + ddarRemoteCall cs ddarrepo 'x' [Param "--force-stdout", Param $ serializeKey k] retrieve :: DdarRepo -> Retriever retrieve ddarrepo = byteRetriever $ \k sink -> do @@ -154,7 +154,7 @@ retrieveCheap _ _ _ = return False remove :: DdarRepo -> Remover remove ddarrepo key = do (cmd, params) <- ddarRemoteCall NoConsumeStdin ddarrepo 'd' - [Param $ key2file key] + [Param $ serializeKey key] liftIO $ boolSystem cmd params ddarDirectoryExists :: DdarRepo -> Annex (Either String Bool) @@ -188,7 +188,7 @@ inDdarManifest ddarrepo k = do contents <- hGetContents h return $ elem k' $ lines contents where - k' = key2file k + k' = serializeKey k checkKey :: DdarRepo -> CheckPresent checkKey ddarrepo key = do diff --git a/Remote/Git.hs b/Remote/Git.hs index 3a3af713df..7641dc50ab 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -427,7 +427,7 @@ lockKey' repo r (State connpool duc _) key callback fallback = do Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin repo "lockcontent" - [Param $ key2file key] [] + [Param $ serializeKey key] [] (Just hin, Just hout, Nothing, p) <- liftIO $ withFile devNull WriteMode $ \nullh -> createProcess $ @@ -530,7 +530,7 @@ copyFromRemote'' repo forcersync r (State connpool _ _) key file dest meterupdat : maybe [] (\f -> [(Fields.associatedFile, f)]) afile Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin repo "transferinfo" - [Param $ key2file key] fields + [Param $ serializeKey key] fields v <- liftIO (newEmptySV :: IO (MSampleVar Integer)) pidv <- liftIO $ newEmptyMVar tid <- liftIO $ forkIO $ void $ tryIO $ do diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 92d7e67590..c303bf6bd3 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -197,7 +197,7 @@ checkKey r k = do {- glacier checkpresent outputs the archive name to stdout if - it's present. -} s <- liftIO $ readProcessEnv "glacier" (toCommand params) (Just e) - let probablypresent = key2file k `elem` lines s + let probablypresent = serializeKey k `elem` lines s if probablypresent then ifM (Annex.getFlag "trustglacier") ( return True, giveup untrusted ) @@ -253,7 +253,7 @@ getVault = fromMaybe (giveup "Missing vault configuration") . M.lookup "vault" archive :: Remote -> Key -> Archive -archive r k = fileprefix ++ key2file k +archive r k = fileprefix ++ serializeKey k where fileprefix = M.findWithDefault "" "fileprefix" $ config r @@ -306,7 +306,7 @@ jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r) parse c [] = c parse c@(succeeded, failed) ((status:_date:vault:key:[]):rest) | vault == myvault = - case file2key key of + case deserializeKey key of Nothing -> parse c rest Just k | "a/d" `isPrefixOf` status -> diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 9c07a60382..47cf577218 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -98,7 +98,7 @@ onRemote cs r (with, errorval) command params fields = do inAnnex :: Git.Repo -> Key -> Annex Bool inAnnex r k = do showChecking r - onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ key2file k] [] + onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] [] where runcheck c p = dispatch =<< safeSystem c p dispatch ExitSuccess = return True @@ -109,7 +109,7 @@ inAnnex r k = do dropKey :: Git.Repo -> Key -> Annex Bool dropKey r key = onRemote NoConsumeStdin r (boolSystem, return False) "dropkey" [ Param "--quiet", Param "--force" - , Param $ key2file key + , Param $ serializeKey key ] [] @@ -141,7 +141,7 @@ rsyncParamsRemote unlocked r direction key file (AssociatedFile afile) = do repo <- getRepo r Just (shellcmd, shellparams) <- git_annex_shell ConsumeStdin repo (if direction == Download then "sendkey" else "recvkey") - [ Param $ key2file key ] + [ Param $ serializeKey key ] fields -- Convert the ssh command into rsync command line. let eparam = rsyncShell (Param shellcmd:shellparams) diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 565b5c038d..2194047582 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -92,7 +92,7 @@ hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv) mergeenv l = addEntries l <$> getEnvironment envvar s v = ("ANNEX_" ++ s, v) keyenv = catMaybes - [ Just $ envvar "KEY" (key2file k) + [ Just $ envvar "KEY" (serializeKey k) , Just $ envvar "ACTION" action , envvar "HASH_1" <$> headMaybe hashbits , envvar "HASH_2" <$> headMaybe (drop 1 hashbits) @@ -151,7 +151,7 @@ checkKey r h k = do liftIO $ check v where action = "checkpresent" - findkey s = key2file k `elem` lines s + findkey s = serializeKey k `elem` lines s check Nothing = giveup $ action ++ " hook misconfigured" check (Just hook) = do environ <- hookEnv action k Nothing diff --git a/Remote/S3.hs b/Remote/S3.hs index a3f2d330a2..2333afe22e 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -653,7 +653,7 @@ getFilePrefix :: RemoteConfig -> String getFilePrefix = M.findWithDefault "" "fileprefix" getBucketObject :: RemoteConfig -> Key -> BucketObject -getBucketObject c = munge . key2file +getBucketObject c = munge . serializeKey where munge s = case M.lookup "mungekeys" c of Just "ia" -> iaMunge $ getFilePrefix c ++ s diff --git a/Test.hs b/Test.hs index 7a730e75c1..555166e299 100644 --- a/Test.hs +++ b/Test.hs @@ -160,7 +160,6 @@ 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_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 , testProperty "prop_isomorphic_shellEscape_multiword" Utility.SafeCommand.prop_isomorphic_shellEscape_multiword , testProperty "prop_isomorphic_configEscape" Logs.Remote.prop_isomorphic_configEscape @@ -397,7 +396,7 @@ test_reinject = intmpclonerepoInDirect $ do git_annex "drop" ["--force", sha1annexedfile] @? "drop failed" annexed_notpresent sha1annexedfile writecontent tmp $ content sha1annexedfile - key <- Key.key2file <$> getKey backendSHA1 tmp + key <- Key.serializeKey <$> getKey backendSHA1 tmp git_annex "reinject" [tmp, sha1annexedfile] @? "reinject failed" annexed_present sha1annexedfile -- fromkey can't be used on a crippled filesystem, since it makes a @@ -867,9 +866,9 @@ test_unused = intmpclonerepoInDirect $ do checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile" -- good opportunity to test dropkey also - git_annex "dropkey" ["--force", Key.key2file annexedfilekey] + git_annex "dropkey" ["--force", Key.serializeKey annexedfilekey] @? "dropkey failed" - checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Key.key2file annexedfilekey) + checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Key.serializeKey annexedfilekey) git_annex_shouldfail "dropunused" ["1"] @? "dropunused failed to fail without --force" git_annex "dropunused" ["--force", "1"] @? "dropunused failed" @@ -1682,12 +1681,12 @@ test_crypto = do let encparams = (mempty :: Types.Remote.RemoteConfig, dummycfg) cipher <- Crypto.decryptCipher gpgcmd encparams cip files <- filterM doesFileExist $ - map ("dir" ) $ concatMap (key2files cipher) keys + map ("dir" ) $ concatMap (serializeKeys cipher) keys return (not $ null files) <&&> allM (checkFile mvariant) files checkFile mvariant filename = Utility.Gpg.checkEncryptionFile gpgcmd filename $ if mvariant == Just Types.Crypto.PubKey then ks else Nothing - key2files cipher = Annex.Locations.keyPaths . + serializeKeys cipher = Annex.Locations.keyPaths . Crypto.encryptKey Types.Crypto.HmacSha1 cipher #else test_crypto = putStrLn "gpg testing not implemented on Windows" diff --git a/Test/Framework.hs b/Test/Framework.hs index 8f1a664c68..410eb6713f 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -341,7 +341,7 @@ checklocationlog f expected = do case r of Just k -> do uuids <- annexeval $ Remote.keyLocations k - assertEqual ("bad content in location log for " ++ f ++ " key " ++ Key.key2file k ++ " uuid " ++ show thisuuid) + assertEqual ("bad content in location log for " ++ f ++ " key " ++ Key.serializeKey k ++ " uuid " ++ show thisuuid) expected (thisuuid `elem` uuids) _ -> assertFailure $ f ++ " failed to look up key" diff --git a/Types/ActionItem.hs b/Types/ActionItem.hs index 73d8451017..f8151018a6 100644 --- a/Types/ActionItem.hs +++ b/Types/ActionItem.hs @@ -36,8 +36,8 @@ instance MkActionItem (Transfer, TransferInfo) where actionItemDesc :: ActionItem -> Key -> String actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f))) _ = f -actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing)) k = key2file k -actionItemDesc ActionItemKey k = key2file k +actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing)) k = serializeKey k +actionItemDesc ActionItemKey k = serializeKey k actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp actionItemDesc (ActionItemFailedTransfer _ i) k = actionItemDesc (ActionItemAssociatedFile (associatedFile i)) k diff --git a/Types/Distribution.hs b/Types/Distribution.hs index d19074bf95..6ef3e766b9 100644 --- a/Types/Distribution.hs +++ b/Types/Distribution.hs @@ -46,7 +46,7 @@ parseInfoFile s = case lines s of formatGitAnnexDistribution :: GitAnnexDistribution -> String formatGitAnnexDistribution d = unlines [ distributionUrl d - , key2file (distributionKey d) + , serializeKey (distributionKey d) , distributionVersion d , show (distributionReleasedate d) , maybe "" show (distributionUrgentUpgrade d) @@ -56,7 +56,7 @@ parseGitAnnexDistribution :: String -> Maybe GitAnnexDistribution parseGitAnnexDistribution s = case lines s of (u:k:v:d:uu:_) -> GitAnnexDistribution <$> pure u - <*> file2key k + <*> deserializeKey k <*> pure v <*> readish d <*> pure (readish uu)