separate source of content from the filename associated with the key when generating a key

This already made migrate's code a lot simpler.

Backend.hs

@@ -6,6 +6,7 @@
  -}
 
 module Backend (
+	B.KeySource(..),
 	list,
 	orderedList,
 	genKey,
@@ -51,18 +52,19 @@ orderedList = do
 		parseBackendList s = map lookupBackendName $ words s
 
 {- Generates a key for a file, trying each backend in turn until one
- - accepts it. -}
+ - accepts it.
-genKey :: FilePath -> Maybe Backend -> Annex (Maybe (Key, Backend))
+ -}
-genKey file trybackend = do
+genKey :: B.KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend))
+genKey source trybackend = do
 	bs <- orderedList
 	let bs' = maybe bs (: bs) trybackend
-	genKey' bs' file
+	genKey' bs' source
-genKey' :: [Backend] -> FilePath -> Annex (Maybe (Key, Backend))
+genKey' :: [Backend] -> B.KeySource -> Annex (Maybe (Key, Backend))
 genKey' [] _ = return Nothing
-genKey' (b:bs) file = do
+genKey' (b:bs) source = do
-	r <- B.getKey b file
+	r <- B.getKey b source
 	case r of
-		Nothing -> genKey' bs file
+		Nothing -> genKey' bs source
 		Just k -> return $ Just (makesane k, b)
 	where
 		-- keyNames should not contain newline characters.

Backend/SHA.hs

@@ -69,8 +69,9 @@ shaN size file = do
 		command = fromJust $ shaCommand size
 
 {- A key is a checksum of its contents. -}
-keyValue :: SHASize -> FilePath -> Annex (Maybe Key)
+keyValue :: SHASize -> KeySource -> Annex (Maybe Key)
-keyValue size file = do
+keyValue size source = do
+	let file = contentLocation source
 	s <- shaN size file
 	stat <- liftIO $ getFileStatus file
 	return $ Just $ stubKey
@@ -80,14 +81,14 @@ keyValue size file = do
 		}
 
 {- Extension preserving keys. -}
-keyValueE :: SHASize -> FilePath -> Annex (Maybe Key)
+keyValueE :: SHASize -> KeySource -> Annex (Maybe Key)
-keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
+keyValueE size source = keyValue size source >>= maybe (return Nothing) addE
 	where
 		addE k = return $ Just $ k
 			{ keyName = keyName k ++ extension
 			, keyBackendName = shaNameE size
 			}
-		naiveextension = takeExtension file
+		naiveextension = takeExtension $ keyFilename source
 		extension
 			-- long or newline containing extensions are 
 			-- probably not really an extension

Backend/URL.hs

@@ -20,11 +20,11 @@ backends :: [Backend]
 backends = [backend]
 
 backend :: Backend
-backend = Backend {
+backend = Backend
-	name = "URL",
+	{ name = "URL"
-	getKey = const (return Nothing),
+	, getKey = const $ return Nothing
-	fsckKey = Nothing
+	, fsckKey = Nothing
-}
+	}
 
 fromUrl :: String -> Maybe Integer -> Key
 fromUrl url size = stubKey

Backend/WORM.hs

@@ -15,11 +15,11 @@ backends :: [Backend]
 backends = [backend]
 
 backend :: Backend
