on master help sign in
Merge pull request #28 from jaspervdj/master
da7e91bMichael Snoyman
wai-websockets/Network/Wai/Handler/WebSockets.hs+35−15
@@ -3,24 +3,44 @@ module Network.Wai.Handler.WebSockets
3 ( intercept
3 ( intercept
4 ) where
4 ) where
5
5
6−import Network.Wai (Request, requestHeaders, rawPathInfo, requestHeaders)
6+import Control.Monad.IO.Class (liftIO)
7−import Network.Socket (Socket)
8−import Data.Char (toLower)
9−import Data.Enumerator (Iteratee)
10import Data.ByteString (ByteString)
7import Data.ByteString (ByteString)
8+import Data.Char (toLower)
9+import Network.Socket (Socket)
10+import Network.Wai (Request, requestHeaders, rawPathInfo, requestHeaders)
11import qualified Data.ByteString.Char8 as S
11import qualified Data.ByteString.Char8 as S
12−import Network.WebSockets (WebSockets, runWebSockets, RequestHttpPart(RequestHttpPart), Protocol)
12+import qualified Data.Conduit as C
13+import qualified Data.Enumerator as E
13import qualified Network.WebSockets as WS
14import qualified Network.WebSockets as WS
14−import Network.Socket.Enumerator (iterSocket)
15+import qualified Network.WebSockets.Internal as WS
15
16
17+-- | For use with 'settingsIntercept' from the Warp web server.
16−intercept :: Protocol p
18+intercept :: WS.Protocol p
17− => (WS.Request -> WebSockets p ())
19+ => (WS.Request -> WS.WebSockets p ())
18 -> Request
20 -> Request
19− -> Maybe (Socket -> Iteratee ByteString IO ())
21+ -> Maybe (C.BufferedSource IO ByteString -> Socket -> C.ResourceT IO ())
20−intercept app req =
21− case lookup "upgrade" $ requestHeaders req of
22+intercept app req = case lookup "upgrade" $ requestHeaders req of
23+ Just s
22− Just s | S.map toLower s=="websocket" -> Just $ \socket -> do
24+ | S.map toLower s == "websocket" -> Just $ runWebSockets req' app
23− runWebSockets req' app (iterSocket socket)
25+ | otherwise -> Nothing
24− _ -> Nothing
26+ _ -> Nothing
27+ where
28+ req' = WS.RequestHttpPart (rawPathInfo req) (requestHeaders req)
29+
30+-- | Internal function to run the WebSocket iteratee using the conduit library
31+runWebSockets :: WS.Protocol p
32+ => WS.RequestHttpPart
33+ -> (WS.Request -> WS.WebSockets p ())
34+ -> C.BufferedSource IO ByteString
35+ -> Socket
36+ -> C.ResourceT IO ()
37+runWebSockets req app source sock = do
38+ step <- liftIO $ E.runIteratee $ WS.runWebSockets req app send
39+ source C.$$ C.sinkState (E.returnI step) push close
25 where
40 where
26− req' = RequestHttpPart (rawPathInfo req) (requestHeaders req)
41+ send = WS.iterSocket sock
42+ close = const $ return ()
43+
44+ push iter bs = do
45+ step <- liftIO $ E.runIteratee $ E.enumList 1 [bs] E.$$ iter
46+ return (E.returnI step, C.Processing)
wai-websockets/wai-websockets.cabal+5−2
@@ -1,5 +1,5 @@
1Name: wai-websockets
1Name: wai-websockets
2−Version: 1.0.0
2+Version: 1.1.0
3Synopsis: Provide a bridge betweeen WAI and the websockets package.
3Synopsis: Provide a bridge betweeen WAI and the websockets package.
4License: BSD3
4License: BSD3
5License-file: LICENSE
5License-file: LICENSE
@@ -19,13 +19,15 @@ flag example
19Library
19Library
20 Build-Depends: base >= 3 && < 5
20 Build-Depends: base >= 3 && < 5
21 , bytestring >= 0.9.1.4 && < 0.10
21 , bytestring >= 0.9.1.4 && < 0.10
22+ , conduit >= 0.0 && < 0.1
22 , wai >= 1.0 && < 1.1
23 , wai >= 1.0 && < 1.1
23 , enumerator >= 0.4.8 && < 0.5
24 , enumerator >= 0.4.8 && < 0.5
24 , network-enumerator >= 0.1.2 && < 0.2
25 , network-enumerator >= 0.1.2 && < 0.2
25 , blaze-builder >= 0.2.1.4 && < 0.4
26 , blaze-builder >= 0.2.1.4 && < 0.4
26 , case-insensitive >= 0.2
27 , case-insensitive >= 0.2
27 , network >= 2.2.1.5 && < 2.4
28 , network >= 2.2.1.5 && < 2.4
29+ , transformers >= 0.2 && < 0.3
28− , websockets >= 0.4 && < 0.5
30+ , websockets >= 0.5.1 && < 0.6
29 Exposed-modules: Network.Wai.Handler.WebSockets
31 Exposed-modules: Network.Wai.Handler.WebSockets
30 ghc-options: -Wall
32 ghc-options: -Wall
31
33
@@ -35,6 +37,7 @@ Executable wai-websockets-example
35 else
37 else
36 buildable: False
38 buildable: False
37 Build-Depends: base >=3 && < 5,
39 Build-Depends: base >=3 && < 5,
40+ conduit,
38 wai-websockets,
41 wai-websockets,
39 websockets,
42 websockets,
40 network-enumerator,
43 network-enumerator,