upgrade alerts

The webapp will check twice a day, when the network is connected, to see if
it can download a distributon upgrade file. If a newer version is found,
display an upgrade alert.

This will need the autobuilders to set UPGRADE_LOCATION to the url
it can be downloaded from when building git-annex. Only builds with that
set need automatic upgrade alerts.

Currently, the upgrade page just requests the user manually download
and upgrade it. But, all the info is provided to do automated upgrades
in the future.

Note that urls used will need to all be https.

This commit was sponsored by Dirk Kraft.

Assistant/WebApp/Configurators/Upgrade.hs

@@ -0,0 +1,24 @@
+{- git-annex assistant webapp upgrade UI
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
+
+module Assistant.WebApp.Configurators.Upgrade where
+
+import Assistant.WebApp.Common
+import Types.Distribution
+import Utility.HumanTime
+
+import Data.Time.Clock
+
+getConfigUpgradeR :: GitAnnexDistribution -> Handler Html
+getConfigUpgradeR d = page "Upgrade git-annex" (Just Configuration) $ do
+	now <- liftIO getCurrentTime
+	let upgradeage = Duration $ floor $
+		now `diffUTCTime` distributionReleasedate d
+	$(widgetFile "configurators/upgrade")
+

Assistant/WebApp/SideBar.hs

@@ -97,6 +97,7 @@ htmlIcon SyncIcon = [whamlet|<img src="@{StaticR syncicon_gif}" alt="">|]
 htmlIcon InfoIcon = bootstrapIcon "info-sign"
 htmlIcon SuccessIcon = bootstrapIcon "ok"
 htmlIcon ErrorIcon = bootstrapIcon "exclamation-sign"
+htmlIcon UpgradeIcon = bootstrapIcon "arrow-up"
 -- utf-8 umbrella (utf-8 cloud looks too stormy)
 htmlIcon TheCloud = [whamlet|&#9730;|]
 

Assistant/WebApp/Types.hs

@@ -25,6 +25,7 @@ import Utility.Gpg (KeyId)
 import Build.SysConfig (packageversion)
 import Types.ScheduledActivity
 import Assistant.WebApp.RepoId
+import Types.Distribution
 
 import Yesod.Static
 import Text.Hamlet
@@ -222,3 +223,7 @@ instance PathPiece ScheduledActivity where
 instance PathPiece RepoId where
 	toPathPiece = pack . show
 	fromPathPiece = readish . unpack
+
+instance PathPiece GitAnnexDistribution where
+	toPathPiece = pack . show
+	fromPathPiece = readish . unpack

Assistant/WebApp/routes

@@ -21,6 +21,7 @@
 /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET
 /config/fsck ConfigFsckR GET POST
 /config/fsck/preferences ConfigFsckPreferencesR POST
+/config/upgrade/#GitAnnexDistribution ConfigUpgradeR GET
 
 /config/addrepository AddRepositoryR GET
 /config/repository/new NewRepositoryR GET POST