-backend = Backend {
+backend = Backend
-	name = "WORM",
+	{ name = "WORM"
-	getKey = keyValue,
+	, getKey = keyValue
-	fsckKey = Nothing
+	, fsckKey = Nothing
-}
+	}
 
 {- The key includes the file size, modification time, and the
  - basename of the filename.
@@ -28,11 +28,11 @@ backend = Backend {
  - while also allowing a file to be moved around while retaining the
  - same key.
  -}
-keyValue :: FilePath -> Annex (Maybe Key)
+keyValue :: KeySource -> Annex (Maybe Key)
-keyValue file = do
+keyValue source = do
-	stat <- liftIO $ getFileStatus file
+	stat <- liftIO $ getFileStatus $ contentLocation source
 	return $ Just Key {
-		keyName = takeFileName file,
+		keyName = takeFileName $ keyFilename source,
 		keyBackendName = name backend,
 		keySize = Just $ fromIntegral $ fileSize stat,
 		keyMtime = Just $ modificationTime stat

Command/Add.hs

@@ -12,7 +12,7 @@ import Annex.Exception
 import Command
 import qualified Annex
 import qualified Annex.Queue
-import qualified Backend
+import Backend
 import Logs.Location
 import Annex.Content
 import Utility.Touch
@@ -46,8 +46,9 @@ start file = notBareRepo $ ifAnnexed file fixup add
 
 perform :: FilePath -> CommandPerform
 perform file = do
-	backend <- Backend.chooseBackend file
+	let source = KeySource { keyFilename = file, contentLocation = file}
-	Backend.genKey file backend >>= go
+	backend <- chooseBackend file
+	genKey source backend >>= go
 	where
 		go Nothing = stop
 		go (Just (key, _)) = do

Command/AddUrl.hs

@@ -11,7 +11,7 @@ import Network.URI
 
 import Common.Annex
 import Command
-import qualified Backend
+import Backend
 import qualified Command.Add
 import qualified Annex
 import qualified Backend.URL
@@ -72,8 +72,9 @@ download url file = do
 	tmp <- fromRepo $ gitAnnexTmpLocation dummykey
 	liftIO $ createDirectoryIfMissing True (parentDir tmp)
 	stopUnless (downloadUrl [url] tmp) $ do
-		backend <- Backend.chooseBackend file
+		backend <- chooseBackend file
-		k <- Backend.genKey tmp backend
+		let source = KeySource { keyFilename = file, contentLocation = file}
+		k <- genKey source backend
 		case k of
 			Nothing -> stop
 			Just (key, _) -> do

Command/Migrate.hs

@@ -9,7 +9,7 @@ module Command.Migrate where
 
 import Common.Annex
 import Command
-import qualified Backend
+import Backend
 import qualified Types.Key
 import Annex.Content
 import qualified Command.ReKey
@@ -23,14 +23,14 @@ seek = [withFilesInGit $ whenAnnexed start]
 start :: FilePath -> (Key, Backend) -> CommandStart
 start file (key, oldbackend) = do
 	exists <- inAnnex key
-	newbackend <- choosebackend =<< Backend.chooseBackend file
+	newbackend <- choosebackend =<< chooseBackend file
 	if (newbackend /= oldbackend || upgradableKey key) && exists
 		then do
 			showStart "migrate" file
 			next $ perform file key newbackend
 		else stop
 	where
-		choosebackend Nothing = Prelude.head <$> Backend.orderedList
+		choosebackend Nothing = Prelude.head <$> orderedList
 		choosebackend (Just backend) = return backend
 
 {- Checks if a key is upgradable to a newer representation. -}
@@ -40,25 +40,13 @@ upgradableKey key = isNothing $ Types.Key.keySize key
 
 {- Store the old backend's key in the new backend
  - The old backend's key is not dropped from it, because there may
- - be other files still pointing at that key.
+ - be other files still pointing at that key. -}
- -
- - Use the same filename as the file for the temp file name, to support
- - backends that allow the filename to influence the keys they
- - generate.
- -}
 perform :: FilePath -> Key -> Backend -> CommandPerform
 perform file oldkey newbackend = maybe stop go =<< genkey
 	where
 		go newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
 			next $ Command.ReKey.cleanup file oldkey newkey
 		genkey = do
-			src <- inRepo $ gitAnnexLocation oldkey
+			content <- inRepo $ gitAnnexLocation oldkey
-			tmp <- fromRepo gitAnnexTmpDir
+			let source = KeySource { keyFilename = file, contentLocation = content }
-			let tmpfile = tmp </> takeFileName file
+			liftM fst <$> genKey source (Just newbackend)
-			cleantmp tmpfile
-			liftIO $ createLink src tmpfile
-			newkey <- liftM fst <$>
-				Backend.genKey tmpfile (Just newbackend)
-			cleantmp tmpfile
-			return newkey
-		cleantmp t = liftIO $ whenM (doesFileExist t) $ removeFile t

Types/Backend.hs

@@ -2,7 +2,7 @@
  -
  - Most things should not need this, using Types instead
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,11 +11,18 @@ module Types.Backend where
 
 import Types.Key
 
+{- The source used to generate a key. The location of the content
+ - may be different from the filename associated with the key. -}
+data KeySource = KeySource
+	{ keyFilename :: FilePath
+	, contentLocation :: FilePath
+	}
+
 data BackendA a = Backend {
 	-- name of this backend
 	name :: String,
-	-- converts a filename to a key
+	-- gets the key to use for a given content
-	getKey :: FilePath -> a (Maybe Key),
+	getKey :: KeySource -> a (Maybe Key),
 	-- called during fsck to check a key, if the backend has its own checks
 	fsckKey :: Maybe (Key -> FilePath -> a Bool)
 }

doc/design/assistant/inotify.mdwn

@@ -61,7 +61,9 @@ Many races need to be dealt with by this code. Here are some of them.
   **Currently unfixed**; The new content will be moved to the annex under the
   old checksum, and fsck will later catch this inconsistency.
 
-  Possible fix: Move content someplace before doing checksumming.
+  Possible fix: Move content someplace before doing checksumming. Perhaps
+  using a hard link and removing the write bit to prevent modification 
+  while checksumming.
 
 * File is added and then replaced with another file before the annex add
   makes its symlink.