websockets 0.4.1.0 → 0.5.0.0

raw patch · 18 files changed

+387/−451 lines, 18 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Network/WebSockets.hs +3/−36
• src/Network/WebSockets/Demultiplex.hs +0/−54
• src/Network/WebSockets/Handshake.hs +14/−27
• src/Network/WebSockets/Handshake/Http.hs +17/−15
• src/Network/WebSockets/Handshake/ShyIterParser.hs +0/−40
• src/Network/WebSockets/Mask.hs +0/−34
• src/Network/WebSockets/Monad.hs +80/−97
• src/Network/WebSockets/Protocol.hs +24/−5
• src/Network/WebSockets/Protocol/Hybi00.hs +10/−6
• src/Network/WebSockets/Protocol/Hybi00/Internal.hs +28/−39
• src/Network/WebSockets/Protocol/Hybi10.hs +10/−6
• src/Network/WebSockets/Protocol/Hybi10/Demultiplex.hs +74/−0
• src/Network/WebSockets/Protocol/Hybi10/Internal.hs +70/−49
• src/Network/WebSockets/Protocol/Hybi10/Mask.hs +36/−0
• src/Network/WebSockets/Protocol/Unsafe.hs +12/−1
• src/Network/WebSockets/Socket.hs +5/−5
• src/Network/WebSockets/Types.hs +1/−33
• websockets.cabal +3/−4

@@ -106,8 +106,6 @@     , I.RequestHttpPart (..)     , I.Request (..)     , I.Response (..)-    , I.FrameType (..)-    , I.Frame (..)     , I.Message (..)     , I.ControlMessage (..)     , I.DataMessage (..)@@ -121,13 +119,11 @@     , I.getVersion        -- * Receiving-    , receiveFrame-    , receive+    , I.receive     , receiveDataMessage     , receiveData        -- * Sending-    , sendFrame     , I.send     , sendTextData     , sendBinaryData@@ -150,10 +146,8 @@     , I.ConnectionError(..)     ) where -import Control.Monad.State (put, get) import Control.Monad.Trans (liftIO) -import qualified Network.WebSockets.Demultiplex as I import qualified Network.WebSockets.Handshake as I import qualified Network.WebSockets.Handshake.Http as I import qualified Network.WebSockets.Monad as I@@ -168,31 +162,10 @@ -- determined by the request, we can't provide this as a WebSockets action. See -- the various flavours of runWebSockets. --- | Read a 'I.Frame' from the socket. Blocks until a frame is received. If the--- socket is closed, throws 'ConnectionClosed' (a 'ConnectionError')------ Note that a typical library user will want to use something like--- 'receiveByteStringData' instead.-receiveFrame :: I.Protocol p => I.WebSockets p I.Frame-receiveFrame = do-    proto <- I.getProtocol-    I.receiveWith $ I.decodeFrame proto---- | Receive a message-receive :: I.Protocol p => I.WebSockets p (I.Message p)-receive = I.WebSockets $ do-    f <- I.unWebSockets receiveFrame-    s <- get-    let (msg, s') = I.demultiplex s f-    put s'-    case msg of-        Nothing -> I.unWebSockets receive-        Just m  -> return m- -- | Receive an application message. Automatically respond to control messages. receiveDataMessage :: I.Protocol p => I.WebSockets p (I.DataMessage p) receiveDataMessage = do-    m <- receive+    m <- I.receive     case m of         (I.DataMessage am) -> return am         (I.ControlMessage cm) -> case cm of@@ -219,13 +192,7 @@  -- | Send a 'I.Response' to the socket immediately. sendResponse :: I.Protocol p => I.Response -> I.WebSockets p ()-sendResponse response = I.sendWith I.encodeResponse response---- | A low-level function to send an arbitrary frame over the wire.-sendFrame :: I.Protocol p => I.Frame -> I.WebSockets p ()-sendFrame frame = do-    proto <- I.getProtocol-    I.sendWith (I.encodeFrame proto) frame+sendResponse = I.sendBuilder . I.encodeResponse  -- | Send a text message sendTextData :: (I.TextProtocol p, I.WebSocketsData a) => a -> I.WebSockets p ()

@@ -1,54 +0,0 @@--- | Demultiplexing of frames into messages-module Network.WebSockets.Demultiplex-    ( DemultiplexState-    , emptyDemultiplexState-    , demultiplex-    ) where--import Blaze.ByteString.Builder (Builder)-import Data.Monoid (mappend)-import qualified Blaze.ByteString.Builder as B--import Network.WebSockets.Types---- | Internal state used by the demultiplexer-newtype DemultiplexState = DemultiplexState-    { unDemultiplexState :: Maybe (FrameType, Builder)-    }--emptyDemultiplexState :: DemultiplexState-emptyDemultiplexState = DemultiplexState Nothing--demultiplex :: DemultiplexState-            -> Frame-            -> (Maybe (Message p), DemultiplexState)-demultiplex state (Frame fin tp pl) = case tp of-    -- Return control messages immediately, they have no influence on the state-    CloseFrame  -> (Just (ControlMessage (Close pl)), state)-    PingFrame   -> (Just (ControlMessage (Ping pl)), state)-    PongFrame   -> (Just (ControlMessage (Pong pl)), state)-    -- If we're dealing with a continuation...-    ContinuationFrame -> case unDemultiplexState state of-        -- We received a continuation but we don't have any state. Let's ignore-        -- this fragment...-        Nothing -> (Nothing, DemultiplexState Nothing)-        -- Append the payload to the state-        -- TODO: protect against overflows-        Just (amt, b)-            | not fin   -> (Nothing, DemultiplexState (Just (amt, b')))-            | otherwise -> case amt of-                TextFrame   -> (Just (DataMessage (Text m)), e)-                BinaryFrame -> (Just (DataMessage (Binary m)), e)-                _           -> error "Demultiplex.demultiplex: Internal error"-          where-            b' = b `mappend` plb-            m = B.toLazyByteString b'-    TextFrame-        | fin       -> (Just (DataMessage (Text pl)), e)-        | otherwise -> (Nothing, DemultiplexState (Just (TextFrame, plb)))-    BinaryFrame-        | fin       -> (Just (DataMessage (Binary pl)), e)-        | otherwise -> (Nothing, DemultiplexState (Just (BinaryFrame, plb)))-  where-    e = emptyDemultiplexState-    plb = B.fromLazyByteString pl

