use global webapp redirects when shutting down

Assistant/WebApp/Control.hs

@@ -1,6 +1,6 @@
 {- git-annex assistant webapp control
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,15 +10,17 @@
 module Assistant.WebApp.Control where
 
 import Assistant.WebApp.Common
-import Utility.LogFile
 import Assistant.DaemonStatus
 import Assistant.Alert
 import Assistant.TransferSlots
 import Assistant.Restart
+import Utility.LogFile
+import Utility.NotificationBroadcaster
 
 import Control.Concurrent
 import System.Posix (getProcessID, signalProcess, sigTERM)
 import qualified Data.Map as M
+import qualified Data.Text as T
 
 getShutdownR :: Handler Html
 getShutdownR = page "Shutdown" Nothing $
@@ -37,12 +39,25 @@ getShutdownConfirmedR = do
 		ts <- M.keys . currentTransfers <$> getDaemonStatus
 		mapM_ pauseTransfer ts
 	page "Shutdown" Nothing $ do
+		webapp <- getYesod
+		let url = T.unpack $ yesodRender webapp (T.pack "") NotRunningR []
+		{- Signal any other web browsers. -}
+		liftAssistant $ do
+			modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url }
+			liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus
 		{- Wait 2 seconds before shutting down, to give the web
 		 - page time to load in the browser. -}
 		void $ liftIO $ forkIO $ do
 			threadDelay 2000000
 			signalProcess sigTERM =<< getProcessID
-		$(widgetFile "control/shutdownconfirmed")
+		redirect NotRunningR
+
+{- Use a custom page to avoid putting long polling elements on it that will 
+ - fail and cause the web browser to show an error once the webapp is
+ - truely stopped. -}
+getNotRunningR :: Handler Html
+getNotRunningR = customPage' False Nothing $
+	$(widgetFile "control/notrunning")
 
 getRestartR :: Handler Html
 getRestartR = do

Assistant/WebApp/Notifications.hs

@@ -28,7 +28,6 @@ import qualified Data.Text as T
 #ifndef WITH_OLD_YESOD
 import qualified Data.Aeson.Types as Aeson
 #endif
-import Control.Concurrent
 
 {- Add to any widget to make it auto-update using long polling.
  -
@@ -51,7 +50,6 @@ autoUpdate tident geturl ms_delay ms_startdelay = do
 	let startdelay = Aeson.String (T.pack (show ms_startdelay))
 	let ident = Aeson.String tident
 #endif
-	addScript $ StaticR longpolling_js
 	$(widgetFile "notifications/longpolling")
 
 {- Notifier urls are requested by the javascript, to avoid allocation
@@ -103,14 +101,6 @@ getGlobalRedirBroadcaster =  globalRedirNotifier <$> getDaemonStatus
 
 getGlobalRedirR :: NotificationId -> Handler Text
 getGlobalRedirR nid = do
-	tid <- liftIO myThreadId
-	liftIO $ do
-		hPutStrLn stderr $ show ("getGlobalRedirR waiting", tid)
-		hFlush stderr
 	waitNotifier getGlobalRedirBroadcaster nid
-	v <- globalRedirUrl <$> liftAssistant getDaemonStatus
-	liftIO $ do
-		hPutStrLn stderr $ show ("getGlobalRedirR got a val", v, tid)
-		hFlush stderr
 	maybe (getGlobalRedirR nid) (return . T.pack)
 		=<< globalRedirUrl <$> liftAssistant getDaemonStatus

Assistant/WebApp/Page.hs

@@ -50,7 +50,10 @@ page title navbaritem content = customPage navbaritem $ do
 
 {- A custom page, with no title or sidebar set. -}
 customPage :: Maybe NavBarItem -> Widget -> Handler Html
-customPage navbaritem content = do
+customPage = customPage' True
+
+customPage' :: Bool -> Maybe NavBarItem -> Widget -> Handler Html
+customPage' with_longpolling navbaritem content = do
 	webapp <- getYesod
 	case cannotRun webapp of
 		Nothing -> do
@@ -62,6 +65,8 @@ customPage navbaritem content = do
 				addScript $ StaticR js_bootstrap_dropdown_js
 				addScript $ StaticR js_bootstrap_modal_js
 				addScript $ StaticR js_bootstrap_collapse_js
+				when with_longpolling $
+					addScript $ StaticR longpolling_js
 				$(widgetFile "page")
 			giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap")
 		Just msg -> error msg

Assistant/WebApp/routes

@@ -9,6 +9,7 @@
 
 /shutdown ShutdownR GET
 /shutdown/confirm ShutdownConfirmedR GET
+/shutdown/complete NotRunningR GET
 /restart RestartR GET
 /restart/thread/#ThreadName RestartThreadR GET
 /log LogR GET

templates/control/notrunning.hamlet

@@ -0,0 +1,10 @@
+<div .span9 .hero-unit>
+  <p>
+    Bye bye!
+<div .modal .fade #shutdownmodal>
+  <div .modal-header>
+    <h3>
+      git-annex has shut down
+  <div .modal-body>
+    <p>
+      You can now close this browser window.

templates/control/notrunning.julius

@@ -0,0 +1,3 @@
+$(function() {
+	$('#shutdownmodal').modal('show');
+});

templates/control/shutdownconfirmed.hamlet

@@ -1,2 +0,0 @@
-<div .span9 .hero-unit>
-  Shutting down...