add prevEntered pointer

Client requires this always point to the previous Entered it accepted,
so a hash chain of Entered is built up, and there is no possibility for
ambiguity about which order a client received two Entered activies in.

So restoreHashes now has to try every possible combination of
known hashes for both prevEntered and prevActivity. That could be
significantly more work, but it would be unusual for there to be a lot
of known hashes, so it should be ok.

--graphviz shows this additional hash chain with grey edges
(and leaves out edges identical to the other hash chain)

While testing this with an artifical network lag, it turned out that
signature verification was failing for Reject messages sent by the
user. Didn't quite figure out what was at the bottom of that,
but the Activity Entered that was sent back in a Reject message was
clearly not useful, because it probably had both its prevEntered and
prevActivity hashes set to Nothing (because restoreHashes didn't restore
them, because the original Activity Entered was out of the expected
chain). So, switched Rejected to use a Hash.

(And renamed Rejected to EnteredRejected to make it more clear what
it's rejecting.)

Also, added a lastAccepted hash to EnteredRejected. This lets
the developer find its way back to the accepted chain when some
of its input gets rejected.

This commit was sponsored by Trenton Cronholm on Patreon.

1 files changed, 33 insertions, 12 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index 604ac6d..d8d9d2c 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -108,8 +108,10 @@ data DeveloperState = DeveloperState
 	, enteredSince :: [Hash]
 	-- ^ Messages we've sent since the last Seen.
 	, lastActivity :: Hash
+	-- ^ Last Entered or Seen activity
 	, lastActivityTs :: POSIXTime
-	-- ^ Last message sent or received.
+	, lastEntered :: Maybe Hash
+	-- ^ Last Entered activity (either from us or another developer).
 	, fromOtherDevelopersSince :: [Hash]
 	-- ^ Messages received from other developers since the last Seen.
 	-- (The next Seen may chain from one of these.)
@@ -126,7 +128,8 @@ data DeveloperState = DeveloperState
 developerStateRecentActivity :: TVar DeveloperState -> RecentActivity
 developerStateRecentActivity devstate = do
 	st <- readTVar devstate
-	let hs = lastSeen st : enteredSince st ++ fromOtherDevelopersSince st
+	let hs = lastSeen st : fromMaybe (lastSeen st) (lastEntered st)
+		: enteredSince st ++ fromOtherDevelopersSince st
 	return (userSigVerifier st <> developerSigVerifier st, hs)
 
 -- | Read things typed by the developer, and forward them to the TMChan.
@@ -154,6 +157,7 @@ sendTtyInput ichan devstate logger = go
 			let act = mkSigned (developerSessionKey ds) $
 				Activity entered
 					(Just $ lastActivity ds)
+					(lastEntered ds)
 					(mkElapsedTime (lastActivityTs ds) ts)
 			writeTMChan ichan (ActivityMessage act)
 			let acth = hash act
@@ -162,6 +166,7 @@ sendTtyInput ichan devstate logger = go
 				, enteredSince = enteredSince ds ++ [acth]
 				, lastActivity = acth
 				, lastActivityTs = ts
+				, lastEntered = Just acth
 				}
 			writeTVar devstate ds'
 			return act
@@ -203,11 +208,11 @@ sendTtyOutput ochan devstate controlinput logger = go
 	forwardcontrol msg = case msg of 
 		User (ControlMessage c) -> fwd c
 		Developer (ControlMessage c) -> case control c of
-			Rejected _ -> return ()
-			SessionKey _ -> return ()
-			SessionKeyAccepted _ -> return ()
-			SessionKeyRejected _ -> return ()
-			ChatMessage _ _ -> fwd c
+			EnteredRejected {} -> return ()
+			SessionKey {} -> return ()
+			SessionKeyAccepted {} -> return ()
+			SessionKeyRejected {} -> return ()
+			ChatMessage {} -> fwd c
 		_ -> return ()
 	fwd = atomically . writeTMChan controlinput . ControlInputAction . control
 