@@ -2,41 +2,28 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} module Network.WebSockets.Handshake     ( HandshakeError (..)+    , handshake     , responseError-    , tryFinishRequest     ) where +import Data.List (find)+ import qualified Data.ByteString as B+import qualified Data.Enumerator as E  import Network.WebSockets.Handshake.Http import Network.WebSockets.Protocol-import Network.WebSockets.Types --- | Receives and checks the client handshake.--- --- * If this fails, we encountered a syntax error while processing the client's--- request. That is very bad.--- --- * If it returns @Left@, we either don't support the protocol requested by--- the client ('NotSupported') or the data the client sent doesn't match the--- protocol ('MalformedRequest')------ * Otherwise, we are guaranteed that the client handshake is valid and have--- generated a response ready to be sent back.----tryFinishRequest :: Protocol p-                 => RequestHttpPart-                 -> Decoder p (Either HandshakeError (Request, p))-tryFinishRequest httpReq = tryInOrder implementations-    -- NOTE that the protocols are tried in order, the first one first. So that-    -- should be the latest one. (only matters if we have overlaps in specs,-    -- though)-  where-    tryInOrder []       = return . Left $ NotSupported-    tryInOrder (p : ps) = finishRequest p httpReq >>= \res -> case res of-        (Left NotSupported) -> tryInOrder ps-        (Left e)            -> return (Left e)-        (Right req)         -> return . Right $ (req, p)+-- | Receives and checks the client handshake. If no suitable protocol is found+-- (or the client sends garbage), a 'HandshakeError' will be thrown.+handshake :: (Monad m, Protocol p)+          => RequestHttpPart+          -> E.Iteratee B.ByteString m (Request, p)+handshake rhp = case find (flip supported rhp) implementations of+    Nothing -> E.throwError NotSupported+    Just p  -> do+        rq <- finishRequest p rhp+        return (rq, p)  -- | Respond to errors encountered during handshake. First argument may be -- bottom.

@@ -6,6 +6,7 @@     , Request (..)     , Response (..)     , HandshakeError (..)+    , getSecWebSocketVersion     , decodeRequest     , encodeResponse     , response101@@ -18,17 +19,14 @@ import Control.Exception (Exception) import Control.Monad.Error (Error (..)) -import Data.Attoparsec (string, takeWhile1, word8)-import Data.Attoparsec.Combinator (manyTill) import Data.ByteString.Char8 () import Data.ByteString.Internal (c2w)+import qualified Data.Attoparsec as A import qualified Blaze.ByteString.Builder as Builder import qualified Blaze.ByteString.Builder.Char.Utf8 as Builder import qualified Data.ByteString as B import qualified Data.CaseInsensitive as CI -import Network.WebSockets.Types- -- | Request headers type Headers = [(CI.CI B.ByteString, B.ByteString)] @@ -79,28 +77,32 @@  instance Exception HandshakeError +-- | Get the @Sec-WebSocket-Version@ header+getSecWebSocketVersion :: RequestHttpPart -> Maybe B.ByteString+getSecWebSocketVersion p = lookup "Sec-WebSocket-Version" (requestHttpHeaders p)+ -- | Parse an initial request-decodeRequest :: Decoder p RequestHttpPart+decodeRequest :: A.Parser RequestHttpPart decodeRequest = RequestHttpPart     <$> requestLine-    <*> manyTill header newline+    <*> A.manyTill header newline   where-    space = word8 (c2w ' ')-    newline = string "\r\n"+    space   = A.word8 (c2w ' ')+    newline = A.string "\r\n" -    requestLine = string "GET" *> space *> takeWhile1 (/= c2w ' ')+    requestLine = A.string "GET" *> space *> A.takeWhile1 (/= c2w ' ')         <* space-        <* string "HTTP/1.1" <* newline+        <* A.string "HTTP/1.1" <* newline      header = (,)-        <$> (CI.mk <$> takeWhile1 (/= c2w ':'))-        <*  string ": "-        <*> takeWhile1 (/= c2w '\r')+        <$> (CI.mk <$> A.takeWhile1 (/= c2w ':'))+        <*  A.string ": "+        <*> A.takeWhile1 (/= c2w '\r')         <*  newline  -- | Encode an HTTP upgrade response-encodeResponse :: Encoder p Response-encodeResponse _ (Response code msg headers body) =+encodeResponse :: Response -> Builder.Builder+encodeResponse (Response code msg headers body) =     Builder.copyByteString "HTTP/1.1 " `mappend`     Builder.fromString (show code)     `mappend`     Builder.fromChar ' '               `mappend`

@@ -1,40 +0,0 @@-module Network.WebSockets.Handshake.ShyIterParser-    ( shyIterParser-    ) where--import Data.Attoparsec.Enumerator (ParseError(..))-import qualified Data.Attoparsec as A-import qualified Data.ByteString as B-import qualified Data.Enumerator as E---- | Behaves almost the same as the 'iterParser' function from the--- attoparsec-enumerator package, with the exception that, while the iteratee--- created by 'iterParser' always starts in a 'Continue' state, this one will--- only ask for more data if the underlying parser needs it. That's important--- because e.g. network connection will block and wait for more data on a--- 'Continue'. For messages or frames the problem will not occur as we know the--- length of the payload and therefore can determine EOF (= end of the frame--- here).------ We use parsers that don't take data for validation in Protocols.Hybi10-shyIterParser :: (Monad m) => A.Parser a -> E.Iteratee B.ByteString m a-shyIterParser p = parseLoop (A.parse p) [B.empty]-    -- feed empty to the parse *once*.-  where-    -- from here: copied from attoparsec-enumerator-0.2.0.4-    step parse (E.Chunks xs) = parseLoop parse (notEmpty xs)-    step parse E.EOF = case A.feed (parse B.empty) B.empty of-        A.Done _ a -> E.yield a E.EOF-        A.Partial _ -> err [] "iterParser: divergent parser"-        A.Fail _ ctx msg -> err ctx msg--    parseLoop parse [] = E.continue (step parse)-    parseLoop parse (x:xs) = case parse x of-        A.Done extra a -> E.yield a $ if B.null extra-            then E.Chunks xs-            else E.Chunks (extra:xs)-        A.Partial parse' -> parseLoop parse' xs-        A.Fail _ ctx msg -> err ctx msg--    err ctx msg = E.throwError (ParseError ctx msg)-    notEmpty = filter (not . B.null)

