diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-22 15:14:03 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-22 15:16:10 -0400 |
commit | 3adfdf1ae27cd4b6419ce5be14ffb3712339065a (patch) | |
tree | 9ce265ece85d2e3829eba85d964f2a123699f908 /Types.hs | |
parent | 7987157bfd99b8e2ec78f5030a49c2e16bf08321 (diff) | |
download | debug-me-3adfdf1ae27cd4b6419ce5be14ffb3712339065a.tar.gz |
add framing protocol for websockets
Diffstat (limited to 'Types.hs')
-rw-r--r-- | Types.hs | 32 |
1 files changed, 16 insertions, 16 deletions
@@ -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 |