Leave the prevMessage out of Activity serialization to save BW.

Do include it in the data that gets signed, so it can be recovered
by trying each likely (recently seen) Activity as the prevMessage, and
checking the signature.

The UserState and DeveloperState already had the necessary state about
recently seen hashes, so this does not impact data use.

One tricky bit is that relayFromSocket needs to wait for the TMChan
to be empty before calling restorePrevActivityHash. Otherwise, the
hashes of items in the channel that have not been processed yet won't be
tried. The TMChan is not really being used as a channel since only 1
item can be in it. It could be converted to a TMVar, but closeTMChan is
used so I left it as a channel.

Note that the server does not restore hashes of messages that pass
through it; it's just a dumb relay.

Sending a single key press now only needs 94 bytes of data to be sent,
down from 169!

---

Also switched to SHA512, since hashes are no longer being sent over
the wire and so the larger size does not matter. SHA512 is slightly
faster and more secure.

This commit was sponsored by Ewen McNeill.

1 files changed, 17 insertions, 3 deletions

diff --git a/Role/User.hs b/Role/User.hs
index e0599a8..fe679a5 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -11,6 +11,7 @@ import Crypto
 import CmdLine
 import WebSockets
 import SessionID
+import PrevActivity
 
 import Control.Concurrent.Async
 import Control.Concurrent.STM
@@ -31,17 +32,20 @@ run os = fromMaybe (ExitFailure 101) <$> connect
 	connect = do
 		putStr "Connecting to debug-me server..."
 		hFlush stdout
-		runClientApp $ clientApp (InitMode mempty) User developerMessages $ \ochan ichan sid -> do
+		usv <- newEmptyTMVarIO
+		let recentactivity = userStateRecentActivity usv
+		runClientApp $ clientApp (InitMode mempty) recentactivity User developerMessages $ \ochan ichan sid -> do
 			let url = sessionIDUrl sid "localhost" 8081
 			putStrLn ""
 			putStrLn "Others can connect to this session and help you debug by running:"
 			putStrLn $ "  debug-me --debug " ++ url
 			hFlush stdout
-			withLogger "debug-me.log" $ go ochan ichan
-	go ochan ichan logger = do
+			withLogger "debug-me.log" $ go ochan ichan usv
+	go ochan ichan usv logger = do
 		(cmd, cmdparams) <- shellCommand os
 		runWithPty cmd cmdparams $ \(p, ph) -> do
 			us <- startProtocol startSession ochan logger
+			atomically $ putTMVar usv us
 			p1 <- async $ sendPtyOutput p ochan us logger
 			p2 <- async $ sendPtyInput ichan ochan p us logger
 				`race` forwardTtyInputToPty p
@@ -73,6 +77,16 @@ data UserState = UserState
 	, lastSeenTs :: POSIXTime
 	}
 
+-- | RecentActivity that uses the UserState.
+userStateRecentActivity :: TMVar (TVar UserState) -> RecentActivity
+userStateRecentActivity usv = go =<< tryReadTMVar usv
+  where
+	go Nothing = noRecentActivity
+	go (Just us) = do
+		st <- readTVar us
+		let hs = mapMaybe loggedHash $ toList $ backLog st
+		return (sigVerifier st, hs)
+
 -- | Start by establishing our session key, and displaying the starttxt.
 startProtocol :: B.ByteString -> TMChan (Message Seen) -> Logger -> IO (TVar UserState)
 startProtocol starttxt ochan logger = do