@@ -2,6 +2,9 @@
22module Network.Wai.Handler.WebSockets
33 ( websocketsApp
44 , websocketsOr
5+ , isWebSocketsReq
6+ , getRequestHead
7+ , runWebSockets
58 ) where
69
710import Data.ByteString (ByteString)
@@ -16,6 +19,11 @@ import qualified Network.WebSockets.Connection as WS
1619import System.IO.Streams (InputStream, OutputStream)
1720import qualified System.IO.Streams as Streams
1821
22+--------------------------------------------------------------------------------
23+isWebSocketsReq :: Wai.Request -> Bool
24+isWebSocketsReq req =
25+ fmap CI.mk (lookup "upgrade" $ Wai.requestHeaders req) == Just "websocket"
26+
1927--------------------------------------------------------------------------------
2028websocketsOr :: WS.ConnectionOptions
2129 -> WS.ServerApp
@@ -32,26 +40,30 @@ websocketsApp :: WS.ConnectionOptions
3240 -> Wai.Request
3341 -> Maybe Wai.Response
3442websocketsApp opts app req
35− | fmap CI.mk (lookup "upgrade" $ Wai.requestHeaders req) == Just "websocket" =
43+ | isWebSocketsReq req =
3644 Just $ flip Wai.responseRaw backup $ \src sink ->
3745 runWebSockets opts req' app src sink
3846 | otherwise = Nothing
3947 where
40− req' = WS.RequestHead
41− (Wai.rawPathInfo req `BC.append` Wai.rawQueryString req)
42− (Wai.requestHeaders req)
43− (Wai.isSecure req)
48+ req' = getRequestHead req
4449 backup = Wai.responseLBS status500 [("Content-Type", "text/plain")]
4550 "The web application attempted to send a WebSockets response, but WebSockets are not supported by your WAI handler."
4651
52+--------------------------------------------------------------------------------
53+getRequestHead :: Wai.Request -> WS.RequestHead
54+getRequestHead req = WS.RequestHead
55+ (Wai.rawPathInfo req `BC.append` Wai.rawQueryString req)
56+ (Wai.requestHeaders req)
57+ (Wai.isSecure req)
58+
4759--------------------------------------------------------------------------------
4860---- | Internal function to run the WebSocket io-streams using the conduit library
4961runWebSockets :: WS.ConnectionOptions
5062 -> WS.RequestHead
51− -> WS.ServerApp
63+ -> (WS.PendingConnection -> IO a)
5264 -> Source IO ByteString
5365 -> Sink ByteString IO ()
54− -> IO ()
66+ -> IO a
5567runWebSockets opts req app src sink = do
5668
5769 is <- srcToInput src