c9fdece · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Merge commit 'f2b2f837aa515a7beca3300630d8e61275e60657'

c9fdeceMichael Snoyman15 years ago

wai-websockets/Network/Wai/Handler/WebSockets.hs+21−12

compare with master

unifiedsplit

@@ -7,34 +7,34 @@ module Network.Wai.Handler.WebSockets

7import Control.Monad.IO.Class (liftIO)

8import Data.ByteString (ByteString)

9import Data.Char (toLower)

10−import Network.Wai (Request, requestHeaders, rawPathInfo, requestHeaders)

11import qualified Data.ByteString.Char8 as S

10import qualified Data.ByteString.Char8 as S

12import qualified Data.Conduit as C

11import qualified Data.Conduit as C

13import qualified Data.Enumerator as E

12import 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

15import qualified Network.WebSockets as WS

16−import Network.Wai.Handler.Warp (Connection (..))

18-- | For use with 'settingsIntercept' from the Warp web server.

17-- | For use with 'settingsIntercept' from the Warp web server.

19intercept :: WS.Protocol p

18intercept :: WS.Protocol p

20 => (WS.Request -> WS.WebSockets p ())

19 => (WS.Request -> WS.WebSockets p ())

21− -> Request

20+ -> Wai.Request

22− -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Connection -> C.ResourceT IO ())

21+ -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Warp.Connection -> C.ResourceT IO ())

23intercept = interceptWith WS.defaultWebSocketsOptions

22intercept = interceptWith WS.defaultWebSocketsOptions

25-- | Variation of 'intercept' which allows custom options.

24-- | Variation of 'intercept' which allows custom options.

26interceptWith :: WS.Protocol p

25interceptWith :: WS.Protocol p

27 => WS.WebSocketsOptions

26 => WS.WebSocketsOptions

28 -> (WS.Request -> WS.WebSockets p ())

27 -> (WS.Request -> WS.WebSockets p ())

29− -> Request

28+ -> Wai.Request

30− -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Connection -> C.ResourceT IO ())

29+ -> Maybe (C.BufferedSource (C.ResourceT IO) ByteString -> Warp.Connection -> C.ResourceT IO ())

31−interceptWith opts app req = case lookup "upgrade" $ requestHeaders req of

30+interceptWith opts app req = case lookup "upgrade" $ Wai.requestHeaders req of

32 Just s

31 Just s

33 | S.map toLower s == "websocket" -> Just $ runWebSockets opts req' app

32 | S.map toLower s == "websocket" -> Just $ runWebSockets opts req' app

34 | otherwise -> Nothing

33 | otherwise -> Nothing

35 _ -> Nothing

34 _ -> Nothing

36 where

35 where

37− req' = WS.RequestHttpPart (rawPathInfo req) (requestHeaders req)

36+ req' = WS.RequestHttpPart (Wai.rawPathInfo req) (Wai.requestHeaders req)

37+ (Wai.isSecure req)

39-- | Internal function to run the WebSocket iteratee using the conduit library

40runWebSockets :: WS.Protocol p

@@ -42,15 +42,24 @@ runWebSockets :: WS.Protocol p

42 -> WS.RequestHttpPart

43 -> (WS.Request -> WS.WebSockets p ())

44 -> C.BufferedSource (C.ResourceT IO) ByteString

45− -> Connection

45+ -> Warp.Connection

46 -> C.ResourceT IO ()

47runWebSockets opts req app source conn = do

48 step <- liftIO $ E.runIteratee $ WS.runWebSocketsWith opts req app send

49 source C.$$ C.sinkState (E.returnI step) push close

50 where

51− send = EL.mapM_ (connSendAll conn)

51+ send = iterConnection conn

52− close = const $ return ()

54 push iter bs = do

53 push iter bs = do

55 step <- liftIO $ E.runIteratee $ E.enumList 1 [bs] E.$$ iter

54 step <- liftIO $ E.runIteratee $ E.enumList 1 [bs] E.$$ iter

56 return $ C.StateProcessing $ E.returnI step

55 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

17flag example

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.2

22+ , conduit >= 0.3 && < 0.4

23− , wai >= 1.2 && < 1.3

24− , warp >= 1.2 && < 1.3

23+ , wai >= 1.2 && < 1.3

25− , enumerator >= 0.4.8 && < 0.5

24+ , enumerator >= 0.4.8 && < 0.5

26− , network-enumerator >= 0.1.2 && < 0.2

25+ , network-enumerator >= 0.1.2 && < 0.2

27− , blaze-builder >= 0.2.1.4 && < 0.4

26+ , blaze-builder >= 0.2.1.4 && < 0.4

28− , case-insensitive >= 0.2

27+ , case-insensitive >= 0.2

29− , network >= 2.2.1.5 && < 2.4

28+ , network >= 2.2.1.5 && < 2.4

30− , transformers >= 0.2 && < 0.3

29+ , transformers >= 0.2 && < 0.3

31− , websockets >= 0.5.1 && < 0.6

30+ , websockets >= 0.6 && < 0.7

31+ , warp >= 1.2 && < 1.3

32 Exposed-modules: Network.Wai.Handler.WebSockets

33 ghc-options: -Wall

@@ -37,22 +37,22 @@ Executable wai-websockets-example

37 buildable: True

38 else

39 buildable: False

40− Build-Depends: base >=3 && < 5,

40+ Build-Depends: base >= 3 && < 5

41− conduit,

41+ , conduit

42− wai-websockets,

42+ , wai-websockets

43− websockets,

43+ , websockets

44− network-enumerator,

44+ , network-enumerator

45− warp,

45+ , warp

46− wai,

46+ , wai

47− wai-app-static,

47+ , wai-app-static

48− bytestring,

48+ , bytestring

49− case-insensitive,

49+ , case-insensitive

50− blaze-builder,

50+ , blaze-builder

51− enumerator,

51+ , enumerator

52− transformers,

52+ , transformers

53− network,

53+ , network

54− text,

54+ , text

55− file-embed

55+ , file-embed

57 ghc-options: -Wall -threaded

58 main-is: server.lhs