cb3c9340f8
This means that anyone serving up the webapp to users as a service (ie, without providing any git-annex binary at all to the user) still needs to provide a link to the source code for it, including any modifications they may make. This may make git-annex be covered by the AGPL as a whole when it is built with the webapp. If in doubt, you should ask a lawyer. When git-annex is built with the webapp disabled, no AGPLed code is used. Even building in the assistant does not pull in AGPLed code.
59 lines
1.9 KiB
Haskell
59 lines
1.9 KiB
Haskell
{- git-annex assistant webapp notifications
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
|
|
|
|
module Assistant.WebApp.Notifications where
|
|
|
|
import Assistant.Common
|
|
import Assistant.WebApp
|
|
import Assistant.WebApp.Types
|
|
import Assistant.DaemonStatus
|
|
import Utility.NotificationBroadcaster
|
|
import Utility.Yesod
|
|
|
|
import Yesod
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
|
|
{- Add to any widget to make it auto-update using long polling.
|
|
-
|
|
- The widget should have a html element with an id=ident, which will be
|
|
- replaced when it's updated.
|
|
-
|
|
- The geturl route should return the notifier url to use for polling.
|
|
-
|
|
- ms_delay is how long to delay between AJAX updates
|
|
- ms_startdelay is how long to delay before updating with AJAX at the start
|
|
-}
|
|
autoUpdate :: Text -> Route WebApp -> Int -> Int -> Widget
|
|
autoUpdate ident geturl ms_delay ms_startdelay = do
|
|
let delay = show ms_delay
|
|
let startdelay = show ms_startdelay
|
|
addScript $ StaticR longpolling_js
|
|
$(widgetFile "notifications/longpolling")
|
|
|
|
{- Notifier urls are requested by the javascript, to avoid allocation
|
|
- of NotificationIds when noscript pages are loaded. This constructs a
|
|
- notifier url for a given Route and NotificationBroadcaster.
|
|
-}
|
|
notifierUrl :: (NotificationId -> Route WebApp) -> (DaemonStatus -> NotificationBroadcaster) -> Handler RepPlain
|
|
notifierUrl route selector = do
|
|
(urlbits, _params) <- renderRoute . route <$> newNotifier selector
|
|
webapp <- getYesod
|
|
return $ RepPlain $ toContent $ T.concat
|
|
[ "/"
|
|
, T.intercalate "/" urlbits
|
|
, "?auth="
|
|
, secretToken webapp
|
|
]
|
|
|
|
getNotifierTransfersR :: Handler RepPlain
|
|
getNotifierTransfersR = notifierUrl TransfersR transferNotifier
|
|
|
|
getNotifierSideBarR :: Handler RepPlain
|
|
getNotifierSideBarR = notifierUrl SideBarR alertNotifier
|