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.

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