From 3adfdf1ae27cd4b6419ce5be14ffb3712339065a Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 22 Apr 2017 15:14:03 -0400
Subject: add framing protocol for websockets

---
 Types.hs | 32 ++++++++++++++++----------------
 1 file changed, 16 insertions(+), 16 deletions(-)

(limited to 'Types.hs')

diff --git a/Types.hs b/Types.hs
index 76a30a2..04855f4 100644
--- a/Types.hs
+++ b/Types.hs
@@ -15,9 +15,6 @@ module Types (
 import Val
 import Memory
 import Serialization
-import Network.WebSockets (WebSocketsData(..))
-import qualified Data.Binary
-import qualified Data.ByteString.Lazy as L
 
 -- | Things that the developer sees.
 data Seen = Seen
@@ -139,6 +136,22 @@ newtype GpgSig = GpgSig Val
 instance DataSize GpgSig where
 	dataSize (GpgSig s) = dataSize s
 
+data LogMessage
+	= User (Message Seen)
+	| Developer (Message Entered)
+	deriving (Show, Generic)
+
+instance DataSize LogMessage where
+	dataSize (User a) = dataSize a
+	dataSize (Developer a) = dataSize a
+
+instance Binary LogMessage
+instance ToJSON LogMessage where
+	toJSON = genericToJSON sumOptions
+	toEncoding = genericToEncoding sumOptions
+instance FromJSON LogMessage where
+	parseJSON = genericParseJSON sumOptions
+
 instance Binary Seen
 instance ToJSON Seen
 instance FromJSON Seen
@@ -194,16 +207,3 @@ instance ToJSON ControlAction where
 	toEncoding = genericToEncoding sumOptions
 instance FromJSON ControlAction where
 	parseJSON = genericParseJSON sumOptions
-
-instance WebSocketsData (Message Seen) where
-	fromLazyByteString = decodeBinaryMessage
-	toLazyByteString = Data.Binary.encode
-
-instance WebSocketsData (Message Entered) where
-	fromLazyByteString = decodeBinaryMessage
-	toLazyByteString = Data.Binary.encode
-
-decodeBinaryMessage :: Binary (Message a) => L.ByteString -> Message a
-decodeBinaryMessage b = case Data.Binary.decodeOrFail b of
-	Right (_, _, msg) -> msg
-	Left (_, _, err) -> error $ "Binary decode error: " ++ err
-- 
cgit v1.2.3