packages feed

websockets 0.6.0.4 → 0.7.0.0

raw patch · 13 files changed

+324/−77 lines, 13 filesdep +entropydep ~QuickCheckdep ~base64-bytestringdep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: entropy

Dependency ranges changed: QuickCheck, base64-bytestring, bytestring

API changes (from Hackage documentation)

- Network.WebSockets: Response :: !Int -> !ByteString -> Headers -> ByteString -> Response
- Network.WebSockets: data Response
- Network.WebSockets: responseBody :: Response -> ByteString
- Network.WebSockets: responseCode :: Response -> !Int
- Network.WebSockets: responseHeaders :: Response -> Headers
- Network.WebSockets: responseMessage :: Response -> !ByteString
+ Network.WebSockets: MalformedResponse :: ResponseHttpPart -> String -> HandshakeError
+ Network.WebSockets: RequestBody :: RequestHttpPart -> ByteString -> RequestBody
+ Network.WebSockets: ResponseBody :: ResponseHttpPart -> ByteString -> ResponseBody
+ Network.WebSockets: ResponseHttpPart :: !Int -> !ByteString -> Headers -> ResponseHttpPart
+ Network.WebSockets: connect :: Protocol p => String -> Int -> String -> WebSockets p a -> IO a
+ Network.WebSockets: connectWith :: Protocol p => String -> Int -> String -> Maybe String -> Maybe [String] -> WebSockets p a -> IO a
+ Network.WebSockets: data RequestBody
+ Network.WebSockets: data ResponseBody
+ Network.WebSockets: data ResponseHttpPart
+ Network.WebSockets: responseHttpCode :: ResponseHttpPart -> !Int
+ Network.WebSockets: responseHttpHeaders :: ResponseHttpPart -> Headers
+ Network.WebSockets: responseHttpMessage :: ResponseHttpPart -> !ByteString
- Network.WebSockets: Request :: !ByteString -> Headers -> Response -> Request
+ Network.WebSockets: Request :: !ByteString -> Headers -> ResponseBody -> Request
- Network.WebSockets: requestResponse :: Request -> Response
+ Network.WebSockets: requestResponse :: Request -> ResponseBody

Files

