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, 50 insertions, 21 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index b0d66a5..9e1f40e 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -1,6 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Role.Developer where
+module Role.Developer (
+	run,
+	run',
+	processSessionStart,
+	getServerMessage,
+	Output(..),
+	emitOutput,
+	DeveloperState,
+) where
 
 import Types
 import Hash
@@ -10,6 +18,7 @@ import CmdLine
 import WebSockets
 import SessionID
 import Pty
+import PrevActivity
 
 import Control.Concurrent.Async
 import Control.Concurrent.STM
@@ -20,20 +29,25 @@ import qualified Data.Text as T
 import Data.List
 import Data.Maybe
 import Control.Monad
+import Data.Monoid
 import Data.Time.Clock.POSIX
 
 run :: DeveloperOpts -> IO ()
 run = run' developer . debugUrl
 
-run' :: (TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO ()) -> UrlString -> IO ()
-run' runner url = void $ runClientApp app
-  where
-	connect = ConnectMode (T.pack url)
-	app = clientApp connect Developer Just runner
+run' :: (TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO ()) -> UrlString -> IO ()
+run' runner url = do
+	app <- do
+		let connect = ConnectMode (T.pack url)
+		dsv <- newEmptyTMVarIO
+		let recentactivity = developerStateRecentActivity dsv
+		return $ clientApp connect recentactivity Developer Just $
+			runner dsv
+	void $ runClientApp app
 
-developer :: TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO ()
-developer ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do
-	(devstate, startoutput) <- processSessionStart ochan logger
+developer :: TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO ()
+developer dsv ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do
+	(devstate, startoutput) <- processSessionStart ochan logger dsv
 	emitOutput startoutput
 	ok <- authUser ichan ochan devstate logger
 	if ok
@@ -63,6 +77,16 @@ data DeveloperState = DeveloperState
 	-- ^ Used to verify signatures on messages from other developers.
 	}
 
+-- | RecentActivity that uses the DeveloperState.
+developerStateRecentActivity :: TMVar (TVar DeveloperState) -> RecentActivity
+developerStateRecentActivity dsv = go =<< tryReadTMVar dsv
+  where
+	go Nothing = noRecentActivity
+	go (Just ds) = do
+		st <- readTVar ds
+		let hs = lastSeen st : enteredSince st ++ fromOtherDevelopersSince st
+		return (userSigVerifier st <> developerSigVerifier st, hs)
+
 -- | Read things typed by the developer, and forward them to the TMChan.
 sendTtyInput :: TMChan (Message Entered) -> TVar DeveloperState -> Logger -> IO ()
 sendTtyInput ichan devstate logger = go
@@ -287,8 +311,8 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts
 
 -- | Start by reading the initial two messages from the user,
 -- their session key and the startup message.
-processSessionStart :: TMChan AnyMessage -> Logger -> IO (TVar DeveloperState, Output)
-processSessionStart ochan logger = do
+processSessionStart :: TMChan AnyMessage -> Logger -> TMVar (TVar DeveloperState) -> IO (TVar DeveloperState, Output)
+processSessionStart ochan logger dsv = do
 	sessionmsg <- fromMaybe (error "Did not get session initialization message")
 		<$> atomically (readTMChan ochan)
 	logger sessionmsg
@@ -302,25 +326,30 @@ processSessionStart ochan logger = do
 				then return sv
 				else error "Badly signed session initialization message"
 		_ -> error $ "Unexpected session initialization message: " ++ show sessionmsg
-	startmsg <- fromMaybe (error "Did not get session startup message")
-		<$> atomically (readTMChan ochan)
-	logger startmsg
-	let (starthash, output) = case startmsg of
-		User (ActivityMessage act@(Activity (Seen (Val b)) Nothing _ _))
-			| verifySigned sigverifier act ->
-				(hash act, TtyOutput b)
-		_ -> error $ "Unexpected startup message: " ++ show startmsg
 	sk <- genMySessionKey
 	ts <- getPOSIXTime
 	st <- newTVarIO $ DeveloperState
-		{ lastSeen = starthash
+		{ lastSeen = hash ()
 		, sentSince = mempty
 		, enteredSince = mempty
-		, lastActivity = starthash
+		, lastActivity = hash ()
 		, lastActivityTs = ts
 		, fromOtherDevelopersSince = mempty
 		, developerSessionKey = sk
 		, userSigVerifier = sigverifier
 		, developerSigVerifier = mempty
 		}
+	atomically $ putTMVar dsv st
+	startmsg <- fromMaybe (error "Did not get session startup message")
+		<$> atomically (readTMChan ochan)
+	logger startmsg
+	let (starthash, output) = case startmsg of
+		User (ActivityMessage act@(Activity (Seen (Val b)) Nothing _ _))
+			| verifySigned sigverifier act ->
+				(hash act, TtyOutput b)
+		_ -> error $ "Unexpected startup message: " ++ show startmsg
+	atomically $ modifyTVar' st $ \ds -> ds
+		{ lastSeen = starthash
+		, lastActivity = starthash
+		}
 	return (st, output)