@@ -1,34 +0,0 @@--- | Masking of fragmes using a simple XOR algorithm-{-# LANGUAGE BangPatterns #-}-module Network.WebSockets.Mask-    ( Mask-    , maskPayload-    , randomMask-    ) where--import Control.Applicative ((<$>))-import Control.Monad (replicateM)-import Data.Bits (xor)-import System.Random (randomRIO)--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL---- | ByteString should be exactly 4 bytes long-type Mask = Maybe B.ByteString---- | Apply mask-maskPayload :: Mask -> BL.ByteString -> BL.ByteString-maskPayload Nothing     = id-maskPayload (Just mask) = snd . BL.mapAccumL f 0-  where-    len = B.length mask-    f !i !c = let i' = (i + 1) `mod` len-                  m = mask `B.index` i-              in (i', m `xor` c)---- | Create a random mask-randomMask :: IO Mask-randomMask = Just . B.pack <$> replicateM 4 randomByte-  where-    randomByte = fromIntegral <$> randomRIO (0x00 :: Int, 0xff)

@@ -1,5 +1,5 @@ -- | Provides a simple, clean monad to write websocket servers in-{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings,+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,         NoMonomorphismRestriction, Rank2Types, ScopedTypeVariables #-} module Network.WebSockets.Monad     ( WebSocketsOptions (..)@@ -10,8 +10,8 @@     , runWebSocketsHandshake     , runWebSocketsWithHandshake     , runWebSocketsWith'-    , receiveWith-    , sendWith+    , receive+    , sendBuilder     , send     , Sink     , sendSink@@ -26,27 +26,28 @@  import Control.Applicative (Applicative, (<$>)) import Control.Concurrent (forkIO, threadDelay)-import Control.Concurrent.MVar (newMVar, withMVar)+import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar) import Control.Exception (Exception (..), SomeException, throw) import Control.Monad (forever) import Control.Monad.Reader (ReaderT, ask, runReaderT)-import Control.Monad.State (StateT, evalStateT, get) import Control.Monad.Trans (MonadIO, lift, liftIO)+import Data.Foldable (forM_)+import System.Random (newStdGen)  import Blaze.ByteString.Builder (Builder)-import Blaze.ByteString.Builder.Enumerator (builderToByteString) import Data.ByteString (ByteString)-import Data.Enumerator (Enumerator, Iteratee, ($$), (>>==))+import Data.Enumerator (Enumerator, Iteratee, ($$), (>>==), (=$))+import qualified Blaze.ByteString.Builder as BB+import qualified Data.Attoparsec as A+import qualified Data.ByteString.Lazy as BL import qualified Data.Attoparsec.Enumerator as AE import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL -import Network.WebSockets.Demultiplex (DemultiplexState, emptyDemultiplexState) import Network.WebSockets.Handshake import Network.WebSockets.Handshake.Http-import Network.WebSockets.Handshake.ShyIterParser-import Network.WebSockets.Mask import Network.WebSockets.Protocol-import Network.WebSockets.Types as T+import Network.WebSockets.Types  -- | Options for the WebSocket program data WebSocketsOptions = WebSocketsOptions@@ -61,15 +62,20 @@  -- | Environment in which the 'WebSockets' monad actually runs data WebSocketsEnv p = WebSocketsEnv-    { options     :: WebSocketsOptions-    , sendBuilder :: Builder -> IO ()-    , protocol    :: p+    { envOptions     :: WebSocketsOptions+    , envSendBuilder :: Builder -> IO ()+    , envSink        :: Sink p+    , envProtocol    :: p     } +-- | Used for asynchronous sending.+newtype Sink p = Sink+    { unSink :: MVar (E.Iteratee (Message p) IO ())+    }+ -- | The monad in which you can write WebSocket-capable applications newtype WebSockets p a = WebSockets-    { unWebSockets :: ReaderT (WebSocketsEnv p)-        (StateT DemultiplexState (Iteratee ByteString IO)) a+    { unWebSockets :: ReaderT (WebSocketsEnv p) (Iteratee (Message p) IO) a     } deriving (Applicative, Functor, Monad, MonadIO)  -- | Receives the initial client handshake, then behaves like 'runWebSockets'.@@ -112,16 +118,18 @@                   -> (Request -> WebSockets p a)                   -> Iteratee ByteString IO ()                   -> Iteratee ByteString IO a-runWebSocketsWith opts httpReq goWs outIter = do-    mreq <- receiveIterateeShy $ tryFinishRequest httpReq-    case mreq of-        (Left err) -> do-            sendIteratee encodeResponse (responseError proto err) outIter-            E.throwError err-        (Right (r, p)) -> runWebSocketsWith' opts p (goWs r) outIter+runWebSocketsWith opts httpReq goWs outIter = E.catchError ok $ \e -> do+    -- If handshake went bad, send response+    forM_ (fromException e) $ \he ->+        let builder = encodeResponse $ responseError (undefined :: p) he+        in liftIO $ makeBuilderSender outIter builder+    -- Re-throw error+    E.throwError e   where-    proto :: p-    proto = undefined+    -- Perform handshake, call runWebSocketsWith'+    ok = do+        (rq, p) <- handshake httpReq+        runWebSocketsWith' opts p (goWs rq) outIter  runWebSocketsWith' :: Protocol p                    => WebSocketsOptions@@ -130,17 +138,24 @@                    -> Iteratee ByteString IO ()                    -> Iteratee ByteString IO a runWebSocketsWith' opts proto ws outIter = do-    sendLock <- liftIO $ newMVar () +    -- Create sink with a random source+    gen <- liftIO newStdGen+    let sinkIter = encodeMessages proto gen =$ builderToByteString =$ outIter+    sink <- Sink <$> liftIO (newMVar sinkIter) -    let sender = makeSend sendLock-        env    = WebSocketsEnv opts sender proto-        state  = runReaderT (unWebSockets ws) env-        iter   = evalStateT state emptyDemultiplexState-    iter-  where-    makeSend sendLock x = withMVar sendLock $ \_ ->-        builderSender outIter x+    let sender = makeBuilderSender outIter+        env    = WebSocketsEnv opts sender sink proto+        iter   = runReaderT (unWebSockets ws) env +    decodeMessages proto =$ iter++makeBuilderSender :: MonadIO m => Iteratee ByteString m b -> Builder -> m ()+makeBuilderSender outIter x = do+    ok <- E.run $ singleton x $$ builderToByteString $$ outIter+    case ok of+        Left err -> throw err+        Right _  -> return ()+ -- | @spawnPingThread n@ spawns a thread which sends a ping every @n@ seconds -- (if the protocol supports it). To be called after having sent the response. spawnPingThread :: BinaryProtocol p => Int -> WebSockets p ()@@ -154,96 +169,66 @@         sendSink sink $ ping ("Hi" :: ByteString)     return () --- | Receive some data from the socket, using a user-supplied parser.-receiveWith :: Decoder p a -> WebSockets p a-receiveWith = liftIteratee . receiveIteratee---- todo: move some stuff to another module. "Decode"?---- | Underlying iteratee version of 'receiveWith'.-receiveIteratee :: Decoder p a -> Iteratee ByteString IO a+-- | Receive arbitrary data.+receiveIteratee :: A.Parser a -> Iteratee ByteString IO a receiveIteratee parser = do     eof <- E.isEOF     if eof         then E.throwError ConnectionClosed         else wrappingParseError . AE.iterParser $ parser --- | Like receiveIteratee, but if the supplied parser is happy with no input,--- we don't supply any more. This is very, very important when we have parsers--- that don't necessarily read data, like hybi10's completeRequest.-receiveIterateeShy :: Decoder p a -> Iteratee ByteString IO a-receiveIterateeShy parser = wrappingParseError $ shyIterParser parser- -- | Execute an iteratee, wrapping attoparsec-enumeratee's ParseError into the -- ParseError constructor (which is a ConnectionError). wrappingParseError :: (Monad m) => Iteratee a m b -> Iteratee a m b wrappingParseError = flip E.catchError $ \e -> E.throwError $     maybe e (toException . ParseError) $ fromException e -sendIteratee :: Encoder p a -> a-             -> Iteratee ByteString IO ()-             -> Iteratee ByteString IO ()-sendIteratee enc resp outIter = do-    liftIO $ mkSend (builderSender outIter) enc resp+-- | Receive a message+receive :: Protocol p => WebSockets p (Message p)+receive = liftIteratee $ do+    mmsg <- EL.head+    case mmsg of+        Nothing  -> E.throwError ConnectionClosed+        Just msg -> return msg --- | Low-leven sending with an arbitrary 'Encoder'-sendWith :: Encoder p a -> a -> WebSockets p ()-sendWith encoder x = WebSockets $ do-    send' <- sendBuilder <$> ask-    liftIO $ mkSend send' encoder x+-- | Send an arbitrary 'Builder'+sendBuilder :: Builder -> WebSockets p ()+sendBuilder builder = WebSockets $ do+    sb <- envSendBuilder <$> ask+    liftIO $ sb builder  -- | Low-level sending with an arbitrary 'T.Message'-send :: Protocol p => T.Message p -> WebSockets p ()+send :: Protocol p => Message p -> WebSockets p () send msg = getSink >>= \sink -> liftIO $ sendSink sink msg --- | Used for asynchronous sending.-newtype Sink p = Sink {unSink :: Message p -> IO ()}- -- | Send a message to a sink. Might generate an exception if the underlying -- connection is closed. sendSink :: Sink p -> Message p -> IO ()-sendSink = unSink+sendSink sink msg = modifyMVar_ (unSink sink) $ \iter -> do+    step <- E.runIteratee $ singleton msg $$ iter+    return $ E.returnI step  -- | In case the user of the library wants to do asynchronous sending to the -- socket, he can extract a 'Sink' and pass this value around, for example, -- to other threads. getSink :: Protocol p => WebSockets p (Sink p)-getSink = WebSockets $ do-    proto <- unWebSockets getProtocol-    send' <- sendBuilder <$> ask-    return $ Sink $ mkSend send' $ encodeMessage $ encodeFrame proto-  where-    -- TODO: proper multiplexing?-    encodeMessage frame mask msg = frame mask $ case msg of-        (ControlMessage (Close pl)) -> Frame True CloseFrame pl-        (ControlMessage (Ping pl))  -> Frame True PingFrame pl-        (ControlMessage (Pong pl))  -> Frame True PongFrame pl-        (DataMessage (Text pl))     -> Frame True TextFrame pl-        (DataMessage (Binary pl))   -> Frame True BinaryFrame pl---- TODO: rename to mkEncodedSender?-mkSend :: (Builder -> IO ()) -> Encoder p a -> a -> IO ()-mkSend send' encoder x = do-    mask <- randomMask-    send' $ encoder mask x+getSink = WebSockets $ envSink <$> ask  singleton :: Monad m => a -> Enumerator a m b singleton c = E.checkContinue0 $ \_ f -> f (E.Chunks [c]) >>== E.returnI -builderSender :: MonadIO m => Iteratee ByteString m b -> Builder -> m ()-builderSender outIter x = do-    ok <- E.run $ singleton x $$ builderToByteString $$ outIter-    case ok of-        Left err -> throw err-        Right _  -> return ()+-- TODO: Figure out why Blaze.ByteString.Enumerator.builderToByteString doesn't+-- work, then inform Simon or send a patch.+builderToByteString :: Monad m => E.Enumeratee Builder ByteString m a+builderToByteString = EL.concatMap $ BL.toChunks . BB.toLazyByteString  -- | Get the current configuration getOptions :: WebSockets p WebSocketsOptions-getOptions = WebSockets $ ask >>= return . options+getOptions = WebSockets $ ask >>= return . envOptions  -- | Get the underlying protocol getProtocol :: WebSockets p p-getProtocol = WebSockets $ protocol <$> ask+getProtocol = WebSockets $ envProtocol <$> ask  -- | Find out the 'WebSockets' version used at runtime getVersion :: Protocol p => WebSockets p String@@ -259,14 +244,12 @@              -> WebSockets p a catchWsError act c = WebSockets $ do     env <- ask-    state <- get-    let it  = peelWebSockets state env $ act-        cit = peelWebSockets state env . c-    lift . lift $ it `E.catchError` cit+    let it  = peelWebSockets env $ act+        cit = peelWebSockets env . c+    lift $ it `E.catchError` cit   where-    peelWebSockets state env =-        flip evalStateT state . flip runReaderT env . unWebSockets+    peelWebSockets env = flip runReaderT env . unWebSockets  -- | Lift an Iteratee computation to WebSockets-liftIteratee :: Iteratee ByteString IO a -> WebSockets p a-liftIteratee = WebSockets . lift . lift+liftIteratee :: Iteratee (Message p) IO a -> WebSockets p a+liftIteratee = WebSockets . lift

@@ -11,7 +11,10 @@     , binaryData     ) where +import Blaze.ByteString.Builder (Builder)+import System.Random (RandomGen) import qualified Data.ByteString as B+import qualified Data.Enumerator as E  import Network.WebSockets.Types import Network.WebSockets.Handshake.Http@@ -26,16 +29,32 @@     -- "7", "8" or "17".     headerVersions  :: p -> [B.ByteString] -    encodeFrame     :: p -> Encoder p Frame-    decodeFrame     :: p -> Decoder p Frame+    -- | Determine if the protocol is compatible with a requested version. A+    -- default implementation exists which uses the @headerVersions@ of the+    -- protocol.+    supported       :: p -> RequestHttpPart -> Bool+    supported p h   = case getSecWebSocketVersion h of+        Just v -> v `elem` headerVersions p+        _      -> False +    -- | Encodes messages to binary 'Builder's. Takes a random source so it is+    -- able to do masking of frames (needed in some cases).+    encodeMessages  :: (Monad m, RandomGen g)+                    => p+                    -> g+                    -> E.Enumeratee (Message p) Builder m a++    -- | Decodes messages from binary 'B.ByteString's.+    decodeMessages  :: Monad m => p -> E.Enumeratee B.ByteString (Message p) m a+     -- | Parse and validate the rest of the request. For hybi10, this is just     -- validation, but hybi00 also needs to fetch a "security token"     ---    -- Todo: Maybe we should introduce our own simplified error type here. (to+    -- In case of failure, this function may throw a 'HandshakeError'.     -- be amended with the RequestHttpPart for the user)-    finishRequest   :: p -> RequestHttpPart-                    -> Decoder p (Either HandshakeError Request)+    finishRequest   :: Monad m+                    => p -> RequestHttpPart+                    -> E.Iteratee B.ByteString m Request      -- | Implementations of the specification     implementations :: [p]

@@ -4,18 +4,22 @@        , Hybi00        ) where +import Data.Enumerator ((=$))+import Data.Enumerator.List as EL import Network.WebSockets.Protocol import Network.WebSockets.Protocol.Hybi00.Internal import Network.WebSockets.Protocol.Hybi10.Internal+import Network.WebSockets.Protocol.Unsafe  data Hybi00 = forall p. Protocol p => Hybi00 p  instance Protocol Hybi00 where-    version        (Hybi00 p) = version p-    headerVersions (Hybi00 p) = headerVersions p-    encodeFrame    (Hybi00 p) = encodeFrame p-    decodeFrame    (Hybi00 p) = decodeFrame p-    finishRequest  (Hybi00 p) = finishRequest p-    implementations           = [Hybi00 Hybi10_, Hybi00 Hybi00_]+    version        (Hybi00 p)   = version p+    headerVersions (Hybi00 p)   = headerVersions p+    supported      (Hybi00 p) h = supported p h+    encodeMessages (Hybi00 p) g = (EL.map castMessage =$) . encodeMessages p g+    decodeMessages (Hybi00 p)   = (decodeMessages p =$) . EL.map castMessage+    finishRequest  (Hybi00 p)   = finishRequest p+    implementations             = [Hybi00 Hybi10_, Hybi00 Hybi00_]  instance TextProtocol Hybi00

