engine-io-yesod (empty) → 1.0.0

raw patch · 4 files changed

+118/−0 lines, 4 filesdep +basedep +bytestringdep +conduitsetup-changed

Dependencies added: base, bytestring, conduit, conduit-extra, engine-io, http-types, text, unordered-containers, wai, wai-websockets, websockets, yesod-core

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• engine-io-yesod.cabal +35/−0
• src/Network/EngineIO/Yesod.hs +51/−0

@@ -0,0 +1,30 @@+Copyright (c) 2014, Tim Baumann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tim Baumann nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,35 @@+name: engine-io-yesod+version: 1.0.0+license: BSD3+license-file: LICENSE+author: Tim Baumann+maintainer: tim@timbaumann.info+category: Network+build-type: Simple+-- extra-source-files:  +cabal-version: >=1.10+description:+  This package provides an @engine-io@ @ServerAPI@ that is compatible with+  <http://www.yesodweb.com/ Yesod>.++library+  exposed-modules:+    Network.EngineIO.Yesod++  build-depends:+    base >=4.6 && <4.8,+    yesod-core >= 1.2.16.1 && < 1.3,+    engine-io >= 1.1.0 && < 1.2,+    http-types >= 0.8 && < 0.9,+    unordered-containers >= 0.2 && < 0.3,+    wai >= 3.0 && < 3.1,+    text >= 1.1 && < 1.2,+    bytestring >= 0.9 && <0.11,+    conduit >= 1.1 && < 1.2,+    conduit-extra >= 1.1 && < 1.2,+    websockets >= 0.8.2.6 && < 0.9,+    wai-websockets >= 3 && < 3.1++  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall -O2

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}+module Network.EngineIO.Yesod (yesodAPI) where++import Control.Applicative+import Data.Maybe (maybeToList)+import Control.Arrow (second)+import Data.Text (pack)+import Data.Conduit (($$))+import Data.Conduit.Lift (runCatchC)+import Data.Conduit.Attoparsec (sinkParser)+import Data.Monoid (mappend)+import Control.Monad (unless)++import qualified Data.ByteString.Builder as Builder+import qualified Network.EngineIO as EIO+import qualified Yesod.Core as YC+import qualified Data.HashMap.Strict as HashMap+import qualified Network.Wai as WAI+import qualified Network.Wai.Handler.WebSockets as WaiWS+import qualified Network.WebSockets as WS+import Network.HTTP.Types.Status as St++--------------------------------------------------------------------------------+-- | A drop in 'EIO.ServerAPI' that works in Yesod's 'Handler' monad.+yesodAPI :: (YC.MonadHandler m, YC.MonadBaseControl IO m) => EIO.ServerAPI m+yesodAPI = EIO.ServerAPI+  { EIO.srvTerminateWithResponse = \code ct builder -> do+      let status = filter ((==) code . St.statusCode) [St.status100..St.status511]+      case status of+        [] -> error "not a valid status code"+        (st:_) -> YC.sendResponseStatus st $ YC.TypedContent ct $+                    YC.toContent $ Builder.toLazyByteString builder++  , EIO.srvGetQueryParams = HashMap.fromListWith (++) . map (second maybeToList)+                              . WAI.queryString <$> YC.waiRequest++  , EIO.srvParseRequestBody = \p -> do+      val <- YC.rawRequestBody $$ runCatchC (sinkParser p)+      case val of+        Left e  -> YC.invalidArgs ["could not parse request body: " `mappend` pack (show e)]+        Right v -> return v++  , EIO.srvGetRequestMethod = WAI.requestMethod <$> YC.waiRequest++  , EIO.srvRunWebSocket = \app -> do+      req <- YC.waiRequest+      unless (WaiWS.isWebSocketsReq req) $ YC.invalidArgs ["not a websocket request"]+      YC.sendRawResponseNoConduit $ \src sink ->+        YC.liftIO $ WaiWS.runWebSockets WS.defaultConnectionOptions+          (WaiWS.getRequestHead req) app src sink+  }