add protocol version

This is distinct from the wire protocol version used in the websocket
framing of messages. Versioning the high level protocol will let later
features be added.

The user controls the protocol version, since they send the first
several messages. Developers that connect need to avoid using features
from newer protocol versions.

So, developers and servers will need to support the most recent version,
while the user can have an old version of debug-me and it will continue
to work.

This commit changes the protocol buffer encoding, and is the last such
free change. All changes past this point will need to be versioned.

This commit was sponsored by Jochen Bartl on Patreon.

2 files changed, 6 insertions, 6 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index 2cdf917..d706a7a 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -226,7 +226,7 @@ authUser :: PerhapsSigned PublicKey -> TMChan (Message Entered) -> TMChan (Missi
 authUser spk ichan ochan devstate logger = do
 	ds <- atomically $ readTVar devstate
 	let msg = ControlMessage $ mkSigned (developerSessionKey ds) 
-		(Control (SessionKey spk))
+		(Control (SessionKey spk currentProtocolVersion))
 	atomically $ writeTMChan ichan msg
 	logger $ Developer msg
 	waitresp $ case spk of
@@ -291,7 +291,7 @@ getServerMessage ochan devstate ts = do
 				return (Just (o, User msg))
 			else return $ Just (ProtocolError ds $ "Bad signature on message from user: " ++ show msg, User msg)
 	-- When other developers connect, learn their SessionKeys.
-	process (Developer msg@(ControlMessage (Control (SessionKey spk) _))) = do
+	process (Developer msg@(ControlMessage (Control (SessionKey spk _) _))) = do
 		let sigverifier = mkSigVerifier $ case spk of
 			GpgSigned pk _ _ -> pk
 			UnSigned pk -> pk
@@ -334,7 +334,7 @@ getServerMessage ochan devstate ts = do
 			}
 		writeTVar devstate ds'
 		return Beep
-	processuser _ (ControlMessage (Control c@(SessionKey _) _)) =
+	processuser _ (ControlMessage (Control c@(SessionKey _ _) _)) =
 		return (GotControl c)
 	processuser _ (ControlMessage (Control c@(SessionKeyAccepted _) _)) =
 		return (GotControl c)
@@ -421,7 +421,7 @@ processSessionStart sk ochan logger dsv = do
 		<$> atomically (readTMChan ochan)
 	logger sessionmsg
 	sigverifier <- case sessionmsg of
-		User (ControlMessage c@(Control (SessionKey spk) _)) -> do
+		User (ControlMessage c@(Control (SessionKey spk _) _)) -> do
 			let pk = case spk of
 				GpgSigned k _ _ -> k
 				UnSigned k -> k
diff --git a/Role/User.hs b/Role/User.hs
index 6c6fb39..6ee1a42 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -118,7 +118,7 @@ startProtocol starttxt ochan logger = do
 		logger $ User msg
 	sk <- genMySessionKey
 	pk <- myPublicKey sk (GpgSign False)
-	let c = mkSigned sk $ Control (SessionKey pk)
+	let c = mkSigned sk $ Control (SessionKey pk currentProtocolVersion)
 	initialmessage $ ControlMessage c
 	let starttxt' = rawLine starttxt
 	let act = mkSigned sk $ Activity
@@ -248,7 +248,7 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do
 	st <- readTVar us
 	Developer msg <- restoreHashes (userStateRecentActivity us) (MissingHashes (Developer wiremsg))
 	case msg of
-		ControlMessage (Control (SessionKey spk) _) -> do
+		ControlMessage (Control (SessionKey spk _) _) -> do
 			let sigverifier = mkSigVerifier $ case spk of
 				GpgSigned pk _ _ -> pk
 				UnSigned pk -> pk