@@ -1,6 +1,7 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Network.Wai.Handler.WebSockets
33 ( intercept
4+ , interceptWith
45 ) where
56
67import Control.Monad.IO.Class (liftIO)
@@ -19,9 +20,17 @@ intercept :: WS.Protocol p
1920 => (WS.Request -> WS.WebSockets p ())
2021 -> Request
2122 -> Maybe (C.BufferedSource IO ByteString -> Socket -> C.ResourceT IO ())
22−intercept app req = case lookup "upgrade" $ requestHeaders req of
23+intercept = interceptWith WS.defaultWebSocketsOptions
24+
25+-- | Variation of 'intercept' which allows custom options.
26+interceptWith :: WS.Protocol p
27+ => WS.WebSocketsOptions
28+ -> (WS.Request -> WS.WebSockets p ())
29+ -> Request
30+ -> Maybe (C.BufferedSource IO ByteString -> Socket -> C.ResourceT IO ())
31+interceptWith opts app req = case lookup "upgrade" $ requestHeaders req of
2332 Just s
24− | S.map toLower s == "websocket" -> Just $ runWebSockets req' app
33+ | S.map toLower s == "websocket" -> Just $ runWebSockets opts req' app
2534 | otherwise -> Nothing
2635 _ -> Nothing
2736 where
@@ -29,13 +38,14 @@ intercept app req = case lookup "upgrade" $ requestHeaders req of
2938
3039-- | Internal function to run the WebSocket iteratee using the conduit library
3140runWebSockets :: WS.Protocol p
32− => WS.RequestHttpPart
41+ => WS.WebSocketsOptions
42+ -> WS.RequestHttpPart
3343 -> (WS.Request -> WS.WebSockets p ())
3444 -> C.BufferedSource IO ByteString
3545 -> Socket
3646 -> C.ResourceT IO ()
37−runWebSockets req app source sock = do
38− step <- liftIO $ E.runIteratee $ WS.runWebSockets req app send
47+runWebSockets opts req app source sock = do
48+ step <- liftIO $ E.runIteratee $ WS.runWebSocketsWith opts req app send
3949 source C.$$ C.sinkState (E.returnI step) push close
4050 where
4151 send = WS.iterSocket sock