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
				
			
		| 
						 | 
				
			
			@ -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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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) ++ ")"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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)
 | 
			
		||||
	}
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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"
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										72
									
								
								Key.hs
									
										
									
									
									
								
							
							
						
						
									
										72
									
								
								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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										2
									
								
								Logs.hs
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 $ 
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ':'
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ->
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										11
									
								
								Test.hs
									
										
									
									
									
								
							
							
						
						
									
										11
									
								
								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"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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"
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue