Merge pull request #408 from meteficha/yesod-eventsource

New yesod-eventsource package.

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.

yesod-eventsource/Setup.lhs

@@ -0,0 +1,7 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain

yesod-eventsource/Yesod/EventSource.hs

@@ -0,0 +1,101 @@
+{-# 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 (mappend, mempty)
+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
+
+
+
+-- | Data type representing a response of server-sent events
+-- (e.g., see '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.  A 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)
+        case evs of
+          [] -> getEvents s'
+          _  -> do
+            let (builder, continue) = joinEvents evs mempty
+            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 (acc `mappend` b)
+          Nothing -> (fst $ joinEvents [] acc, False)
+      joinEvents [] acc = (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
+    -- <https://github.com/remy/polyfills/blob/master/EventSource.js>.
+    -- 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)

yesod-eventsource/yesod-eventsource.cabal

@@ -0,0 +1,42 @@
+name:            yesod-eventsource
+version:         1.0.0.1
+license:         MIT
+license-file:    LICENSE
+author:          Felipe Lessa <felipe.lessa@gmail.com>
+maintainer:      Felipe Lessa <felipe.lessa@gmail.com>
+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 (<http://www.w3.org/TR/eventsource/>) 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