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, 17 deletions

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) =