global webapp redirects, to finish upgrades

When an automatic upgrade completes, or when the user clicks on the upgrade
button in one webapp, but also has it open in another browser window/tab,
we have a problem: The current web server is going to stop running in
minutes, but there is no way to send a redirect to the web browser to the
new url.

To solve this, used long polling, so the webapp is always listening for
urls it should redirect to. This allows globally redirecting every open
webapp. Works great! Tested with 2 web browsers with 2 tabs each.
May be useful for other purposes later too, dunno.

The overhead is 2 http requests per page load in the webapp. Due to yesod's
speed, this does not seem to noticibly delay it. Only 1 of the requests
could possibly block the page load, the other is async.
This commit is contained in:
Joey Hess 2013-11-23 14:47:38 -04:00
parent d24f7f94fe
commit 183f7355cd
11 changed files with 148 additions and 82 deletions

View file

@ -28,6 +28,7 @@ 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.
-
@ -82,6 +83,9 @@ getNotifierRepoListR reposelector = notifierUrl route getRepoListBroadcaster
where
route nid = RepoListR nid reposelector
getNotifierGlobalRedirR :: Handler RepPlain
getNotifierGlobalRedirR = notifierUrl GlobalRedirR getGlobalRedirBroadcaster
getTransferBroadcaster :: Assistant NotificationBroadcaster
getTransferBroadcaster = transferNotifier <$> getDaemonStatus
@ -93,3 +97,20 @@ getBuddyListBroadcaster = getBuddyBroadcaster <$> getAssistant buddyList
getRepoListBroadcaster :: Assistant NotificationBroadcaster
getRepoListBroadcaster = syncRemotesNotifier <$> getDaemonStatus
getGlobalRedirBroadcaster :: Assistant NotificationBroadcaster
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