@@ -5,8 +5,6 @@        ) where  import Control.Applicative ((<|>))-import Control.Monad.Error (ErrorT (..), MonadError, throwError)-import Control.Monad.Trans (lift) import Data.Char (isDigit)  import Data.Binary (encode)@@ -14,10 +12,10 @@ import Data.Int (Int32) import qualified Blaze.ByteString.Builder as BB import qualified Data.Attoparsec as A-#if MIN_VERSION_attoparsec(0,10,0)-import qualified Data.Attoparsec.Types as AT-#endif+import qualified Data.Attoparsec.Enumerator as A import qualified Data.ByteString as B+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import qualified Data.CaseInsensitive as CI@@ -29,35 +27,37 @@ data Hybi00_ = Hybi00_  instance Protocol Hybi00_ where-    version         Hybi00_ = "hybi00"-    headerVersions  Hybi00_ = ["0"]  -- but the client will elide it-    encodeFrame     Hybi00_ = encodeFrameHybi00-    decodeFrame     Hybi00_ = decodeFrameHybi00-    finishRequest   Hybi00_ = runErrorT . handshakeHybi00-    implementations         = [Hybi00_]+    version         Hybi00_   = "hybi00"+    headerVersions  Hybi00_   = []  -- The client will elide it+    supported       Hybi00_ h = getSecWebSocketVersion h == Nothing+    encodeMessages  Hybi00_ _ = EL.map encodeMessage+    decodeMessages  Hybi00_   = E.sequence (A.iterParser parseMessage)+    finishRequest   Hybi00_   = handshakeHybi00+    implementations           = [Hybi00_]  instance TextProtocol Hybi00_ -encodeFrameHybi00 :: Encoder p Frame-encodeFrameHybi00 _ (Frame True TextFrame pl) =+encodeMessage :: Message p -> BB.Builder+encodeMessage (DataMessage (Text pl))    =     BB.fromLazyByteString $ "\0" `BL.append` pl `BL.append` "\255"-encodeFrameHybi00 _ (Frame _ CloseFrame _) =+encodeMessage (ControlMessage (Close _)) =     BB.fromLazyByteString  "\255\0"-    -- TODO: prevent the user from doing this using type tags-encodeFrameHybi00 _ _ = error "Not supported"+encodeMessage msg                        = error $+    "Network.WebSockets.Protocol.Hybi00.encodeFrame: unsupported message: " +++    show msg -decodeFrameHybi00 :: Decoder p Frame-decodeFrameHybi00 = decodeTextFrame <|> decodeCloseFrame+parseMessage :: A.Parser (Message p)+parseMessage = parseText <|> parseClose   where-    decodeTextFrame = do+    parseText = do         _ <- A.word8 0x00         utf8string <- A.manyTill A.anyWord8 (A.try $ A.word8 0xff)-        return $ Frame True TextFrame $ BL.pack utf8string+        return $ DataMessage $ Text $ BL.pack utf8string -    decodeCloseFrame = do+    parseClose = do         _ <- A.word8 0xff         _ <- A.word8 0x00-        return $ Frame True CloseFrame ""+        return $ ControlMessage $ Close ""  divBySpaces :: String -> Maybe Int32 divBySpaces str@@ -67,22 +67,11 @@     number = read $ filter isDigit str :: Integer     spaces = fromIntegral . length $ filter (== ' ') str -handshakeHybi00 :: RequestHttpPart-#if MIN_VERSION_attoparsec(0,10,0)-                -> ErrorT HandshakeError (AT.Parser B.ByteString) Request-#else-                -> ErrorT HandshakeError A.Parser Request-#endif+handshakeHybi00 :: Monad m+                => RequestHttpPart+                -> E.Iteratee B.ByteString m Request handshakeHybi00 reqHttp@(RequestHttpPart path h) = do-    -- _ <- lift . A.word8 $ fromIntegral 0x0d-    -- _ <- lift . A.word8 $ fromIntegral 0x0a--    case getHeader "Sec-WebSocket-Version" of-        Left _    -> return ()-        Right "0" -> return ()-        Right _   -> throwError NotSupported--    keyPart3 <- lift $ A.take 8+    keyPart3 <- A.iterParser $ A.take 8     keyPart1 <- numberFromToken =<< getHeader "Sec-WebSocket-Key1"     keyPart2 <- numberFromToken =<< getHeader "Sec-WebSocket-Key2" @@ -102,10 +91,10 @@   where     getHeader k = case lookup k h of         Just t  -> return t-        Nothing -> throwError $ MalformedRequest reqHttp $+        Nothing -> E.throwError $ MalformedRequest reqHttp $             "Header missing: " ++ BC.unpack (CI.original k)      numberFromToken token = case divBySpaces (BC.unpack token) of         Just n  -> return $ encode n-        Nothing -> throwError $ MalformedRequest reqHttp+        Nothing -> E.throwError $ MalformedRequest reqHttp             "Security token does not contain enough spaces"