@@ -308,20 +313,21 @@ getServerMessage ochan devstate ts = do
 	
 	ignore = getServerMessage ochan devstate ts
 	
-	processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _)) = do
+	processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _ _)) = do
 		let (legal, ds') = isLegalSeen act ds ts
 		if legal
 			then do
 				writeTVar devstate ds'
 				return (TtyOutput b)
 			else return (ProtocolError ds $ "Illegal Seen value: " ++ show act)
-	processuser ds (ControlMessage (Control (Rejected _) _)) = do
+	processuser ds (ControlMessage (Control (er@EnteredRejected {}) _)) = do
 		-- When they rejected a message we sent,
 		-- anything we sent subsequently will
 		-- also be rejected, so forget about it.
 		let ds' = ds
 			{ sentSince = mempty
 			, enteredSince = mempty
+			, lastEntered = enteredLastAccepted er
 			}
 		writeTVar devstate ds'
 		return Beep
@@ -345,8 +351,8 @@ getServerMessage ochan devstate ts = do
 --
 -- Does not check the signature.
 isLegalSeen :: Activity Seen -> DeveloperState -> POSIXTime -> (Bool, DeveloperState)
-isLegalSeen (Activity _ Nothing _ _) ds _ = (False, ds)
-isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts
+isLegalSeen (Activity _ Nothing _ _ _) ds _ = (False, ds)
+isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _ _) ds ts
 	-- Does it chain to the last Seen activity or to
 	-- something sent by another developer since the last Seen?
 	| hp == lastSeen ds || hp `elem` fromOtherDevelopersSince ds = 
@@ -364,6 +370,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts
 			, enteredSince = es'
 			, lastActivity = acth
 			, lastActivityTs = ts
+			, lastEntered = newlastentered
 			, fromOtherDevelopersSince = mempty
 			}
 	-- Does it chain to something we've entered since the last Seen
@@ -384,12 +391,25 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts
 				, enteredSince = es'
 				, lastActivity = acth
 				, lastActivityTs = ts
+				, lastEntered = newlastentered
 				, fromOtherDevelopersSince = mempty
 				}
   where
 	acth = hash act
 	yes ds' = (True, ds')
 
+	-- If there are multiple developers, need to set our lastEntered
+	-- to the prevEntered from the Activity Seen, so we can follow on to
+	-- another developer's activity.
+	--
+	-- But, if there's lag, we may have sent some Activity Entered
+	-- that had not reached the user yet when it constructed the
+	-- Activity Seen, so check if the prevEntered is one of the
+	-- things we've enteredSince; if so keep our lastEntered.
+	newlastentered = case prevEntered act of
+		Just v | v `notElem` enteredSince ds -> Just v
+		_ -> lastEntered ds
+
 -- | Start by reading the initial two messages from the user,
 -- their session key and the startup message.
 processSessionStart :: MySessionKey -> TMChan (MissingHashes AnyMessage) -> Logger -> TMVar (TVar DeveloperState) -> IO (TVar DeveloperState, Output)
@@ -412,7 +432,7 @@ processSessionStart sk ochan logger dsv = do
 		<$> atomically (readTMChan ochan)
 	logger startmsg
 	let (starthash, output) = case startmsg of
-		User (ActivityMessage act@(Activity (Seen (Val b)) Nothing _ _))
+		User (ActivityMessage act@(Activity (Seen (Val b)) Nothing Nothing _ _))
 			| verifySigned sigverifier act ->
 				(hash act, TtyOutput b)
 			| otherwise ->
@@ -424,6 +444,7 @@ processSessionStart sk ochan logger dsv = do
 		, enteredSince = mempty
 		, lastActivity = starthash
 		, lastActivityTs = ts
+		, lastEntered = Nothing
 		, fromOtherDevelopersSince = mempty
 		, developerSessionKey = sk
 		, userSigVerifier = sigverifier