improve JSON

Most of the time, ByteStrings will be able to be encoded as utf8, so avoid
base64 when not needed.

Adjusted some of the types in order to generate more usual JSON. In particular,
removed StartActivity.

The JSON now looks like this (with the signature still not populated):

{"signature":{"v":""},"prevActivity":{"hashValue":{"v":"3b1abe614dd43bdb2d9a56777884e2d0f3bac9796e2d25c1ad52bb689c117286"},"hashMethod":"SHA256"},"activity":{"echoData":{"v":""},"enteredData":{"v":"l"}}}

203 bytes to send a single keystroke is not great when there's really
only 1+64(hash) bytes of unique data. So, may end up adding a wire
encoding on top of this. But, JSON is good to have for storage of the
proofs, etc.

Also, it does compress well. Two such JSON objects gzip -9 to 219
bytes, and three to 265 bytes. So, 37 bytes per keystroke. This is
*exactly* as efficient as gzip -9 of $c$hash formatted data.

This commit was sponsored by Jack Hill on Patreon.

1 files changed, 20 insertions, 17 deletions

diff --git a/debug-me.hs b/debug-me.hs
index 86558bc..5f0f628 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -13,8 +13,10 @@ import System.IO
 import System.Process
 import System.Exit
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
 import Data.List.NonEmpty (NonEmpty(..), toList)
 import Data.Monoid
+import Data.Aeson
 
 main :: IO ()
 main = do
@@ -41,7 +43,7 @@ developer :: TChan (Activity Entered) -> TChan (Activity Seen) -> IO ()
 developer ichan ochan = do
 	startact <- atomically $ readTChan ochan
 	case startact of
-		StartActivity (Seen (Val b)) sig -> do
+		Activity (Seen (Val b)) Nothing sig -> do
 			B.hPut stdout b
 			hFlush stdout	
 		_ -> return ()
@@ -72,7 +74,7 @@ sendTtyInput ichan devstate = go
 				{ enteredData = Val b
 				, echoData = Val (sentSince ds)
 				}
-			let act = Activity entered (lastSeen ds) dummySignature
+			let act = Activity entered (Just $ lastSeen ds) dummySignature
 			writeTChan ichan act
 			let ds' = ds { sentSince = sentSince ds <> b }
 			writeTVar devstate ds'
@@ -91,7 +93,7 @@ sendTtyOutput ochan devstate = go
 		act <- readTChan ochan
 		ds <- readTVar devstate
 		case act of
-			Activity (Seen (Val b)) hp sig
+			Activity (Seen (Val b)) (Just hp) sig
 				| hp == lastSeen ds -> do
 					let ss = sentSince ds
 					let ss' = if b `B.isPrefixOf` ss
@@ -109,7 +111,7 @@ sendTtyOutput ochan devstate = go
 
 user :: B.ByteString -> Pty -> TChan (Activity Entered) -> TChan (Activity Seen) -> IO ()
 user startmsg p ichan ochan = do
-	let startact = StartActivity (Seen (Val (startmsg <> "\r\n"))) dummySignature
+	let startact = Activity (Seen (Val (startmsg <> "\r\n"))) Nothing dummySignature
 	atomically $ writeTChan ochan startact
 	backlog <- newTVarIO $ Backlog ((hash startact, startact) :| [])
 	_ <- sendPtyOutput p ochan backlog
@@ -129,7 +131,7 @@ sendPtyOutput p ochan backlog = go
 		atomically $ do
 			Backlog (bl@((prevhash, _) :| _)) <- readTVar backlog
 			let seen = Seen (Val b)
-			let act = Activity seen prevhash dummySignature
+			let act = Activity seen (Just prevhash) dummySignature
 			writeTChan ochan act
 			writeTVar backlog (Backlog ((hash act, act) :| toList bl))
 		go
@@ -141,7 +143,7 @@ sendPtyInput ichan p backlog = go
   where
 	go = do
 		networkDelay
-		mb <- atomically $ do
+		v <- atomically $ do
 			newact <- readTChan ichan
 			bl <- readTVar backlog
 			-- Don't need to retain backlog before the Activity
@@ -150,12 +152,13 @@ sendPtyInput ichan p backlog = go
 			if isLegal newact bl'
 				then do
 					writeTVar backlog bl'
-					return (Right (enteredData (activityContent newact)))
+					return (Right newact)
 				else do
-					return (Left ("illegal entry" :: String, newact, bl'))
-		case mb of
-			Right (Val b) -> do
-				writePty p b
+					return (Left ("illegal entry" :: String, encode newact, bl'))
+		case v of
+			Right entered -> do
+				L.putStrLn (encode entered)
+				writePty p (val (enteredData (activity entered)))
 				go
 			Left _e -> do
 				-- print e
@@ -168,12 +171,12 @@ sendPtyInput ichan p backlog = go
 -- done.
 truncateBacklog :: Backlog -> Activity Entered -> Backlog
 truncateBacklog (Backlog (b :| l)) (Activity _ hp _)
-	| fst b == hp = Backlog (b :| [])
+	| Just (fst b) == hp = Backlog (b :| [])
 	| otherwise = Backlog (b :| go [] l)
   where
 	go c [] = reverse c
 	go c (x:xs)
-		| fst x == hp = reverse (x:c)
+		| Just (fst x) == hp = reverse (x:c)
 		| otherwise = go (x:c) xs
 truncateBacklog (Backlog bl) _ = Backlog bl
 
@@ -188,11 +191,11 @@ truncateBacklog (Backlog bl) _ = Backlog bl
 -- Seen activity.
 isLegal :: Activity Entered -> Backlog -> Bool
 isLegal (Activity entered hp sig) (Backlog (lastseen@(lastseenhash, _lastseen) :| bl))
-	| lastseenhash == hp = True
+	| Just lastseenhash == hp = True
 	| B.null (val (echoData entered)) = False -- optimisation
-	| any (== hp) (map fst bl) =
-		let sincehp = reverse (lastseen : takeWhile (\(h, _) -> h /= hp) bl)
-		in echoData entered == mconcat (map (seenData . activityContent . snd) sincehp)
+	| any (== hp) (map (Just . fst) bl) =
+		let sincehp = reverse (lastseen : takeWhile (\(h, _) -> Just h /= hp) bl)
+		in echoData entered == mconcat (map (seenData . activity . snd) sincehp)
 	| otherwise = False
 isLegal _ _ = False