@@ -3,18 +3,22 @@     ( Hybi10     ) where +import Data.Enumerator ((=$))+import Data.Enumerator.List as EL import Network.WebSockets.Protocol import Network.WebSockets.Protocol.Hybi10.Internal+import Network.WebSockets.Protocol.Unsafe  data Hybi10 = forall p. Protocol p => Hybi10 p  instance Protocol Hybi10 where-    version        (Hybi10 p) = version p-    headerVersions (Hybi10 p) = headerVersions p-    encodeFrame    (Hybi10 p) = encodeFrame p-    decodeFrame    (Hybi10 p) = decodeFrame p-    finishRequest  (Hybi10 p) = finishRequest p-    implementations           = [Hybi10 Hybi10_]+    version        (Hybi10 p)   = version p+    headerVersions (Hybi10 p)   = headerVersions p+    supported      (Hybi10 p) h = supported p h+    encodeMessages (Hybi10 p) g = (EL.map castMessage =$) . encodeMessages p g+    decodeMessages (Hybi10 p)   = (decodeMessages p =$) . EL.map castMessage+    finishRequest  (Hybi10 p)   = finishRequest p+    implementations             = [Hybi10 Hybi10_]  instance TextProtocol Hybi10 instance BinaryProtocol Hybi10

@@ -0,0 +1,74 @@+-- | Demultiplexing of frames into messages+module Network.WebSockets.Protocol.Hybi10.Demultiplex+    ( FrameType (..)+    , Frame (..)+    , DemultiplexState+    , emptyDemultiplexState+    , demultiplex+    ) where++import Blaze.ByteString.Builder (Builder)+import Data.Monoid (mappend)+import qualified Blaze.ByteString.Builder as B+import qualified Data.ByteString.Lazy as BL++import Network.WebSockets.Types++-- | A low-level representation of a WebSocket packet+data Frame = Frame+    { frameFin     :: !Bool+    , frameType    :: !FrameType+    , framePayload :: !BL.ByteString+    } deriving (Eq, Show)++-- | The type of a frame. Not all types are allowed for all protocols.+data FrameType+    = ContinuationFrame+    | TextFrame+    | BinaryFrame+    | CloseFrame+    | PingFrame+    | PongFrame+    deriving (Eq, Show)++-- | Internal state used by the demultiplexer+newtype DemultiplexState = DemultiplexState+    { unDemultiplexState :: Maybe (FrameType, Builder)+    }++emptyDemultiplexState :: DemultiplexState+emptyDemultiplexState = DemultiplexState Nothing++demultiplex :: DemultiplexState+            -> Frame+            -> (Maybe (Message p), DemultiplexState)+demultiplex state (Frame fin tp pl) = case tp of+    -- Return control messages immediately, they have no influence on the state+    CloseFrame  -> (Just (ControlMessage (Close pl)), state)+    PingFrame   -> (Just (ControlMessage (Ping pl)), state)+    PongFrame   -> (Just (ControlMessage (Pong pl)), state)+    -- If we're dealing with a continuation...+    ContinuationFrame -> case unDemultiplexState state of+        -- We received a continuation but we don't have any state. Let's ignore+        -- this fragment...+        Nothing -> (Nothing, DemultiplexState Nothing)+        -- Append the payload to the state+        -- TODO: protect against overflows+        Just (amt, b)+            | not fin   -> (Nothing, DemultiplexState (Just (amt, b')))+            | otherwise -> case amt of+                TextFrame   -> (Just (DataMessage (Text m)), e)+                BinaryFrame -> (Just (DataMessage (Binary m)), e)+                _           -> error "Demultiplex.demultiplex: Internal error"+          where+            b' = b `mappend` plb+            m = B.toLazyByteString b'+    TextFrame+        | fin       -> (Just (DataMessage (Text pl)), e)+        | otherwise -> (Nothing, DemultiplexState (Just (TextFrame, plb)))+    BinaryFrame+        | fin       -> (Just (DataMessage (Binary pl)), e)+        | otherwise -> (Nothing, DemultiplexState (Just (BinaryFrame, plb)))+  where+    e = emptyDemultiplexState+    plb = B.fromLazyByteString pl

