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.
This commit is contained in:
parent
ff0a2bee2d
commit
d3ab5e626b
40 changed files with 97 additions and 108 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -126,5 +126,5 @@ instance TCSerialized RemoteName where
|
|||
deserialize n = Just n
|
||||
|
||||
instance TCSerialized Key where
|
||||
serialize = key2file
|
||||
deserialize = file2key
|
||||
serialize = serializeKey
|
||||
deserialize = deserializeKey
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue