From 5c542bb09e51eeb407a59f5bd4a2c6c460863446 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 27 Apr 2017 12:01:20 -0400 Subject: switch wire message seralization to use protocol buffers This way it's not tied to details of the haskell binary library, and implementations in other languages should be fairly simple to do. The haskell protobuf library was used because it does not need extra tooling or build steps. So I didn't write a .proto file, but one could fairly easily be written by following ProtocolBuffers.hs and translating it. ProtocolBuffers.hs is *extremely* repetative and tedious code. Surely there must be a way to not need to write all of that? Oh well, I wrote it.. Sizes of serialized messages: ">>> debug-me session started": 121 sending a single key press: 169 This seems equally as efficient as the binary serialization was; that was 165 bytes before elapsedTime was added. This commit was sponsored by Ethan Aubin. --- WebSockets.hs | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'WebSockets.hs') 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 -- cgit v1.2.3