@@ -1,30 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} module Network.WebSockets.Protocol.Hybi10.Internal     ( Hybi10_ (..)+    , encodeFrameHybi10     ) where  import Control.Applicative (pure, (<$>)) import Data.Bits ((.&.), (.|.))-import Data.Monoid (mempty)+import Data.Maybe (maybeToList)+import Data.Monoid (mempty, mappend, mconcat)+import System.Random (RandomGen)  import Data.Attoparsec (anyWord8) import Data.Binary.Get (runGet, getWord16be, getWord64be) import Data.ByteString (ByteString) import Data.ByteString.Char8 ()+import Data.Digest.Pure.SHA (bytestringDigest, sha1) import Data.Int (Int64)+import Data.Enumerator ((=$)) import qualified Blaze.ByteString.Builder as B import qualified Data.Attoparsec as A-import qualified Data.ByteString.Lazy as BL-import Data.Digest.Pure.SHA (bytestringDigest, sha1)+import qualified Data.Attoparsec.Enumerator as A import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL import qualified Data.CaseInsensitive as CI-import Control.Monad.Error (throwError)-import Data.Monoid (mappend, mconcat)+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL  import Network.WebSockets.Handshake.Http-import Network.WebSockets.Mask import Network.WebSockets.Protocol+import Network.WebSockets.Protocol.Hybi10.Demultiplex+import Network.WebSockets.Protocol.Hybi10.Mask import Network.WebSockets.Types  data Hybi10_ = Hybi10_@@ -32,17 +38,64 @@ instance Protocol Hybi10_ where     version         Hybi10_ = "hybi10"     headerVersions  Hybi10_ = ["13", "8", "7"]-    encodeFrame     Hybi10_ = encodeFrameHybi10-    decodeFrame     Hybi10_ = decodeFrameHybi10+    encodeMessages  Hybi10_ = EL.mapAccum encodeMessageHybi10+    decodeMessages  Hybi10_ = decodeMessagesHybi10     finishRequest   Hybi10_ = handshakeHybi10     implementations         = [Hybi10_]  instance TextProtocol Hybi10_ instance BinaryProtocol Hybi10_ +encodeMessageHybi10 :: RandomGen g => g -> Message p -> (g, B.Builder)+encodeMessageHybi10 gen msg = (gen', builder)+  where+    (mask, gen') = randomMask gen+    builder      = encodeFrameHybi10 mask $ case msg of+        (ControlMessage (Close pl)) -> Frame True CloseFrame pl+        (ControlMessage (Ping pl))  -> Frame True PingFrame pl+        (ControlMessage (Pong pl))  -> Frame True PongFrame pl+        (DataMessage (Text pl))     -> Frame True TextFrame pl+        (DataMessage (Binary pl))   -> Frame True BinaryFrame pl++-- | Encode a frame+encodeFrameHybi10 :: Mask -> Frame -> B.Builder+encodeFrameHybi10 mask f = B.fromWord8 byte0 `mappend`+    B.fromWord8 byte1 `mappend` len `mappend` maskbytes `mappend`+    B.fromLazyByteString (maskPayload mask (framePayload f))+  where+    byte0  = fin .|. opcode+    fin    = if frameFin f then 0x80 else 0x00+    opcode = case frameType f of+        ContinuationFrame -> 0x00+        TextFrame         -> 0x01+        BinaryFrame       -> 0x02+        CloseFrame        -> 0x08+        PingFrame         -> 0x09+        PongFrame         -> 0x0a++    (maskflag, maskbytes) = case mask of+        Nothing -> (0x00, mempty)+        Just m  -> (0x80, B.fromByteString m)++    byte1 = maskflag .|. lenflag+    len'  = BL.length (framePayload f)+    (lenflag, len)+        | len' < 126     = (fromIntegral len', mempty)+        | len' < 0x10000 = (126, B.fromWord16be (fromIntegral len'))+        | otherwise      = (127, B.fromWord64be (fromIntegral len'))++decodeMessagesHybi10 :: Monad m => E.Enumeratee ByteString (Message p) m a+decodeMessagesHybi10 =+    (E.sequence (A.iterParser parseFrame) =$) . demultiplexEnum++demultiplexEnum :: Monad m => E.Enumeratee Frame (Message p) m a+demultiplexEnum = EL.concatMapAccum step emptyDemultiplexState+  where+    step s f = let (m, s') = demultiplex s f in (s', maybeToList m)+ -- | Parse a frame-decodeFrameHybi10 :: Decoder p Frame-decodeFrameHybi10 = do+parseFrame :: A.Parser Frame+parseFrame = do     byte0 <- anyWord8     let fin = byte0 .&. 0x80 == 0x80         opcode = byte0 .&. 0x0f@@ -73,7 +126,7 @@   where     runGet' g = runGet g . BL.fromChunks . return -    take64 :: Int64 -> Decoder p [ByteString]+    take64 :: Int64 -> A.Parser [ByteString]     take64 n         | n <= 0    = return []         | otherwise = do@@ -84,41 +137,10 @@         intMax :: Int64         intMax = fromIntegral (maxBound :: Int) --- | Encode a frame-encodeFrameHybi10 :: Encoder p Frame-encodeFrameHybi10 mask f = B.fromWord8 byte0 `mappend`-    B.fromWord8 byte1 `mappend` len `mappend` maskbytes `mappend`-    B.fromLazyByteString (maskPayload mask (framePayload f))-  where-    byte0  = fin .|. opcode-    fin    = if frameFin f then 0x80 else 0x00-    opcode = case frameType f of-        ContinuationFrame -> 0x00-        TextFrame         -> 0x01-        BinaryFrame       -> 0x02-        CloseFrame        -> 0x08-        PingFrame         -> 0x09-        PongFrame         -> 0x0a--    (maskflag, maskbytes) = case mask of-        Nothing -> (0x00, mempty)-        Just m  -> (0x80, B.fromByteString m)--    byte1 = maskflag .|. lenflag-    len'  = BL.length (framePayload f)-    (lenflag, len)-        | len' < 126     = (fromIntegral len', mempty)-        | len' < 0x10000 = (126, B.fromWord16be (fromIntegral len'))-        | otherwise      = (127, B.fromWord64be (fromIntegral len'))---handshakeHybi10 :: RequestHttpPart -> Decoder p (Either HandshakeError Request)-handshakeHybi10 reqHttp@(RequestHttpPart path h) = return $ do-    case getHeader "Sec-WebSocket-Version" of-        Right "7"  -> return ()-        Right "8"  -> return ()-        Right "13" -> return ()-        _          -> throwError NotSupported+handshakeHybi10 :: Monad m+                => RequestHttpPart+                -> E.Iteratee ByteString m Request+handshakeHybi10 reqHttp@(RequestHttpPart path h) = do     key <- getHeader "Sec-WebSocket-Key"     let hash = unlazy $ bytestringDigest $ sha1 $ lazy $ key `mappend` guid     let encoded = B64.encode hash@@ -129,6 +151,5 @@     unlazy = mconcat . BL.toChunks     getHeader k = case lookup k h of         Just t  -> return t-        Nothing -> throwError $-                   MalformedRequest reqHttp $ -                   "Header missing: " ++ BC.unpack (CI.original k)+        Nothing -> E.throwError $ MalformedRequest reqHttp $ +            "Header missing: " ++ BC.unpack (CI.original k)

@@ -0,0 +1,36 @@+-- | Masking of fragmes using a simple XOR algorithm+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}+module Network.WebSockets.Protocol.Hybi10.Mask+    ( Mask+    , maskPayload+    , randomMask+    ) where++import Data.Bits (shiftR, xor)+import System.Random (RandomGen, random)++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++-- | ByteString should be exactly 4 bytes long+type Mask = Maybe B.ByteString++-- | Apply mask+maskPayload :: Mask -> BL.ByteString -> BL.ByteString+maskPayload Nothing     = id+maskPayload (Just mask) = snd . BL.mapAccumL f 0+  where+    len = B.length mask+    f !i !c = let i' = (i + 1) `mod` len+                  m = mask `B.index` i+              in (i', m `xor` c)++-- | Create a random mask+randomMask :: forall g. RandomGen g => g -> (Mask, g)+randomMask gen = (Just (B.pack [b1, b2, b3, b4]), gen')+  where+    (!int, !gen') = random gen :: (Int, g)+    !b1           = fromIntegral $ int `mod` 0x100+    !b2           = fromIntegral $ int `shiftR` 8  `mod` 0x100+    !b3           = fromIntegral $ int `shiftR` 16 `mod` 0x100+    !b4           = fromIntegral $ int `shiftR` 24 `mod` 0x100

