websockets 0.7.3.0 → 0.7.4.0
raw patch · 9 files changed
+85/−58 lines, 9 filesdep ~binary
Dependency ranges changed: binary
Files
- src/Network/WebSockets/Client.hs +1/−1
- src/Network/WebSockets/Monad.hs +12/−8
- src/Network/WebSockets/Protocol.hs +5/−2
- src/Network/WebSockets/Protocol/Hybi00.hs +10/−9
- src/Network/WebSockets/Protocol/Hybi00/Internal.hs +9/−9
- src/Network/WebSockets/Protocol/Hybi10.hs +10/−9
- src/Network/WebSockets/Protocol/Hybi10/Internal.hs +22/−16
- src/Network/WebSockets/Protocol/Hybi10/Mask.hs +13/−1
- websockets.cabal +3/−3
src/Network/WebSockets/Client.hs view
@@ -102,4 +102,4 @@ liftIO $ makeBuilderSender outIter $ encodeRequestHttpPart request response <- receiveIteratee decodeResponse _ <- finishResponse protocol request response- runWebSocketsWith' defaultWebSocketsOptions protocol ws outIter+ runWebSocketsWith' defaultWebSocketsOptions protocol True ws outIter
src/Network/WebSockets/Monad.hs view
@@ -34,6 +34,7 @@ import Control.Monad.Reader (ReaderT, ask, runReaderT) import Control.Monad.Trans (MonadIO, lift, liftIO) import Data.Foldable (forM_)+import System.Random (newStdGen) import Blaze.ByteString.Builder (Builder) import Data.ByteString (ByteString)@@ -132,17 +133,20 @@ -- Perform handshake, call runWebSocketsWith' ok = do (rq, p) <- handshake httpReq- runWebSocketsWith' opts p (goWs rq) outIter+ runWebSocketsWith' opts p False (goWs rq) outIter runWebSocketsWith' :: Protocol p- => WebSocketsOptions- -> p- -> WebSockets p a- -> Iteratee ByteString IO ()- -> Iteratee ByteString IO a-runWebSocketsWith' opts proto ws outIter = do+ => WebSocketsOptions -- ^ Options+ -> p -- ^ Protocol+ -> Bool -- ^ Need to mask+ -> WebSockets p a -- ^ App+ -> Iteratee ByteString IO () -- ^ Out iteratee+ -> Iteratee ByteString IO a -- ^ Resulting iteratee+runWebSocketsWith' opts proto mask ws outIter = do -- Create sink with a random source- let sinkIter = encodeMessages proto =$ builderToByteString =$ outIter+ gen <- liftIO newStdGen+ let sinkIter =+ encodeMessages proto mask gen =$ builderToByteString =$ outIter sink <- Sink <$> liftIO (newMVar sinkIter) let sender = makeBuilderSender outIter
src/Network/WebSockets/Protocol.hs view
@@ -12,6 +12,7 @@ ) where import Blaze.ByteString.Builder (Builder)+import System.Random (RandomGen) import qualified Data.ByteString as B import qualified Data.Enumerator as E @@ -38,8 +39,10 @@ -- | 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- => p+ encodeMessages :: (Monad m, RandomGen g)+ => p -- ^ Protocol+ -> Bool -- ^ Mask messages+ -> g -- ^ Random source -> E.Enumeratee (Message p) Builder m a -- | Decodes messages from binary 'B.ByteString's.
src/Network/WebSockets/Protocol/Hybi00.hs view
@@ -14,14 +14,15 @@ data Hybi00 = forall p. Protocol p => Hybi00 p instance Protocol Hybi00 where- version (Hybi00 p) = version p- headerVersions (Hybi00 p) = headerVersions p- supported (Hybi00 p) h = supported p h- encodeMessages (Hybi00 p) = (EL.map castMessage =$) . encodeMessages p- decodeMessages (Hybi00 p) = (decodeMessages p =$) . EL.map castMessage- createRequest (Hybi00 p) = createRequest p- finishRequest (Hybi00 p) = finishRequest p- finishResponse (Hybi00 p) = finishResponse 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) m g =+ (EL.map castMessage =$) . encodeMessages p m g+ decodeMessages (Hybi00 p) = (decodeMessages p =$) . EL.map castMessage+ createRequest (Hybi00 p) = createRequest p+ finishRequest (Hybi00 p) = finishRequest p+ finishResponse (Hybi00 p) = finishResponse p+ implementations = [Hybi00 Hybi10_, Hybi00 Hybi00_] instance TextProtocol Hybi00
src/Network/WebSockets/Protocol/Hybi00/Internal.hs view
@@ -28,15 +28,15 @@ data Hybi00_ = Hybi00_ instance Protocol Hybi00_ where- 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)- createRequest Hybi00_ = error "createRequest Hybi00_"- finishRequest Hybi00_ = handshakeHybi00- finishResponse Hybi00_ = error "finishResponse Hybi00_"- 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)+ createRequest Hybi00_ = error "createRequest Hybi00_"+ finishRequest Hybi00_ = handshakeHybi00+ finishResponse Hybi00_ = error "finishResponse Hybi00_"+ implementations = [Hybi00_] instance TextProtocol Hybi00_
src/Network/WebSockets/Protocol/Hybi10.hs view
@@ -12,15 +12,16 @@ data Hybi10 = forall p. Protocol p => Hybi10 p instance Protocol Hybi10 where- version (Hybi10 p) = version p- headerVersions (Hybi10 p) = headerVersions p- supported (Hybi10 p) h = supported p h- encodeMessages (Hybi10 p) = (EL.map castMessage =$) . encodeMessages p- decodeMessages (Hybi10 p) = (decodeMessages p =$) . EL.map castMessage- createRequest (Hybi10 p) = createRequest p- finishRequest (Hybi10 p) = finishRequest p- finishResponse (Hybi10 p) = finishResponse p- implementations = [Hybi10 Hybi10_]+ version (Hybi10 p) = version p+ headerVersions (Hybi10 p) = headerVersions p+ supported (Hybi10 p) h = supported p h+ encodeMessages (Hybi10 p) m g =+ (EL.map castMessage =$) . encodeMessages p m g+ decodeMessages (Hybi10 p) = (decodeMessages p =$) . EL.map castMessage+ createRequest (Hybi10 p) = createRequest p+ finishRequest (Hybi10 p) = finishRequest p+ finishResponse (Hybi10 p) = finishResponse p+ implementations = [Hybi10 Hybi10_] instance TextProtocol Hybi10 instance BinaryProtocol Hybi10
src/Network/WebSockets/Protocol/Hybi10/Internal.hs view
@@ -9,6 +9,7 @@ import Data.Bits ((.&.), (.|.)) 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)@@ -36,23 +37,24 @@ data Hybi10_ = Hybi10_ instance Protocol Hybi10_ where- version Hybi10_ = "hybi10"- headerVersions Hybi10_ = ["13", "8", "7"]- encodeMessages Hybi10_ = EL.map encodeMessageHybi10- decodeMessages Hybi10_ = decodeMessagesHybi10- createRequest Hybi10_ = createRequestHybi10- finishRequest Hybi10_ = handshakeHybi10- finishResponse Hybi10_ = finishResponseHybi10- implementations = [Hybi10_]+ version Hybi10_ = "hybi10"+ headerVersions Hybi10_ = ["13", "8", "7"]+ encodeMessages Hybi10_ m = EL.mapAccum (encodeMessageHybi10 m)+ decodeMessages Hybi10_ = decodeMessagesHybi10+ createRequest Hybi10_ = createRequestHybi10+ finishRequest Hybi10_ = handshakeHybi10+ finishResponse Hybi10_ = finishResponseHybi10+ implementations = [Hybi10_] instance TextProtocol Hybi10_ instance BinaryProtocol Hybi10_ -encodeMessageHybi10 :: Message p -> B.Builder-encodeMessageHybi10 msg = builder+encodeMessageHybi10 :: RandomGen g => Bool -> g -> Message p -> (g, B.Builder)+encodeMessageHybi10 needMask gen msg = (gen', builder) where mkFrame = Frame True False False False- builder = encodeFrameHybi10 $ case msg of+ (mask, gen') = if needMask then randomMask gen else (Nothing, gen)+ builder = encodeFrameHybi10 mask $ case msg of (ControlMessage (Close pl)) -> mkFrame CloseFrame pl (ControlMessage (Ping pl)) -> mkFrame PingFrame pl (ControlMessage (Pong pl)) -> mkFrame PongFrame pl@@ -60,10 +62,10 @@ (DataMessage (Binary pl)) -> mkFrame BinaryFrame pl -- | Encode a frame-encodeFrameHybi10 :: Frame -> B.Builder-encodeFrameHybi10 f = B.fromWord8 byte0 `mappend`- B.fromWord8 byte1 `mappend` len `mappend`- B.fromLazyByteString (framePayload f)+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 .|. rsv1 .|. rsv2 .|. rsv3 .|. opcode fin = if frameFin f then 0x80 else 0x00@@ -78,7 +80,11 @@ PingFrame -> 0x09 PongFrame -> 0x0a - byte1 = lenflag+ (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)
src/Network/WebSockets/Protocol/Hybi10/Mask.hs view
@@ -3,9 +3,11 @@ module Network.WebSockets.Protocol.Hybi10.Mask ( Mask , maskPayload+ , randomMask ) where -import Data.Bits (xor)+import Data.Bits (shiftR, xor)+import System.Random (RandomGen, random) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -22,3 +24,13 @@ 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
websockets.cabal view
@@ -1,5 +1,5 @@ Name: websockets-Version: 0.7.3.0+Version: 0.7.4.0 Synopsis: A sensible and clean way to write WebSocket-capable servers in Haskell.@@ -69,7 +69,7 @@ attoparsec-enumerator >= 0.2 && < 0.4, base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1,- binary >= 0.5 && < 0.7,+ binary >= 0.5 && < 0.8, blaze-builder >= 0.3 && < 0.4, blaze-builder-enumerator >= 0.2 && < 0.3, bytestring >= 0.9 && < 0.11,@@ -102,7 +102,7 @@ attoparsec-enumerator >= 0.2 && < 0.4, base >= 4 && < 5, base64-bytestring >= 0.1 && < 1.1,- binary >= 0.5 && < 0.7,+ binary >= 0.5 && < 0.8, blaze-builder >= 0.3 && < 0.4, blaze-builder-enumerator >= 0.2 && < 0.3, bytestring >= 0.9 && < 0.11,