fix up Read instance incompatability caused by recent commit

2f868db90c7ba16eee901b9b1472b1e1a889dd93 changed the Read instance for
Key.

I've checked all uses of that instance (by removing it and seeing what
breaks), and they're all limited to the webapp, except one.
That is GitAnnexDistribution's Read instance.

So, 2f868db90c7ba16eee901b9b1472b1e1a889dd93 would have broken upgrades
of git-annex from downloads.kitenet.net. Once the .info files there got
updated for a new release, old releases would have failed to parse them
and never upgraded.

To fix this, I found a way to make the .info files that contain
GitAnnexDistribution values be readable by the old version of git-annex.

This commit was sponsored by Ewen McNeill.

6 files changed, 59 insertions, 21 deletions

diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs
index f91fde06c..a2f6f9e0a 100644
--- a/Assistant/Upgrade.hs
+++ b/Assistant/Upgrade.hs
@@ -324,7 +324,7 @@ downloadDistributionInfo = do
 		ifM (Url.downloadQuiet distributionInfoUrl infof uo
 			<&&> Url.downloadQuiet distributionInfoSigUrl sigf uo
 			<&&> verifyDistributionSig gpgcmd sigf)
-			( readish <$> readFileStrict infof
+			( parseInfoFile <$> readFileStrict infof
 			, return Nothing
 			)
 
diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs
index dd18a7883..e026d655b 100644
--- a/Build/DistributionUpdate.hs
+++ b/Build/DistributionUpdate.hs
@@ -119,13 +119,14 @@ makeinfos updated version = do
 			Just k -> whenM (inAnnex k) $ do
 				liftIO $ putStrLn f
 				let infofile = f ++ ".info"
-				liftIO $ writeFile infofile $ show $ GitAnnexDistribution
+				let d = GitAnnexDistribution
 					{ distributionUrl = mkUrl f
 					, distributionKey = k
 					, distributionVersion = bv
 					, distributionReleasedate = now
 					, distributionUrgentUpgrade = Nothing
 					}
+				liftIO $ writeFile infofile $ formatInfoFile d
 				void $ inRepo $ runBool [Param "add", File infofile]
 				signFile infofile
 				signFile f
diff --git a/Command/Info.hs b/Command/Info.hs
index 835a8498d..aaee08fe1 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -419,14 +419,14 @@ transfer_list = stat desc $ nojson $ lift $ do
   where
 	desc = "transfers in progress"
 	line uuidmap t i = unwords
-		[ showLcDirection (transferDirection t) ++ "ing"
+		[ formatDirection (transferDirection t) ++ "ing"
 		, fromMaybe (key2file $ transferKey t) (associatedFile i)
 		, if transferDirection t == Upload then "to" else "from"
 		, maybe (fromUUID $ transferUUID t) Remote.name $
 			M.lookup (transferUUID t) uuidmap
 		]
 	jsonify t i = object $ map (\(k, v) -> (T.pack k, v)) $
-		[ ("transfer", toJSON (showLcDirection (transferDirection t)))
+		[ ("transfer", toJSON (formatDirection (transferDirection t)))
 		, ("key", toJSON (key2file (transferKey t)))
 		, ("file", toJSON (associatedFile i))
 		, ("remote", toJSON (fromUUID (transferUUID t)))
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 903db96fe..ce2a7d299 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -23,15 +23,6 @@ import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Control.Concurrent
 
-showLcDirection :: Direction -> String
-showLcDirection Upload = "upload"
-showLcDirection Download = "download"
-
-readLcDirection :: String -> Maybe Direction
-readLcDirection "upload" = Just Upload
-readLcDirection "download" = Just Download
-readLcDirection _ = Nothing
-
 describeTransfer :: Transfer -> TransferInfo -> String
 describeTransfer t info = unwords
 	[ show $ transferDirection t
@@ -212,7 +203,7 @@ parseTransferFile file
 	| "lck." `isPrefixOf` takeFileName file = Nothing
 	| otherwise = case drop (length bits - 3) bits of
 		[direction, u, key] -> Transfer
-			<$> readLcDirection direction
+			<$> parseDirection direction
 			<*> pure (toUUID u)
 			<*> fileKey key
 		_ -> Nothing
@@ -279,14 +270,14 @@ readTransferInfo mpid s = TransferInfo
 
 {- The directory holding transfer information files for a given Direction. -}
 transferDir :: Direction -> Git.Repo -> FilePath
-transferDir direction r = gitAnnexTransferDir r </> showLcDirection direction
+transferDir direction r = gitAnnexTransferDir r </> formatDirection direction
 
 {- The directory holding failed transfer information files for a given
  - Direction and UUID -}
 failedTransferDir :: UUID -> Direction -> Git.Repo -> FilePath
 failedTransferDir u direction r = gitAnnexTransferDir r
 	</> "failed"
-	</> showLcDirection direction
+	</> formatDirection direction
 	</> filter (/= '/') (fromUUID u)
 
 prop_read_write_transferinfo :: TransferInfo -> Bool
diff --git a/Types/Distribution.hs b/Types/Distribution.hs
index d4de7a79b..a7e2f4c95 100644
--- a/Types/Distribution.hs
+++ b/Types/Distribution.hs
@@ -1,16 +1,22 @@
 {- Data type for a distribution of git-annex
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013, 2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Types.Distribution where
 
+import Utility.PartialPrelude
 import Types.Key
+import Key
 import Data.Time.Clock
 import Git.Config (isTrue, boolConfig)
 
+import Data.String.Utils
+
+type GitAnnexVersion = String
+
 data GitAnnexDistribution = GitAnnexDistribution
 	{ distributionUrl :: String
 	, distributionKey :: Key
@@ -20,7 +26,39 @@ data GitAnnexDistribution = GitAnnexDistribution
 	}
 	deriving (Read, Show, Eq)
 
-type GitAnnexVersion = String
+{- The first line of the info file is in the format old versions of
+ - git-annex expect to read a GitAnnexDistribution.
+ - The remainder of the file is in the new format.
+ - This works because old versions of git-annex used readish to parse
+ - the file, and that ignores the second line.
+ -}
+formatInfoFile :: GitAnnexDistribution -> String
+formatInfoFile d = replace "keyVariant = " "keyBackendName = " (show d) ++
+	"\n" ++ formatGitAnnexDistribution d
+
+parseInfoFile :: String -> Maybe GitAnnexDistribution
+parseInfoFile s = case lines s of
+	(_oldformat:rest) -> parseGitAnnexDistribution (unlines rest)
+	_ -> Nothing
+
+formatGitAnnexDistribution :: GitAnnexDistribution -> String
+formatGitAnnexDistribution d = unlines
+	[ distributionUrl d
+	, key2file (distributionKey d)
+	, distributionVersion d
+	, show (distributionReleasedate d)
+	, maybe "" show (distributionUrgentUpgrade d)
+	]
+
+parseGitAnnexDistribution :: String -> Maybe GitAnnexDistribution
+parseGitAnnexDistribution s = case lines s of
+	(u:k:v:d:uu:_) -> GitAnnexDistribution
+		<$> pure u
+		<*> file2key k
+		<*> pure v
+		<*> readish d
+		<*> pure (readish uu)
+	_ -> Nothing
 
 data AutoUpgrade = AskUpgrade | AutoUpgrade | NoAutoUpgrade
 	deriving (Eq)
diff --git a/Types/Transfer.hs b/Types/Transfer.hs
index 1920bc73b..349eccf4b 100644
--- a/Types/Transfer.hs
+++ b/Types/Transfer.hs
@@ -16,8 +16,7 @@ import Control.Concurrent
 import Control.Applicative
 import Prelude
 
-{- Enough information to uniquely identify a transfer, used as the filename
- - of the transfer information file. -}
+{- Enough information to uniquely identify a transfer. -}
 data Transfer = Transfer
 	{ transferDirection :: Direction
 	, transferUUID :: UUID
@@ -46,7 +45,16 @@ stubTransferInfo :: TransferInfo
 stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False
 
 data Direction = Upload | Download
-	deriving (Eq, Ord, Read, Show)
+	deriving (Eq, Ord, Show, Read)
+
+formatDirection :: Direction -> String
+formatDirection Upload = "upload"
+formatDirection Download = "download"
+
+parseDirection :: String -> Maybe Direction
+parseDirection "upload" = Just Upload
+parseDirection "download" = Just Download
+parseDirection _ = Nothing
 
 instance Arbitrary TransferInfo where
 	arbitrary = TransferInfo