on master help sign in
Merge commit 'f2b2f837aa515a7beca3300630d8e61275e60657'

Conflicts: wai-websockets/Network/Wai/Handler/WebSockets.hs wai-websockets/wai-websockets.cabal

commitc9fdece2d74d8673faca6e409e44c5df2e706ee9 authorMichael Snoyman <michael@snoyman.com> dateWed 21 Mar 2012, 14:42 (15 years ago) parent3c83a50f2b2f83
2 files changed+49−40
wai-websockets/Network/Wai/Handler/WebSockets.hs+21−12 wai-websockets/wai-websockets.cabal+28−28
wai-websockets/Network/Wai/Handler/WebSockets.hs+21−12
@@ -7,34 +7,34 @@ module Network.Wai.Handler.WebSockets
77import Control.Monad.IO.Class (liftIO)
88import Data.ByteString (ByteString)
99import Data.Char (toLower)
10−import Network.Wai (Request, requestHeaders, rawPathInfo, requestHeaders)
1110import qualified Data.ByteString.Char8 as S
1211import qualified Data.Conduit as C
1312import qualified Data.Enumerator as E
14−import qualified Data.Enumerator.List as EL
13+import qualified Network.Wai as Wai
14+import qualified Network.Wai.Handler.Warp as Warp
1515import qualified Network.WebSockets as WS
16−import Network.Wai.Handler.Warp (Connection (..))
1716
1817-- | For use with 'settingsIntercept' from the Warp web server.
1918intercept :: WS.Protocol p
2019 => (WS.Request -> WS.WebSockets p ())
21− -> Request
22− -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Connection -> C.ResourceT IO ())
20+ -> Wai.Request
21+ -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Warp.Connection -> C.ResourceT IO ())
2322intercept = interceptWith WS.defaultWebSocketsOptions
2423
2524-- | Variation of 'intercept' which allows custom options.
2625interceptWith :: WS.Protocol p
2726 => WS.WebSocketsOptions
2827 -> (WS.Request -> WS.WebSockets p ())
29− -> Request
30− -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Connection -> C.ResourceT IO ())
31−interceptWith opts app req = case lookup "upgrade" $ requestHeaders req of
28+ -> Wai.Request
29+ -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Warp.Connection -> C.ResourceT IO ())
30+interceptWith opts app req = case lookup "upgrade" $ Wai.requestHeaders req of
3231 Just s
3332 | S.map toLower s == "websocket" -> Just $ runWebSockets opts req' app
3433 | otherwise -> Nothing
3534 _ -> Nothing
3635 where
37− req' = WS.RequestHttpPart (rawPathInfo req) (requestHeaders req)
36+ req' = WS.RequestHttpPart (Wai.rawPathInfo req) (Wai.requestHeaders req)
37+ (Wai.isSecure req)
3838
3939-- | Internal function to run the WebSocket iteratee using the conduit library
4040runWebSockets :: WS.Protocol p
@@ -42,15 +42,24 @@ runWebSockets :: WS.Protocol p
4242 -> WS.RequestHttpPart
4343 -> (WS.Request -> WS.WebSockets p ())
4444 -> C.BufferedSource (C.ResourceT IO) ByteString
45− -> Connection
45+ -> Warp.Connection
4646 -> C.ResourceT IO ()
4747runWebSockets opts req app source conn = do
4848 step <- liftIO $ E.runIteratee $ WS.runWebSocketsWith opts req app send
4949 source C.$$ C.sinkState (E.returnI step) push close
5050 where
51− send = EL.mapM_ (connSendAll conn)
52− close = const $ return ()
51+ send = iterConnection conn
5352
5453 push iter bs = do
5554 step <- liftIO $ E.runIteratee $ E.enumList 1 [bs] E.$$ iter
5655 return $ C.StateProcessing $ E.returnI step
56+ close iter = do
57+ _ <- liftIO $ E.runIteratee $ E.enumEOF E.$$ iter
58+ return ()
59+
60+iterConnection :: Warp.Connection -> E.Iteratee ByteString IO ()
61+iterConnection c = E.continue go
62+ where
63+ go (E.Chunks []) = E.continue go
64+ go (E.Chunks cs) = E.tryIO (Warp.connSendMany c cs) >> E.continue go
65+ go E.EOF = E.continue go
wai-websockets/wai-websockets.cabal+28−28
@@ -17,18 +17,18 @@ extra-source-files: static/client.js, static/client.html, static/screen.css
1717flag example
1818
1919Library
20− Build-Depends: base >= 3 && < 5
21− , bytestring >= 0.9.1.4 && < 0.10
22− , conduit >= 0.2
23− , wai >= 1.2 && < 1.3
24− , warp >= 1.2 && < 1.3
25− , enumerator >= 0.4.8 && < 0.5
26− , network-enumerator >= 0.1.2 && < 0.2
27− , blaze-builder >= 0.2.1.4 && < 0.4
28− , case-insensitive >= 0.2
29− , network >= 2.2.1.5 && < 2.4
30− , transformers >= 0.2 && < 0.3
31− , websockets >= 0.5.1 && < 0.6
20+ Build-Depends: base >= 3 && < 5
21+ , bytestring >= 0.9.1.4 && < 0.10
22+ , conduit >= 0.3 && < 0.4
23+ , wai >= 1.2 && < 1.3
24+ , enumerator >= 0.4.8 && < 0.5
25+ , network-enumerator >= 0.1.2 && < 0.2
26+ , blaze-builder >= 0.2.1.4 && < 0.4
27+ , case-insensitive >= 0.2
28+ , network >= 2.2.1.5 && < 2.4
29+ , transformers >= 0.2 && < 0.3
30+ , websockets >= 0.6 && < 0.7
31+ , warp >= 1.2 && < 1.3
3232 Exposed-modules: Network.Wai.Handler.WebSockets
3333 ghc-options: -Wall
3434
@@ -37,22 +37,22 @@ Executable wai-websockets-example
3737 buildable: True
3838 else
3939 buildable: False
40− Build-Depends: base >=3 && < 5,
41− conduit,
42− wai-websockets,
43− websockets,
44− network-enumerator,
45− warp,
46− wai,
47− wai-app-static,
48− bytestring,
49− case-insensitive,
50− blaze-builder,
51− enumerator,
52− transformers,
53− network,
54− text,
55− file-embed
40+ Build-Depends: base >= 3 && < 5
41+ , conduit
42+ , wai-websockets
43+ , websockets
44+ , network-enumerator
45+ , warp
46+ , wai
47+ , wai-app-static
48+ , bytestring
49+ , case-insensitive
50+ , blaze-builder
51+ , enumerator
52+ , transformers
53+ , network
54+ , text
55+ , file-embed
5656
5757 ghc-options: -Wall -threaded
5858 main-is: server.lhs