From b873f05ca7e86344a28d269d682b7ffd8a88baca Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 10 Jul 2014 17:06:04 -0400
Subject: migrate: Avoid re-checksumming when migrating from hashE to hash
 backend.

---
 Backend/Hash.hs            | 10 ++++++++++
 Backend/URL.hs             |  1 +
 Backend/WORM.hs            |  1 +
 Command/Migrate.hs         | 30 ++++++++++++++++++------------
 Types/Backend.hs           |  1 +
 debian/changelog           |  1 +
 doc/todo/fast_migrate.mdwn |  2 ++
 7 files changed, 34 insertions(+), 12 deletions(-)

diff --git a/Backend/Hash.hs b/Backend/Hash.hs
index 41368a5bb..3ff496271 100644
--- a/Backend/Hash.hs
+++ b/Backend/Hash.hs
@@ -44,6 +44,7 @@ genBackend hash = Just Backend
 	, getKey = keyValue hash
 	, fsckKey = Just $ checkKeyChecksum hash
 	, canUpgradeKey = Just needsUpgrade
+	, fastMigrate = Just trivialMigrate
 	}
 
 genBackendE :: Hash -> Maybe Backend
@@ -129,6 +130,15 @@ needsUpgrade :: Key -> Bool
 needsUpgrade key = "\\" `isPrefixOf` keyHash key ||
 	any (not . validExtension) (takeExtensions $ keyName key)
 
+{- Fast migration from hashE to hash backend. (Optimisation) -}
+trivialMigrate :: Key -> Backend -> Maybe Key
+trivialMigrate oldkey newbackend
+	| keyBackendName oldkey == name newbackend ++ "E" = Just $ oldkey
+		{ keyName = keyHash oldkey
+		, keyBackendName = name newbackend
+		}
+	| otherwise = Nothing
+
 hashFile :: Hash -> FilePath -> Integer -> Annex String
 hashFile hash file filesize = liftIO $ go hash
   where
diff --git a/Backend/URL.hs b/Backend/URL.hs
index a8161c98d..4233c56bc 100644
--- a/Backend/URL.hs
+++ b/Backend/URL.hs
@@ -24,6 +24,7 @@ backend = Backend
 	, getKey = const $ return Nothing
 	, fsckKey = Nothing
 	, canUpgradeKey = Nothing
+	, fastMigrate = Nothing
 	}
 
 {- Every unique url has a corresponding key. -}
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index 60db42f56..cc7123850 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -22,6 +22,7 @@ backend = Backend
 	, getKey = keyValue
 	, fsckKey = Nothing
 	, canUpgradeKey = Nothing
+	, fastMigrate = Nothing
 	}
 
 {- The key includes the file size, modification time, and the
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index 18e6e0748..cea9e9426 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -11,7 +11,7 @@ import Common.Annex
 import Command
 import Backend
 import qualified Types.Key
-import qualified Types.Backend
+import Types.Backend (canUpgradeKey, fastMigrate)
 import Types.KeySource
 import Annex.Content
 import qualified Command.ReKey
@@ -51,8 +51,7 @@ start file key = do
 upgradableKey :: Backend -> Key -> Bool
 upgradableKey backend key = isNothing (Types.Key.keySize key) || backendupgradable
   where
-	backendupgradable = maybe False (\a -> a key)
-		(Types.Backend.canUpgradeKey backend)
+	backendupgradable = maybe False (\a -> a key) (canUpgradeKey backend)
 
 {- Store the old backend's key in the new backend
  - The old backend's key is not dropped from it, because there may
@@ -67,15 +66,22 @@ perform :: FilePath -> Key -> Backend -> Backend -> CommandPerform
 perform file oldkey oldbackend newbackend = go =<< genkey
   where
   	go Nothing = stop
-	go (Just newkey) = stopUnless checkcontent $ finish newkey
+	go (Just (newkey, knowngoodcontent))
+		| knowngoodcontent = finish newkey
+		| otherwise = stopUnless checkcontent $ finish newkey
 	checkcontent = Command.Fsck.checkBackend oldbackend oldkey $ Just file
 	finish newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
 		next $ Command.ReKey.cleanup file oldkey newkey
-	genkey = do
-		content <- calcRepo $ gitAnnexLocation oldkey
-		let source = KeySource
-			{ keyFilename = file
-			, contentLocation = content
-			, inodeCache = Nothing
-			}
-		liftM fst <$> genKey source (Just newbackend)
+	genkey = case maybe Nothing (\fm -> fm oldkey newbackend) (fastMigrate oldbackend) of
+		Just newkey -> return $ Just (newkey, True)
+		Nothing -> do
+			content <- calcRepo $ gitAnnexLocation oldkey
+			let source = KeySource
+				{ keyFilename = file
+				, contentLocation = content
+				, inodeCache = Nothing
+				}
+			v <- genKey source (Just newbackend)
+			return $ case v of
+				Just (newkey, _) -> Just (newkey, False)
+				_ -> Nothing
diff --git a/Types/Backend.hs b/Types/Backend.hs
index c7d962db0..7eb59b6e2 100644
--- a/Types/Backend.hs
+++ b/Types/Backend.hs
@@ -17,6 +17,7 @@ data BackendA a = Backend
 	, getKey :: KeySource -> a (Maybe Key) 
 	, fsckKey :: Maybe (Key -> FilePath -> a Bool)
 	, canUpgradeKey :: Maybe (Key -> Bool)
+	, fastMigrate :: Maybe (Key -> BackendA a -> Maybe Key)
 	}
 
 instance Show (BackendA a) where
diff --git a/debian/changelog b/debian/changelog
index 250f71973..087e3cdfc 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,7 @@ git-annex (5.20140710) UNRELEASED; urgency=medium
   * Fix minor FD leak in journal code.
   * direct: Fix handling of case where a work tree subdirectory cannot
     be written to due to permissions.
+  * migrate: Avoid re-checksumming when migrating from hashE to hash backend.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 09 Jul 2014 23:29:21 -0400
 
diff --git a/doc/todo/fast_migrate.mdwn b/doc/todo/fast_migrate.mdwn
index 560e0e2c7..1571d880a 100644
--- a/doc/todo/fast_migrate.mdwn
+++ b/doc/todo/fast_migrate.mdwn
@@ -12,3 +12,5 @@ dear Joey and everybody else,
 
 > Certianly doable, for $hashE to $hash. Probably about an hour's work.
 > --[[Joey]]
+
+>> [[done]] --[[Joey]]
-- 
cgit v1.2.3