make developer accept messages from user that chain to other developer's messages

This makes --download always work, which was the real motivation.

It's probably a good ways to having multiple connected developers able
to simulantaneously interact. I tested that breifly, and it seems to
work ok! It may however, not handle it perfectly when both developers
are trying to type at the same time. Still, nice that's basically
working for free!

This commit was sponsored by Jeff Goeke-Smith on Patreon.

1 files changed, 45 insertions, 6 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index e3d4a8c..89ce2cf 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -43,12 +43,22 @@ developer ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do
 
 data DeveloperState = DeveloperState
 	{ lastSeen :: Hash
+	-- ^ Last Seen value received from the user.
 	, sentSince :: [B.ByteString]
+	-- ^ Keys pressed since last Seen.
 	, enteredSince :: [Hash]
+	-- ^ Messages we've sent since the last Seen.
 	, lastActivity :: Hash
+	-- ^ Last message sent or received.
+	, fromOtherDevelopersSince :: [Hash]
+	-- ^ Messages received from other developers since the last Seen.
+	-- (The next Seen may chain from one of these.)
 	, developerSessionKey :: MySessionKey
+	-- ^ Our session key.
 	, userSigVerifier :: SigVerifier
 	-- ^ Used to verify signatures on messages from the user.
+	, developerSigVerifier :: SigVerifier
+	-- ^ Used to verify signatures on messages from other developers.
 	}
 
 -- | Read things typed by the developer, and forward them to the TMChan.
@@ -149,6 +159,7 @@ emitOutput NoOutput =
 -- are properly chained from past messages, before returning.
 getServerMessage :: TMChan LogMessage -> TVar DeveloperState -> STM (Maybe (Output, LogMessage))
 getServerMessage ochan devstate = do
+	let ignore = getServerMessage ochan devstate
 	mmsg <- readTMChan ochan
 	case mmsg of
 		Nothing -> return Nothing
@@ -159,11 +170,28 @@ getServerMessage ochan devstate = do
 				then do
 					o <- processuser ds msg
 					return (Just (o, User msg))
-				else getServerMessage ochan devstate
+				else ignore
+		-- When other developers connect, learn their SessionKeys.
+		Just (Developer msg@(ControlMessage (Control (SessionKey pk) _))) -> do
+			let sigverifier = mkSigVerifier pk
+			if verifySigned sigverifier msg
+				then do
+					ds <- readTVar devstate
+					let sv = developerSigVerifier ds
+					let sv' = sv `mappend` sigverifier
+					writeTVar devstate $ ds
+						{ developerSigVerifier = sv'
+						}
+					processdeveloper ds msg
+					return (Just (NoOutput, Developer msg))
+				else ignore
 		Just (Developer msg) -> do
-			-- Not bothering to check signatures of messages
-			-- from other developers. XXX
-			return (Just (NoOutput, Developer msg))
+			ds <- readTVar devstate
+			if verifySigned (developerSigVerifier ds) msg
+				then do
+					processdeveloper ds msg
+					return (Just (NoOutput, Developer msg))
+				else ignore
   where
 	processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _)) = do
 		let (legal, ds') = isLegalSeen act ds
@@ -189,6 +217,12 @@ getServerMessage ochan devstate = do
 	processuser _ (ControlMessage (Control c@(SessionKeyRejected _) _)) =
 		return (GotControl c)
 
+	processdeveloper ds (ActivityMessage a) = do
+		let msghash = hash a
+		let ss = msghash : fromOtherDevelopersSince ds
+		writeTVar devstate (ds { fromOtherDevelopersSince = ss })
+	processdeveloper _ (ControlMessage _) = return ()
+
 -- | Check if the Seen activity is legal, forming a chain with previous
 -- ones, and returns an updated DeveloperState.
 --
@@ -196,8 +230,9 @@ getServerMessage ochan devstate = do
 isLegalSeen :: Activity Seen -> DeveloperState -> (Bool, DeveloperState)
 isLegalSeen (Activity _ Nothing _) ds = (False, ds)
 isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
-	-- Does it chain to the last Seen activity?
-	| hp == lastSeen ds = 
+	-- 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 = 
 		-- Trim sentSince and enteredSince to
 		-- values after the Seen value.
 		let ss = sentSince ds
@@ -211,6 +246,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
 			, sentSince = ss'
 			, enteredSince = es'
 			, lastActivity = acth
+			, fromOtherDevelopersSince = mempty
 			}
 	-- Does it chain to something we've entered since the last Seen
 	-- value? Eg, user sent A, we replied B C, and the user has
@@ -229,6 +265,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
 				, sentSince = ss'
 				, enteredSince = es'
 				, lastActivity = acth
+				, fromOtherDevelopersSince = mempty
 				}
   where
 	acth = hash act
@@ -262,7 +299,9 @@ processSessionStart ochan logger = do
 		, sentSince = mempty
 		, enteredSince = mempty
 		, lastActivity = starthash
+		, fromOtherDevelopersSince = mempty
 		, developerSessionKey = sk
 		, userSigVerifier = sigverifier
+		, developerSigVerifier = mempty
 		}
 	return (st, output)