diff options
Diffstat (limited to 'WebSockets.hs')
| -rw-r--r-- | WebSockets.hs | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/WebSockets.hs b/WebSockets.hs index 2fa9e35..f159271 100644 --- a/WebSockets.hs +++ b/WebSockets.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings, DeriveGeneric, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables #-} module WebSockets ( connectionOptions, @@ -16,6 +17,7 @@ module WebSockets ( import Types import SessionID +import ProtocolBuffers import Network.WebSockets hiding (Message) import Control.Concurrent.STM @@ -24,8 +26,9 @@ import Control.Concurrent.Async import Control.Exception import GHC.Generics (Generic) import Data.Aeson (FromJSON, ToJSON) +import Data.ProtocolBuffers import qualified Data.Aeson -import qualified Data.Binary +import qualified Data.Serialize import qualified Data.Text as T import qualified Data.ByteString.Lazy as L import Data.List @@ -144,7 +147,9 @@ instance WebSocketsData WireProtocol where toLazyByteString (Version v) = "V" <> Data.Aeson.encode v toLazyByteString (SelectMode _ m) = "M" <> Data.Aeson.encode m toLazyByteString (Ready _ sid) = "R" <> Data.Aeson.encode sid - toLazyByteString (AnyMessage msg) = "L" <> Data.Binary.encode msg + toLazyByteString (AnyMessage msg) = "L" <> + let pmsg = toProtocolBuffer msg :: AnyMessageP + in Data.Serialize.runPutLazy (encodeMessage pmsg) toLazyByteString Done = "D" toLazyByteString (WireProtocolError s) = "E" <> Data.Aeson.encode s fromLazyByteString b = case L.splitAt 1 b of @@ -157,9 +162,9 @@ instance WebSocketsData WireProtocol where ("R", sid) -> maybe (WireProtocolError "invalid JSON in SessionID") (Ready ServerSends) (Data.Aeson.decode sid) - ("L", l) -> case Data.Binary.decodeOrFail l of - Left (_, _, err) -> WireProtocolError $ "Binary decode error: " ++ err - Right (_, _, msg) -> AnyMessage msg + ("L", l) -> case Data.Serialize.runGetLazy decodeMessage l of + Left err -> WireProtocolError $ "Protocol buffers decode error: " ++ err + Right (pmsg :: AnyMessageP) -> AnyMessage (fromProtocolBuffer pmsg) ("D", "") -> Done ("E", s) -> maybe (WireProtocolError "invalid JSON in WireProtocolError") WireProtocolError |