@@ -1,5 +1,6 @@ module Network.WebSockets.Protocol.Unsafe-    ( close+    ( castMessage+    , close     , ping     , pong     , textData@@ -7,6 +8,16 @@     ) where  import Network.WebSockets.Types++castMessage :: Message p1 -> Message p2+castMessage (ControlMessage m) = ControlMessage $ case m of+    Close b -> Close b+    Ping b  -> Ping b+    Pong b  -> Pong b+castMessage (DataMessage m)    = DataMessage $ case m of+    Text b   -> Text b+    Binary b -> Binary b+{-# INLINE castMessage #-}  close :: WebSocketsData a => a -> Message p close = ControlMessage . Close . toLazyByteString

@@ -78,8 +78,8 @@   where     go (E.Chunks []) = E.continue go     go (E.Chunks cs) = do-      b <- liftIO $ S.sIsWritable s-      if b-        then E.tryIO (SB.sendMany s cs) >> E.continue go-        else E.throwError ConnectionClosed-    go E.EOF         = E.yield () E.EOF+        b <- liftIO $ S.sIsWritable s+        if b+            then E.tryIO (SB.sendMany s cs) >> E.continue go+            else E.throwError ConnectionClosed+    go E.EOF         = E.continue go

@@ -3,12 +3,7 @@  -- | Primary types module Network.WebSockets.Types-    ( Decoder-    , Encoder--    , FrameType (..)-    , Frame (..)-    , Message (..)+    ( Message (..)     , ControlMessage (..)     , DataMessage (..)     , WebSocketsData (..)@@ -19,8 +14,6 @@ import Control.Exception (Exception(..)) import Data.Typeable (Typeable) -import Data.Attoparsec (Parser)-import qualified Blaze.ByteString.Builder as B import qualified Data.Attoparsec.Enumerator as AE import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -28,14 +21,6 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -import Network.WebSockets.Mask---- | An alias so we don't have to import attoparsec everywhere-type Decoder p a = Parser a---- | The inverse of a parser-type Encoder p a = Mask -> a -> B.Builder- -- | The connection couldn't be established or broke down unexpectedly. thrown -- as an iteratee exception. data ConnectionError@@ -49,23 +34,6 @@     deriving (Show, Typeable)  instance Exception ConnectionError---- | A low-level representation of a WebSocket packet-data Frame = Frame-    { frameFin     :: !Bool-    , frameType    :: !FrameType-    , framePayload :: !BL.ByteString-    } deriving (Eq, Show)---- | The type of a frame. Not all types are allowed for all protocols.-data FrameType-    = ContinuationFrame-    | TextFrame-    | BinaryFrame-    | CloseFrame-    | PingFrame-    | PongFrame-    deriving (Eq, Show)  -- | The kind of message a server application typically deals with data Message p

@@ -1,5 +1,5 @@ Name:    websockets-Version: 0.4.1.0+Version: 0.5.0.0  Synopsis:   A sensible and clean way to write WebSocket-capable servers in Haskell.@@ -47,17 +47,16 @@     Network.WebSockets    Other-modules:-    Network.WebSockets.Demultiplex     Network.WebSockets.Handshake     Network.WebSockets.Handshake.Http-    Network.WebSockets.Handshake.ShyIterParser-    Network.WebSockets.Mask     Network.WebSockets.Monad     Network.WebSockets.Protocol     Network.WebSockets.Protocol.Hybi00     Network.WebSockets.Protocol.Hybi00.Internal     Network.WebSockets.Protocol.Hybi10+    Network.WebSockets.Protocol.Hybi10.Demultiplex     Network.WebSockets.Protocol.Hybi10.Internal+    Network.WebSockets.Protocol.Hybi10.Mask     Network.WebSockets.Protocol.Unsafe     Network.WebSockets.Socket     Network.WebSockets.Types