diff --git a/yesod-eventsource/LICENSE b/yesod-eventsource/LICENSE new file mode 100644 index 00000000..6baa863e --- /dev/null +++ b/yesod-eventsource/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2012 Felipe Lessa + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/yesod-eventsource/Yesod/EventSource.hs b/yesod-eventsource/Yesod/EventSource.hs new file mode 100644 index 00000000..989e4103 --- /dev/null +++ b/yesod-eventsource/Yesod/EventSource.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This module contains everything that you need to support +-- server-sent events in Yesod applications. +module Yesod.EventSource + ( RepEventSource + , repEventSource + , ioToRepEventSource + , EventSourcePolyfill(..) + ) where + +import Blaze.ByteString.Builder (Builder) +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Data.Functor ((<$>)) +import Data.Monoid (mconcat) +import Yesod.Content +import Yesod.Core +import qualified Data.Conduit as C +import qualified Network.Wai as W +import qualified Network.Wai.EventSource as ES +import qualified Network.Wai.EventSource.EventStream as ES + + + +-- | Phantom type used for 'Handler'@s@ that are @EventSources@ +-- (e.g. 'repEventSource' and 'ioToRepEventSource'). +newtype RepEventSource = + RepEventSource (C.Source (C.ResourceT IO) (C.Flush Builder)) + +instance HasReps RepEventSource where + chooseRep (RepEventSource src) = + const $ return ("text/event-stream", ContentSource src) + + +-- | (Internal) Find out the request's 'EventSourcePolyfill' and +-- set any necessary headers. +prepareForEventSource :: GHandler sub master EventSourcePolyfill +prepareForEventSource = do + reqWith <- lookup "X-Requested-With" . W.requestHeaders <$> waiRequest + let polyfill | reqWith == Just "XMLHttpRequest" = Remy'sESPolyfill + | otherwise = NoESPolyfill + setHeader "Cache-Control" "no-cache" -- extremely important! + return polyfill + + +-- | Returns a Server-Sent Event stream from a 'C.Source' of +-- 'ES.ServerEvent'@s@. The HTTP socket is flushed after every +-- event. The connection is closed either when the 'C.Source' +-- finishes outputting data or a 'ES.CloseEvent' is outputted, +-- whichever comes first. +repEventSource :: (EventSourcePolyfill -> C.Source (C.ResourceT IO) ES.ServerEvent) + -> GHandler sub master RepEventSource +repEventSource src = RepEventSource . ES.sourceToSource . src <$> prepareForEventSource + + +-- | Return a Server-Sent Event stream given an @IO@ action that +-- is repeatedly called. An state is threaded for the action so +-- that it may avoid using @IORefs@. The @IO@ action may sleep +-- or block while waiting for more data. The HTTP socket is +-- flushed after every list of simultaneous events. The +-- connection is closed as soon as an 'ES.CloseEvent' is +-- outputted, after which no other events are sent to the client. +ioToRepEventSource :: s + -> (EventSourcePolyfill -> s -> IO ([ES.ServerEvent], s)) + -> GHandler sub master RepEventSource +ioToRepEventSource initial act = do + polyfill <- prepareForEventSource + let -- Get new events to be sent. + getEvents s = do + (evs, s') <- liftIO (act polyfill s) + let (builder, continue) = joinEvents evs [] + C.yield (C.Chunk builder) + C.yield C.Flush + when continue (getEvents s') + + -- Join all events in a single Builder. Returns @False@ + -- when we the connection should be closed. + joinEvents (ev:evs) acc = + case ES.eventToBuilder ev of + Just b -> joinEvents evs (b:acc) + Nothing -> (fst $ joinEvents [] acc, False) + joinEvents [] acc = (mconcat (reverse acc), True) + + return $ RepEventSource $ getEvents initial + + +-- | Which @EventSource@ polyfill was detected (if any). +data EventSourcePolyfill = + NoESPolyfill + -- ^ We didn't detect any @EventSource@ polyfill that we know. + | Remy'sESPolyfill + -- ^ See + -- . + -- In order to support Remy\'s polyfill, your server needs to + -- explicitly close the connection from time to + -- time--browsers such as IE7 will not show any event until + -- the connection is closed. + deriving (Eq, Ord, Show, Enum) diff --git a/yesod-eventsource/yesod-json.cabal b/yesod-eventsource/yesod-json.cabal new file mode 100644 index 00000000..88b1bef2 --- /dev/null +++ b/yesod-eventsource/yesod-json.cabal @@ -0,0 +1,42 @@ +name: yesod-eventsource +version: 1.0 +license: MIT +license-file: LICENSE +author: Felipe Lessa +maintainer: Felipe Lessa +synopsis: Server-sent events support for Yesod apps. +category: Web, Yesod +stability: Stable +cabal-version: >= 1.6 +build-type: Simple +homepage: http://www.yesodweb.com/ +description: + It's easy to send an event from an HTTP client to a server: + just send an HTTP request. However, sending events from the + server to the client requires more sophisticated approaches. + Server-sent events () are a + standardized way of pushing events from the server to the + client. + . + This package allows your Yesod application to easily send + server-sent events. On the client side, you may use the + @EventSource@ JavaScript object on browsers that support it + (https://developer.mozilla.org/en-US/docs/Server-sent_events/EventSource) + or a polyfill for browsers that don't (we support Remy's + polyfill out-of-the-box, although that requires you to + explicitly support it). + +library + build-depends: base >= 4 && < 5 + , yesod-core >= 1.1 && < 1.2 + , conduit >= 0.5 && < 0.6 + , wai >= 1.3 && < 1.4 + , wai-eventsource >= 1.3 && < 1.4 + , blaze-builder + , transformers + exposed-modules: Yesod.EventSource + ghc-options: -Wall + +source-repository head + type: git + location: https://github.com/yesodweb/yesod