engine-io-wai (empty) → 1.0.0

raw patch · 4 files changed

+143/−0 lines, 4 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, engine-io, http-types, mtl, text, transformers, unordered-containers, wai, wai-websockets, websockets

Files

LICENSE +30/−0
Setup.hs +2/−0
engine-io-wai.cabal +35/−0
src/Network/EngineIO/Wai.hs +76/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015, Brandon Martin++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.

+ Setup.hs view

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

+ engine-io-wai.cabal view

@@ -0,0 +1,35 @@+name: engine-io-wai+version: 1.0.0+license: BSD3+license-file: LICENSE+author: Brandon Martin+maintainer: brandon@codedmart.com+category: Network+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10+description:+    This package provides an @engine-io@ @ServerAPI@ that is compatible with+    <https://hackage.haskell.org/package/wai/ Wai>.++library+    exposed-modules:+        Network.EngineIO.Wai++    build-depends:+        base >=4.6 && <4.9,+        engine-io >= 1.2 && < 1.3,+        http-types >= 0.8 && < 0.9,+        unordered-containers >= 0.2 && < 0.3,+        wai >= 3.0 && < 3.1,+        text >= 1.1 && < 1.3,+        bytestring >= 0.9 && <0.11,+        websockets >= 0.8 && < 0.10,+        wai-websockets >= 3 && < 3.1,+        mtl >= 2 && < 2.3,+        transformers >= 0.4 && < 0.5,+        attoparsec >= 0.13 && < 0.14++    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -Wall -O2

+ src/Network/EngineIO/Wai.hs view

@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+++module Network.EngineIO.Wai (+    WaiMonad,+    toWaiApplication,+    waiAPI+    ) where+++import Network.Wai+import Control.Monad.Except+import Control.Monad.Reader+import Control.Monad.Trans.Except+import Control.Arrow (second)+import Data.Maybe (maybeToList)+import Data.ByteString.Lazy (toStrict)+import Data.Text.Lazy.Encoding (encodeUtf8)+import Data.Text.Lazy (fromStrict)+import Data.Attoparsec.ByteString (parseOnly)+import Network.HTTP.Types.Header (hContentType)+++import Network.HTTP.Types.Status as ST+import Network.HTTP.Types.URI as URI+import qualified Data.ByteString as BS+import qualified Network.EngineIO as EIO+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+++newtype WaiMonad a = WaiMonad {+    runWaiMonad :: ExceptT Response (ReaderT Request IO) a+    } deriving (Monad, Functor, Applicative, MonadReader Request, MonadError Response, MonadIO)+++toWaiApplication :: WaiMonad a -> Application+toWaiApplication sHandler req respond = do+    socket <- runReaderT (runExceptT (runWaiMonad sHandler)) req+    case socket of+        Left response -> respond response+        Right _ -> respond $ responseLBS status200 [("Content-Type", "text/html")] $ encodeUtf8 $ fromStrict ""+++--------------------------------------------------------------------------------+-- | A drop in 'EIO.ServerAPI' that works with Wai.+waiAPI :: EIO.ServerAPI WaiMonad+waiAPI = 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:_) -> throwError (responseBuilder st [(hContentType, ct)] builder)++    , EIO.srvGetQueryParams = fmap (queryToHashMap . WAI.queryString) ask++    , EIO.srvParseRequestBody = \p -> do+        req <- ask+        b <- liftIO $ WAI.lazyRequestBody req+        return (parseOnly p $ toStrict b)++    , EIO.srvGetRequestMethod = fmap (WAI.requestMethod) ask++    , EIO.srvRunWebSocket = \app -> do+        req <- ask+        maybe (return ()) throwError (WaiWS.websocketsApp WS.defaultConnectionOptions app req)+    }+++queryToHashMap :: URI.Query -> HashMap.HashMap BS.ByteString [BS.ByteString]+queryToHashMap = HashMap.fromListWith (++) . map (second maybeToList)+