From 13976667ed1a1e47e5c5ea982418231b3900706c Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 6 Mar 2014 18:00:46 +0200 Subject: [PATCH] Initial yesod-websockets Pinging @gregwebs and @meteficha. Greg: I know you were talking about Sockets.IO support, and Felipe: I thought you might be curious about this relative to yesod-eventsource. Comments welcome :) --- yesod-websockets/LICENSE | 20 +++++++++ yesod-websockets/Setup.hs | 2 + yesod-websockets/Yesod/WebSockets.hs | 60 +++++++++++++++++++++++++ yesod-websockets/sample.hs | 39 ++++++++++++++++ yesod-websockets/yesod-websockets.cabal | 28 ++++++++++++ 5 files changed, 149 insertions(+) create mode 100644 yesod-websockets/LICENSE create mode 100644 yesod-websockets/Setup.hs create mode 100644 yesod-websockets/Yesod/WebSockets.hs create mode 100644 yesod-websockets/sample.hs create mode 100644 yesod-websockets/yesod-websockets.cabal diff --git a/yesod-websockets/LICENSE b/yesod-websockets/LICENSE new file mode 100644 index 00000000..38956985 --- /dev/null +++ b/yesod-websockets/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2014 Michael Snoyman, http://www.yesodweb.com/ + +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-websockets/Setup.hs b/yesod-websockets/Setup.hs new file mode 100644 index 00000000..9a994af6 --- /dev/null +++ b/yesod-websockets/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs new file mode 100644 index 00000000..e8f90c64 --- /dev/null +++ b/yesod-websockets/Yesod/WebSockets.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Yesod.WebSockets + ( WebsocketsT + , webSockets + , receiveData + , sendTextData + , sendBinaryData + ) where + +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Control (control) +import Control.Monad.Trans.Reader (ReaderT (ReaderT, runReaderT)) +import qualified Network.Wai.Handler.WebSockets as WaiWS +import qualified Network.WebSockets as WS +import qualified Yesod.Core as Y + +-- | A transformer for a WebSockets handler. +-- +-- Since 0.1.0 +type WebsocketsT = ReaderT WS.Connection + +-- | Attempt to run a WebSockets handler. This function first checks if the +-- client initiated a WebSockets connection and, if so, runs the provided +-- application, short-circuiting the rest of your handler. If the client did +-- not request a WebSockets connection, the rest of your handler will be called +-- instead. +-- +-- Since 0.1.0 +webSockets :: (Y.MonadBaseControl IO m, Y.MonadHandler m) => WebsocketsT m () -> m () +webSockets inner = do + req <- Y.waiRequest + when (WaiWS.isWebSocketsReq req) $ + Y.sendRawResponse $ \src sink -> control $ \runInIO -> WaiWS.runWebSockets + WS.defaultConnectionOptions + (WaiWS.getRequestHead req) + (\pconn -> do + conn <- WS.acceptRequest pconn + runInIO $ runReaderT inner conn) + src + sink + +-- | Receive a piece of data from the client. +-- +-- Since 0.1.0 +receiveData :: (MonadIO m, WS.WebSocketsData a) => WebsocketsT m a +receiveData = ReaderT $ liftIO . WS.receiveData + +-- | Send a textual messsage to the client. +-- +-- Since 0.1.0 +sendTextData :: (MonadIO m, WS.WebSocketsData a) => a -> WebsocketsT m () +sendTextData x = ReaderT $ liftIO . flip WS.sendTextData x + +-- | Send a binary messsage to the client. +-- +-- Since 0.1.0 +sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebsocketsT m () +sendBinaryData x = ReaderT $ liftIO . flip WS.sendBinaryData x diff --git a/yesod-websockets/sample.hs b/yesod-websockets/sample.hs new file mode 100644 index 00000000..86e6630b --- /dev/null +++ b/yesod-websockets/sample.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} +import Yesod.Core +import Yesod.WebSockets +import qualified Data.Text.Lazy as TL +import Control.Monad (forever) + +data App = App + +instance Yesod App + +mkYesod "App" [parseRoutes| +/ HomeR GET +|] + +getHomeR :: Handler Html +getHomeR = do + webSockets $ forever $ do + msg <- receiveData + sendTextData $ TL.toUpper msg + defaultLayout $ + toWidget + [julius| + var conn = new WebSocket("ws://localhost:3000/"); + conn.onopen = function() { + document.write("

open!

"); + document.write("") + document.getElementById("button").addEventListener("click", function(){ + var msg = prompt("Enter a message for the server"); + conn.send(msg); + }); + conn.send("hello world"); + }; + conn.onmessage = function(e) { + document.write("

" + e.data + "

"); + }; + |] + +main :: IO () +main = warp 3000 App diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal new file mode 100644 index 00000000..f72ce660 --- /dev/null +++ b/yesod-websockets/yesod-websockets.cabal @@ -0,0 +1,28 @@ +-- Initial yesod-websockets.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: yesod-websockets +version: 0.1.0.0 +synopsis: WebSockets support for Yesod +description: WebSockets support for Yesod +homepage: https://github.com/yesodweb/yesod +license: MIT +license-file: LICENSE +author: Michael Snoyman +maintainer: michael@snoyman.com +category: Web +build-type: Simple +cabal-version: >=1.8 + +library + exposed-modules: Yesod.WebSockets + build-depends: base >= 4.5 && < 5 + , wai-websockets >= 2.1 + , websockets >= 0.8 + , transformers >= 0.2 + , yesod-core >= 1.2.7 + , monad-control >= 0.3 + +source-repository head + type: git + location: https://github.com/yesodweb/yesod