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:
parent
d24f7f94fe
commit
183f7355cd
11 changed files with 148 additions and 82 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue