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.

2 files changed, 66 insertions, 29 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
diff --git a/Role/User.hs b/Role/User.hs
index e1138c2..a7e4843 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -12,6 +12,7 @@ import Pty
 import Memory
 import Log
 import Session
+import Hash
 import Crypto
 import Gpg
 import CmdLine
@@ -98,13 +99,15 @@ data UserState = UserState
 	, userSessionKey :: MySessionKey
 	, sigVerifier :: SigVerifier
 	, lastSeenTs :: POSIXTime
+	, lastAcceptedEntered :: Maybe Hash
 	}
 
 -- | RecentActivity that uses the UserState.
 userStateRecentActivity :: TVar UserState -> RecentActivity
 userStateRecentActivity us = do
 	st <- readTVar us
-	let hs = mapMaybe loggedHash $ toList $ backLog st
+	let hs = catMaybes $ lastAcceptedEntered st
+		: map loggedHash (toList (backLog st))
 	return (sigVerifier st, hs)
 
 -- | Start by establishing our session key, and displaying the starttxt.
@@ -118,7 +121,9 @@ startProtocol starttxt ochan logger = do
 	let c = mkSigned sk $ Control (SessionKey pk)
 	initialmessage $ ControlMessage c
 	let starttxt' = rawLine starttxt
-	let act = mkSigned sk $ Activity (Seen (Val starttxt')) Nothing mempty
+	let act = mkSigned sk $ Activity
+		(Seen (Val starttxt'))
+		Nothing Nothing mempty
 	let startmsg = ActivityMessage act
 	B.hPut stdout starttxt'
 	hFlush stdout
@@ -130,6 +135,7 @@ startProtocol starttxt ochan logger = do
 		, userSessionKey = sk
 		, sigVerifier = mempty
 		, lastSeenTs = now
+		, lastAcceptedEntered = Nothing
 		}
 
 -- | Forward things the user types to the Pty.
@@ -177,6 +183,7 @@ instance SendableToDeveloper Seen where
 			mkSigned (userSessionKey st) $ 
 				Activity seen
 					(loggedHash prev)
+					(lastAcceptedEntered st)
 					(mkElapsedTime (lastSeenTs st) now)
 		let l = mkLog (User msg) now
 		writeTMChan ochan msg
@@ -214,14 +221,15 @@ sendPtyInput ichan ochan controlinput p us logger = go
 				logger $ Developer msg
 				atomically $ writeTMChan controlinput (ControlInputAction c)
 				go
-			Just (RejectedMessage rej) -> do
+			Just (RejectedMessage ent rej) -> do
+				logger $ Developer ent
 				logger $ User rej
 				go
 			Just (BadlySignedMessage _) -> go
 
 data Input
 	= InputMessage (Message Entered)
-	| RejectedMessage (Message Seen)
+	| RejectedMessage (Message Entered) (Message Seen)
 	| BadlySignedMessage (Message Entered)
 
 -- Get message from developer, verify its signature is from a developer we
@@ -258,11 +266,18 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do
 					if isLegalEntered entered (st { backLog = bl' })
 						then do
 							let l = mkLog (Developer msg) now
-							writeTVar us (st { backLog = l :| toList bl' })
+							writeTVar us $ st 
+								{ backLog = l :| toList bl'
+								, lastAcceptedEntered = Just (hash entered)
+								}
 							return (InputMessage msg)
 						else do
-							let reject = Rejected entered
-							RejectedMessage <$> sendDeveloper ochan us reject now
+							let reject = EnteredRejected 
+								{ enteredRejected = hash entered
+								, enteredLastAccepted = lastAcceptedEntered st
+								}
+							RejectedMessage msg
+								<$> sendDeveloper ochan us reject now
 				ControlMessage (Control _ _) ->
 					return (InputMessage msg)
 			else return (BadlySignedMessage msg)
@@ -278,7 +293,7 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do
 -- If the Activity refers to an item not in the backlog, no truncation is
 -- done.
 truncateBacklog :: Backlog -> Activity Entered -> Backlog
-truncateBacklog (b :| l) (Activity _ (Just hp) _ _)
+truncateBacklog (b :| l) (Activity _ (Just hp) _ _ _)
 	| truncationpoint b = b :| []
 	| otherwise = b :| go [] l
   where
@@ -288,7 +303,7 @@ truncateBacklog (b :| l) (Activity _ (Just hp) _ _)
 		| otherwise = go (x:c) xs
 	truncationpoint x@(Log { loggedMessage = User {}}) = loggedHash x == Just hp
 	truncationpoint _ = False
-truncateBacklog bl (Activity _ Nothing _ _) = bl
+truncateBacklog bl (Activity _ Nothing _ _ _) = bl
 
 -- | To avoid DOS attacks that try to fill up the backlog and so use all
 -- memory, don't let the backlog contain more than 1000 items, or
@@ -302,23 +317,24 @@ reduceBacklog (b :| l) = b :| go 0 (take 1000 l)
 		| n > 16777216 = []
 		| otherwise = x : go (n + dataSize x) xs
 
--- | Entered activity is legal when it points to the last logged activity,
--- because this guarantees that the person who entered it saw
--- the current state of the system before manipulating it.
+-- | Entered activity is legal when its prevActivity points to the last
+-- logged activity, because this guarantees that the person who entered
+-- it saw the current state of the system before manipulating it.
 --
 -- To support typeahead on slow links, some echoData may be provided
 -- in the Entered activity. If the Entered activity points
--- to an older activity, then the echoData must match the
+-- to an older prevActivity, then the echoData must match the
 -- concatenation of all Seen activities after that one, up to the
 -- last logged activity.
 --
--- Activities that do not enter data point to the first message
--- sent in the debug-me session.
+-- Also, the prevEntered field must point to the last accepted
+-- Entered activity.
 --
 -- Does not check the signature.
 isLegalEntered :: Activity Entered -> UserState -> Bool
-isLegalEntered (Activity _ Nothing _ _) _ = False
-isLegalEntered (Activity a (Just hp) _ _) us
+isLegalEntered (Activity _ Nothing _ _ _) _ = False
+isLegalEntered (Activity a (Just hp) lastentered _ _) us
+	| lastentered /= lastAcceptedEntered us = False
 	| loggedHash lastact == Just hp = True
 	| B.null (val (echoData a)) = False -- optimisation
 	| any (== Just hp) (map loggedHash bl) =