src/Network/WebSockets.hs view
@@ -101,11 +101,15 @@     , I.runServer     , I.runWithSocket -      -- * Types+      -- * HTTP Types     , I.Headers-    , I.RequestHttpPart (..)     , I.Request (..)-    , I.Response (..)+    , I.RequestHttpPart (..)+    , I.RequestBody (..)+    , I.ResponseHttpPart (..)+    , I.ResponseBody (..)++      -- * WebSockets types     , I.Message (..)     , I.ControlMessage (..)     , I.DataMessage (..)@@ -144,10 +148,15 @@     , I.catchWsError     , I.HandshakeError(..)     , I.ConnectionError(..)++      -- * WebSockets Client+    , I.connect+    , I.connectWith     ) where  import Control.Monad.Trans (liftIO) +import qualified Network.WebSockets.Client as I import qualified Network.WebSockets.Handshake as I import qualified Network.WebSockets.Handshake.Http as I import qualified Network.WebSockets.Monad as I@@ -191,8 +200,8 @@         I.Binary x -> return (I.fromLazyByteString x)  -- | Send a 'I.Response' to the socket immediately.-sendResponse :: I.Protocol p => I.Response -> I.WebSockets p ()-sendResponse = I.sendBuilder . I.encodeResponse+sendResponse :: I.Protocol p => I.ResponseBody -> I.WebSockets p ()+sendResponse = I.sendBuilder . I.encodeResponseBody  -- | Send a text message sendTextData :: (I.TextProtocol p, I.WebSocketsData a) => a -> I.WebSockets p ()
+ src/Network/WebSockets/Client.hs view
@@ -0,0 +1,84 @@+--------------------------------------------------------------------------------+-- | This part of the library provides you with utilities to create WebSockets+-- clients (in addition to servers).+module Network.WebSockets.Client+    ( connect+    , connectWith+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative               ((<$>))+import           Control.Monad.Trans               (liftIO)+import           Data.ByteString                   (ByteString)+import qualified Data.ByteString.Char8             as BC+import           Data.Enumerator                   (Iteratee, ($$))+import qualified Data.Enumerator                   as E+import qualified Data.Text                         as T+import qualified Data.Text.Encoding                as T+import qualified Network.Socket                    as S+import qualified Network.Socket.Enumerator         as SE+++--------------------------------------------------------------------------------+import           Network.WebSockets.Handshake.Http+import           Network.WebSockets.Monad+import           Network.WebSockets.Protocol+import           Network.WebSockets.Socket         (iterSocket)+++--------------------------------------------------------------------------------+connect :: Protocol p+        => String          -- ^ Host+        -> Int             -- ^ Port+        -> String          -- ^ Path+        -> WebSockets p a  -- ^ Client application+        -> IO a+connect host port path ws =+    connectWith host port path Nothing Nothing ws+++--------------------------------------------------------------------------------+connectWith :: Protocol p+            => String          -- ^ Host+            -> Int             -- ^ Port+            -> String          -- ^ Path+            -> Maybe String    -- ^ Origin, if Nothing then server interprets+                               --   connection as not coming from a browser.+            -> Maybe [String]  -- ^ Protocol List+            -> WebSockets p a  -- ^ Client application+            -> IO a+connectWith host port path origin wsProtocols app = do+    -- Create the request+    request <- createRequest protocol bHost bPath bOrigin bWsProtocols False++    -- Connect to server+    sock      <- S.socket S.AF_INET S.Stream S.defaultProtocol+    addrInfos <- S.getAddrInfo Nothing (Just host) (Just $ show port)+    S.connect sock (S.addrAddress $ head addrInfos)+    res <- E.run_ $ SE.enumSocket 4096 sock $$ (iter request) $ iterSocket sock++    -- Clean up+    S.sClose sock+    return res+  where+    protocol      = head implementations+    iter request  = runWebSocketsClient protocol request app+    bHost         = T.encodeUtf8 $ T.pack host+    bPath         = T.encodeUtf8 $ T.pack path+    bOrigin       = T.encodeUtf8 . T.pack <$> origin+    bWsProtocols  = map BC.pack <$> wsProtocols+++--------------------------------------------------------------------------------+runWebSocketsClient :: Protocol p+                    => p+                    -> RequestHttpPart+                    -> WebSockets p a+                    -> Iteratee ByteString IO ()+                    -> Iteratee ByteString IO a+runWebSocketsClient protocol request ws outIter = do+    liftIO $ makeBuilderSender outIter $ encodeRequestHttpPart request+    response <- receiveIteratee decodeResponse+    _        <- finishResponse protocol request response+    runWebSocketsWith' defaultWebSocketsOptions protocol ws outIter
src/Network/WebSockets/Handshake.hs view
@@ -27,7 +27,7 @@  -- | Respond to errors encountered during handshake. First argument may be -- bottom.-responseError :: forall p. Protocol p => p -> HandshakeError -> Response+responseError :: forall p. Protocol p => p -> HandshakeError -> ResponseBody responseError _ err = response400 $ case err of     -- TODO: fix     NotSupported -> versionHeader  -- Version negotiation
src/Network/WebSockets/Handshake/Http.hs view
@@ -2,15 +2,27 @@ {-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} module Network.WebSockets.Handshake.Http     ( Headers-    , RequestHttpPart (..)     , Request (..)-    , Response (..)+    , RequestHttpPart (..)+    , RequestBody (..)+    , ResponseHttpPart (..)+    , ResponseBody (..)     , HandshakeError (..)     , getSecWebSocketVersion++    , encodeRequestHttpPart+    , encodeRequestBody     , decodeRequest-    , encodeResponse++    , encodeResponseHttpPart+    , encodeResponseBody+    , decodeResponse+     , response101     , response400++    , getRequestHeader+    , getResponseHeader     ) where  import Data.Dynamic (Typeable)@@ -19,17 +31,27 @@ import Control.Exception (Exception) import Control.Monad.Error (Error (..)) +import Data.ByteString (ByteString) 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.Attoparsec as A import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC import qualified Data.CaseInsensitive as CI+import qualified Data.Enumerator as E  -- | Request headers type Headers = [(CI.CI B.ByteString, B.ByteString)] +-- | Full request type, including the response to it+data Request = Request+    { requestPath     :: !B.ByteString+    , requestHeaders  :: Headers+    , requestResponse :: ResponseBody+    } deriving (Show)+ -- | (Internally used) HTTP headers and requested path. data RequestHttpPart = RequestHttpPart     { requestHttpPath    :: !B.ByteString@@ -37,22 +59,21 @@     , requestHttpSecure  :: Bool     } deriving (Eq, Show) --- | Full request type-data Request = Request-    { requestPath     :: !B.ByteString-    , requestHeaders  :: Headers-    , requestResponse :: Response-    }+-- | A request with a body+data RequestBody = RequestBody RequestHttpPart B.ByteString     deriving (Show)  -- | Response to a 'Request'-data Response = Response-    { responseCode    :: !Int-    , responseMessage :: !B.ByteString-    , responseHeaders :: Headers-    , responseBody    :: B.ByteString+data ResponseHttpPart = ResponseHttpPart+    { responseHttpCode    :: !Int+    , responseHttpMessage :: !B.ByteString+    , responseHttpHeaders :: Headers     } deriving (Show) +-- | A response including a body+data ResponseBody = ResponseBody ResponseHttpPart B.ByteString+    deriving (Show)+ -- | Error in case of failed handshake. Will be thrown as an iteratee -- exception. ('Error' condition). --@@ -65,6 +86,9 @@     -- | The request was somehow invalid (missing headers or wrong security     -- token)     | MalformedRequest RequestHttpPart String+    -- | The servers response was somehow invalid (missing headers or wrong+    -- security token)+    | MalformedResponse ResponseHttpPart String     -- | The request was well-formed, but the library user rejected it.     -- (e.g. "unknown path")     | RequestRejected Request String@@ -82,6 +106,24 @@ getSecWebSocketVersion :: RequestHttpPart -> Maybe B.ByteString getSecWebSocketVersion p = lookup "Sec-WebSocket-Version" (requestHttpHeaders p) +-- | RequestHttpPart encoder+encodeRequestHttpPart :: RequestHttpPart -> Builder.Builder+encodeRequestHttpPart (RequestHttpPart path headers _) =+    Builder.copyByteString "GET "      `mappend`+    Builder.copyByteString path        `mappend`+    Builder.copyByteString " HTTP/1.1" `mappend`+    Builder.fromByteString "\r\n"      `mappend`+    mconcat (map header headers)       `mappend`+    Builder.copyByteString "\r\n"+  where+    header (k, v) = mconcat $ map Builder.copyByteString+        [CI.original k, ": ", v, "\r\n"]++-- | RequestBody encoder+encodeRequestBody :: RequestBody -> Builder.Builder+encodeRequestBody (RequestBody httpPart body) =+    encodeRequestHttpPart httpPart `mappend` Builder.copyByteString body+ -- | Parse an initial request decodeRequest :: Bool -> A.Parser RequestHttpPart decodeRequest isSecure = RequestHttpPart@@ -103,27 +145,67 @@         <*  newline  -- | Encode an HTTP upgrade response-encodeResponse :: Response -> Builder.Builder-encodeResponse (Response code msg headers body) =+encodeResponseHttpPart :: ResponseHttpPart -> Builder.Builder+encodeResponseHttpPart (ResponseHttpPart code msg headers) =     Builder.copyByteString "HTTP/1.1 " `mappend`     Builder.fromString (show code)     `mappend`     Builder.fromChar ' '               `mappend`     Builder.fromByteString msg         `mappend`     Builder.fromByteString "\r\n"      `mappend`     mconcat (map header headers)       `mappend`-    Builder.copyByteString "\r\n"      `mappend`-    Builder.copyByteString body  -- (body is empty except for version -00)+    Builder.copyByteString "\r\n"   where     header (k, v) = mconcat $ map Builder.copyByteString         [CI.original k, ": ", v, "\r\n"] +encodeResponseBody :: ResponseBody -> Builder.Builder+encodeResponseBody (ResponseBody httpPart body) =+    encodeResponseHttpPart httpPart `mappend` Builder.copyByteString body+ -- | An upgrade response-response101 :: Headers -> B.ByteString -> Response-response101 headers body = Response 101 "WebSocket Protocol Handshake"-    (("Upgrade", "websocket") : ("Connection", "Upgrade") : headers)-    body+response101 :: Headers -> B.ByteString -> ResponseBody+response101 headers = ResponseBody+    (ResponseHttpPart 101 "WebSocket Protocol Handshake"+        (("Upgrade", "websocket") : ("Connection", "Upgrade") : headers))  -- | Bad request ---response400 :: Headers -> Response-response400 headers = Response 400 "Bad Request" headers ""+response400 :: Headers -> ResponseBody+response400 headers =+    ResponseBody (ResponseHttpPart 400 "Bad Request" headers) ""++-- | HTTP response parser+decodeResponse :: A.Parser ResponseHttpPart+decodeResponse = ResponseHttpPart+    <$> fmap (read . BC.unpack) code+    <*> message+    <*> A.manyTill header newline+  where+    space = A.word8 (c2w ' ')+    newline = A.string "\r\n"++    code = A.string "HTTP/1.1" *> space *> A.takeWhile1 (/= c2w ' ') <* space+    message = A.takeWhile1 (/= c2w '\r') <* newline+    header = (,)+        <$> (CI.mk <$> A.takeWhile1 (/= c2w ':'))+        <*  A.string ": "+        <*> A.takeWhile1 (/= c2w '\r')+        <*  newline++getRequestHeader :: Monad m+                 => RequestHttpPart+                 -> CI.CI ByteString+                 -> E.Iteratee ByteString m ByteString+getRequestHeader rq key = case lookup key (requestHttpHeaders rq) of+    Just t  -> return t+    Nothing -> E.throwError $ MalformedRequest rq $ +        "Header missing: " ++ BC.unpack (CI.original key)++getResponseHeader :: Monad m+                  => ResponseHttpPart+                  -> CI.CI ByteString+                  -> E.Iteratee ByteString m ByteString+getResponseHeader rsp key = case lookup key (responseHttpHeaders rsp) of+    Just t  -> return t+    Nothing -> E.throwError $ MalformedResponse rsp $ +        "Header missing: " ++ BC.unpack (CI.original key)
src/Network/WebSockets/Monad.hs view
@@ -22,6 +22,8 @@     , throwWsError     , catchWsError     , spawnPingThread+    , receiveIteratee+    , makeBuilderSender     ) where  import Control.Applicative (Applicative, (<$>))@@ -122,7 +124,7 @@ 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+        let builder = encodeResponseBody $ responseError (undefined :: p) he         in liftIO $ makeBuilderSender outIter builder     -- Re-throw error     E.throwError e
src/Network/WebSockets/Protocol.hs view
@@ -45,6 +45,17 @@     -- | Decodes messages from binary 'B.ByteString's.     decodeMessages  :: Monad m => p -> E.Enumeratee B.ByteString (Message p) m a +    -- | Create a @Request@ that can be sent to the websockets server to open+    -- the connection.+    createRequest   :: p+                    -> B.ByteString         -- ^ Hostname of the server.+                    -> B.ByteString         -- ^ Path+                    -> Maybe B.ByteString   -- ^ Origin where we are connecting from.+                    -> Maybe [B.ByteString] -- ^ Protocols list.+                    -> Bool                 -- ^ Is the connection secure, i.e. wss.+                    -> IO RequestHttpPart   -- ^ HTTP request that can be sent to the+                                            --   to the server to initiate the connection.+     -- | Parse and validate the rest of the request. For hybi10, this is just     -- validation, but hybi00 also needs to fetch a "security token"     --@@ -53,6 +64,11 @@     finishRequest   :: Monad m                     => p -> RequestHttpPart                     -> E.Iteratee B.ByteString m Request++    -- | Parse and validate the handshake response received from the server.+    finishResponse :: Monad m+                   => p -> RequestHttpPart -> ResponseHttpPart+                   -> E.Iteratee B.ByteString m ResponseBody      -- | Implementations of the specification     implementations :: [p]
src/Network/WebSockets/Protocol/Hybi00.hs view
@@ -19,7 +19,9 @@     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_]  instance TextProtocol Hybi00
src/Network/WebSockets/Protocol/Hybi00/Internal.hs view
@@ -18,8 +18,8 @@ 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.Char8 () import qualified Data.ByteString.Lazy as BL-import qualified Data.CaseInsensitive as CI  import Network.WebSockets.Handshake.Http import Network.WebSockets.Protocol@@ -28,13 +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)-    finishRequest   Hybi00_   = 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)+    createRequest  Hybi00_   = error "createRequest Hybi00_"+    finishRequest  Hybi00_   = handshakeHybi00+    finishResponse Hybi00_   = error "finishResponse Hybi00_"+    implementations            = [Hybi00_]  instance TextProtocol Hybi00_ @@ -79,7 +81,7 @@     let key = B.concat . BL.toChunks . encode . md5 $ BL.concat                 [keyPart1, keyPart2, BL.fromChunks [keyPart3]] -    host <- getHeader "Host"+    host   <- getHeader "Host"     -- todo: origin right? (also applies to hybi10)     origin <- getHeader "Origin"     let schema = if isSecure then "wss://" else "ws://"@@ -91,11 +93,7 @@      return $ Request path h response   where-    getHeader k = case lookup k h of-        Just t  -> return t-        Nothing -> E.throwError $ MalformedRequest reqHttp $-            "Header missing: " ++ BC.unpack (CI.original k)-+    getHeader = getRequestHeader reqHttp     numberFromToken token = case divBySpaces (BC.unpack token) of         Just n  -> return $ encode n         Nothing -> E.throwError $ MalformedRequest reqHttp
src/Network/WebSockets/Protocol/Hybi10.hs view
@@ -17,7 +17,9 @@     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_]  instance TextProtocol Hybi10
src/Network/WebSockets/Protocol/Hybi10/Internal.hs view
@@ -5,24 +5,23 @@     ) where  import Control.Applicative (pure, (<$>))+import Control.Monad (liftM) import Data.Bits ((.&.), (.|.)) import Data.Maybe (maybeToList) import Data.Monoid (mempty, mappend, mconcat)  import Data.Attoparsec (anyWord8) import Data.Binary.Get (runGet, getWord16be, getWord64be)-import Data.ByteString (ByteString)+import Data.ByteString (ByteString, intercalate) import Data.ByteString.Char8 () import Data.Digest.Pure.SHA (bytestringDigest, sha1)-import Data.Int (Int64) import Data.Enumerator ((=$))+import Data.Int (Int64) import qualified Blaze.ByteString.Builder as B import qualified Data.Attoparsec as A 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 qualified Data.Enumerator as E import qualified Data.Enumerator.List as EL @@ -32,15 +31,19 @@ import Network.WebSockets.Protocol.Hybi10.Mask import Network.WebSockets.Types +import System.Entropy as R+ data Hybi10_ = Hybi10_  instance Protocol Hybi10_ where-    version         Hybi10_ = "hybi10"-    headerVersions  Hybi10_ = ["13", "8", "7"]-    encodeMessages  Hybi10_ = EL.map encodeMessageHybi10-    decodeMessages  Hybi10_ = decodeMessagesHybi10-    finishRequest   Hybi10_ = handshakeHybi10-    implementations         = [Hybi10_]+    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_]  instance TextProtocol Hybi10_ instance BinaryProtocol Hybi10_@@ -142,15 +145,65 @@                 => 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+    key <- getRequestHeader reqHttp "Sec-WebSocket-Key"+    let hash = hashKeyHybi10 key     let encoded = B64.encode hash     return $ Request path h $ response101 [("Sec-WebSocket-Accept", encoded)] ""++createRequestHybi10 :: ByteString+                    -> ByteString+                    -> Maybe ByteString+                    -> Maybe [ByteString]+                    -> Bool+                    -> IO RequestHttpPart+createRequestHybi10 hostname path origin protocols secure = do+    key <- B64.encode `liftM`  getEntropy 16+    return $ RequestHttpPart path (headers key) secure   where+    headers key = [("Host"                   , hostname     )+                  ,("Connection"             , "Upgrade"    )+                  ,("Upgrade"                , "websocket"  )+                  ,("Sec-WebSocket-Key"      , key          )+                  ,("Sec-WebSocket-Version"  , versionNumber)+                  ] ++ protocolHeader protocols+                    ++ originHeader origin++    originHeader (Just o)    = [("Origin"                , o                  )]+    originHeader Nothing     = []++    protocolHeader (Just ps) = [("Sec-WebSocket-Protocol", intercalate ", " ps)]+    protocolHeader Nothing   = []++    versionNumber = head . headerVersions $ Hybi10_++finishResponseHybi10 :: Monad m+                     => RequestHttpPart+                     -> ResponseHttpPart+                     -> E.Iteratee ByteString m ResponseBody+finishResponseHybi10 request response = do+    -- Response message should be one of+    --+    -- - WebSocket Protocol Handshake+    -- - Switching Protocols+    --+    -- But we don't check it for now+    if responseHttpCode response /= 101+        then throw "Wrong response status or message."+        else do+            key          <- getRequestHeader  request  "Sec-WebSocket-Key"+            responseHash <- getResponseHeader response "Sec-WebSocket-Accept"++            let challengeHash = B64.encode $ hashKeyHybi10 key+            if responseHash /= challengeHash+                then throw "Challenge and response hashes do not match."+                else return $ ResponseBody response ""+  where+    throw msg = E.throwError $ MalformedResponse response msg+++hashKeyHybi10 :: ByteString -> ByteString+hashKeyHybi10 key = unlazy $ bytestringDigest $ sha1 $ lazy $ key `mappend` guid+  where     guid = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"     lazy = BL.fromChunks . return     unlazy = mconcat . BL.toChunks-    getHeader k = case lookup k h of-        Just t  -> return t-        Nothing -> E.throwError $ MalformedRequest reqHttp $ -            "Header missing: " ++ BC.unpack (CI.original k)
src/Network/WebSockets/Socket.hs view
@@ -7,10 +7,8 @@     , iterSocket     ) where -import Prelude hiding (catch)- import Control.Concurrent (forkIO)-import Control.Exception (SomeException, catch)+import Control.Exception (SomeException, handle) import Control.Monad (forever) import Control.Monad.Trans (liftIO) @@ -41,7 +39,7 @@     host' <- S.inet_addr host     S.bindSocket sock (S.SockAddrInet (fromIntegral port) host')     S.listen sock 5-    flip catch (closeSock sock) $ forever $ do+    handle (closeSock sock) $ forever $ do         (conn, _) <- S.accept sock         -- Voodoo fix: set this to True as soon as we notice the connection was         -- closed. Will prevent iterSocket' from even trying to send anything.
src/Network/WebSockets/Types.hs view
@@ -1,7 +1,5 @@--{-# LANGUAGE DeriveDataTypeable #-}- -- | Primary types+{-# LANGUAGE DeriveDataTypeable #-} module Network.WebSockets.Types     ( Message (..)     , ControlMessage (..)
websockets.cabal view
@@ -1,5 +1,5 @@ Name:    websockets-Version: 0.6.0.4+Version: 0.7.0.0  Synopsis:   A sensible and clean way to write WebSocket-capable servers in Haskell.@@ -49,6 +49,7 @@     Network.WebSockets.Util.PubSub    Other-modules:+    Network.WebSockets.Client     Network.WebSockets.Handshake     Network.WebSockets.Handshake.Http     Network.WebSockets.Monad@@ -67,11 +68,11 @@     attoparsec               >= 0.9    && < 0.11,     attoparsec-enumerator    >= 0.2    && < 0.4,     base                     >= 4      && < 5,-    base64-bytestring        >= 0.1    && < 0.2,+    base64-bytestring        >= 0.1    && < 1.1,     binary                   >= 0.5    && < 0.6,     blaze-builder            >= 0.3    && < 0.4,     blaze-builder-enumerator >= 0.2    && < 0.3,-    bytestring               >= 0.9    && < 0.10,+    bytestring               >= 0.9    && < 0.11,     case-insensitive         >= 0.3    && < 0.5,     containers               >= 0.3    && < 0.6,     enumerator               >= 0.4.13 && < 0.5,@@ -81,7 +82,8 @@     random                   >= 1.0    && < 1.1,     SHA                      >= 1.5    && < 1.6,     text                     >= 0.10   && < 0.12,-    pureMD5                  >= 0.2.2  && < 2.2+    pureMD5                  >= 0.2.2  && < 2.2,+    entropy                  >= 0.2.1  && < 0.3  Test-suite websockets-tests   Type:           exitcode-stdio-1.0@@ -91,7 +93,7 @@    Build-depends:     HUnit                      >= 1.2 && < 1.3,-    QuickCheck                 >= 2.4 && < 2.5,+    QuickCheck                 >= 2.4 && < 2.6,     test-framework             >= 0.4 && < 0.7,     test-framework-hunit       >= 0.2 && < 0.3,     test-framework-quickcheck2 >= 0.2 && < 0.3,@@ -99,11 +101,11 @@     attoparsec               >= 0.9    && < 0.11,     attoparsec-enumerator    >= 0.2    && < 0.4,     base                     >= 4      && < 5,-    base64-bytestring        >= 0.1    && < 0.2,+    base64-bytestring        >= 0.1    && < 1.1,     binary                   >= 0.5    && < 0.6,     blaze-builder            >= 0.3    && < 0.4,     blaze-builder-enumerator >= 0.2    && < 0.3,-    bytestring               >= 0.9    && < 0.10,+    bytestring               >= 0.9    && < 0.11,     case-insensitive         >= 0.3    && < 0.5,     containers               >= 0.3    && < 0.6,     enumerator               >= 0.4.13 && < 0.5,@@ -113,7 +115,8 @@     random                   >= 1.0    && < 1.1,     SHA                      >= 1.5    && < 1.6,     text                     >= 0.10   && < 0.12,-    pureMD5                  >= 0.2.2  && < 2.2+    pureMD5                  >= 0.2.2  && < 2.2,+    entropy                  >= 0.2.1  && < 0.3  Source-repository head   Type:     git