queue and start download of git-annex from web, using git-annex, when upgrade is started

Assistant/Threads/TransferWatcher.hs

@@ -16,6 +16,7 @@ import Utility.DirWatcher.Types
 import qualified Remote
 
 import Control.Concurrent
+import qualified Data.Map as M
 
 {- This thread watches for changes to the gitAnnexTransferDir,
  - and updates the DaemonStatus's map of ongoing transfers. -}
@@ -89,6 +90,11 @@ onDel file = case parseTransferFile file of
 		debug [ "transfer finishing:", show t]
 		minfo <- removeTransfer t
 
+		-- Run transfer hook.
+		void $ maybe noop (\hook -> void $ forkIO $ hook t)
+			. M.lookup (transferKey t)
+			. transferHook <$> getDaemonStatus
+
 		finished <- asIO2 finishedTransfer
 		void $ liftIO $ forkIO $ do
 			{- XXX race workaround delay. The location

Assistant/Types/DaemonStatus.hs

@@ -73,6 +73,8 @@ data DaemonStatus = DaemonStatus
 	-- Broadcasts notifications when a global redirect is needed.
 	, globalRedirNotifier :: NotificationBroadcaster
 	, globalRedirUrl :: Maybe URLString
+	-- Actions to run after a Key is transferred.
+	, transferHook :: M.Map Key (Transfer -> IO ())
 	-- When the XMPP client is connected, this will contain the XMPP
 	-- address.
 	, xmppClientID :: Maybe ClientID
@@ -112,5 +114,6 @@ newDaemonStatus = DaemonStatus
 	<*> newNotificationBroadcaster
 	<*> newNotificationBroadcaster
 	<*> pure Nothing
+	<*> pure M.empty
 	<*> pure Nothing
 	<*> pure M.empty

Assistant/WebApp/Configurators/Upgrade.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
+{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
 
 module Assistant.WebApp.Configurators.Upgrade where
 
@@ -13,17 +13,50 @@ import Assistant.WebApp.Common
 import Types.Distribution
 import Assistant.Upgrade
 import Assistant.Restart
-import Utility.HumanTime
+import Assistant.DaemonStatus
 import Config
+import Assistant.TransferQueue
+import Assistant.TransferSlots
+import Logs.Transfer
+import Logs.Web
+import Remote
 
-import Data.Time.Clock
+import qualified Data.Map as M
 
+{- On Android, just redirect the user's web browser to the apk file
+ - to download it.
+ -
+ - Otherwise, register a hook action that will be called once the key
+ - is downloaded, and start downloading the key.
+ - -}
 getConfigStartUpgradeR :: GitAnnexDistribution -> Handler Html
-getConfigStartUpgradeR d = page "Upgrade git-annex" (Just Configuration) $ do
+getConfigStartUpgradeR d = do
-	now <- liftIO getCurrentTime
+#ifdef __ANDROID__
-	let upgradeage = Duration $ floor $
+	redirect (distributionUrl d)
-		now `diffUTCTime` distributionReleasedate d
+#else
-	$(widgetFile "configurators/upgrade/start")
+	liftAssistant $ do
+		let k = distributionKey d
+		let u = distributionUrl d
+		liftAnnex $ setUrlPresent k u
+		hook <- asIO1 $ downloadComplete d
+		modifyDaemonStatus_ $ \status -> status
+			{ transferHook = M.insert k hook (transferHook status) }
+		let t = Transfer
+			{ transferDirection = Download
+			, transferUUID = webUUID
+			, transferKey = k
+			}
+		let f = takeFileName u ++ " (for upgrade)"
+		maybe noop (queueTransfer "upgrade" Next (Just f) t)
+			=<< liftAnnex (remoteFromUUID webUUID)
+		startTransfer t
+	redirect DashboardR
+#endif
+
+downloadComplete :: GitAnnexDistribution -> Transfer -> Assistant ()
+downloadComplete d t = do
+	error "TODO"
+	liftAnnex $ setUrlMissing (distributionKey d) (distributionUrl d)
 
 {- Finish upgrade by starting the new assistant in the same repository this
  - one is running in, and redirecting to it. -}

templates/configurators/upgrade/start.hamlet

@@ -1,12 +0,0 @@
-<div .span9 .hero-unit>
-  <h2>
-    Upgrade git-annex
-  <p>
-    Version #{distributionVersion d} was released #
-    #{fromDuration upgradeage} ago.
-  <p>
-    To upgrade to this version, you will need to manually download and #
-    install it. (Sorry, upgrades are not automated yet..)
-  <p>
-    <a .btn .btn-primary href="#{distributionUrl d}">
-      Download