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.

8 files changed, 58 insertions, 38 deletions

diff --git a/ControlWindow.hs b/ControlWindow.hs
index 99fd4d3..2540640 100644
--- a/ControlWindow.hs
+++ b/ControlWindow.hs
@@ -118,7 +118,7 @@ displayInput ochan ichan promptchan responsechan = loop
 	go (Just (ControlWindowMessage m)) = do
 		putStrLn m
 		loop
-	go (Just (ControlInputAction (SessionKey k))) = do
+	go (Just (ControlInputAction (SessionKey k _))) = do
 		askToAllow ochan promptchan responsechan k
 		loop
 	go (Just (ControlInputAction m@(ChatMessage {}))) = do
diff --git a/Hash.hs b/Hash.hs
index 6fb5614..8a33803 100644
--- a/Hash.hs
+++ b/Hash.hs
@@ -53,7 +53,7 @@ instance Hashable Seen where
 instance Hashable ControlAction where
 	hash (EnteredRejected h1 h2) = hash $ Tagged "EnteredRejected"
 		[hash h1, hash h2]
-	hash (SessionKey pk) = hash $ Tagged "SessionKey" pk
+	hash (SessionKey pk v) = hash $ Tagged "SessionKey" [hash pk, hash v]
 	hash (SessionKeyAccepted pk) = hash $ Tagged "SessionKeyAccepted" pk
 	hash (SessionKeyRejected pk) = hash $ Tagged "SessionKeyRejected" pk
 	hash (ChatMessage u m) = hash $ Tagged "ChatMessage" [hash u, hash m]
diff --git a/ProtocolBuffers.hs b/ProtocolBuffers.hs
index 42d3e0b..e87a156 100644
--- a/ProtocolBuffers.hs
+++ b/ProtocolBuffers.hs
@@ -65,65 +65,67 @@ data ControlActionP
 		, enteredLastAcceptedP :: Optional 12 (Message HashP)
 		}
 	| SessionKeyP
-		{ sessionKeyP :: Required 13 (Message (PerhapsSignedP PublicKeyP)) }
+		{ sessionKeyP :: Required 13 (Message (PerhapsSignedP PublicKeyP))
+		, protocolVersionP :: Required 14 (Value B.ByteString)
+		}
 	| SessionKeyAcceptedP
-		{ sessionKeyAcceptedP :: Required 14 (Message PublicKeyP) }
+		{ sessionKeyAcceptedP :: Required 15 (Message PublicKeyP) }
 	| SessionKeyRejectedP
-		{ sessionKeyRejectedP :: Required 15 (Message PublicKeyP) }
+		{ sessionKeyRejectedP :: Required 16 (Message PublicKeyP) }
 	| ChatMessageP
-		{ chatMessageSenderName :: Required 16 (Value B.ByteString)
-		, chatMessage :: Required 17 (Value B.ByteString)
+		{ chatMessageSenderName :: Required 17 (Value B.ByteString)
+		, chatMessage :: Required 18 (Value B.ByteString)
 		}
 	deriving (Generic)
 
 data SignatureP
 	= Ed25519SignatureP
-		{ ed25519SignatureP :: Required 18 (Value B.ByteString) }
+		{ ed25519SignatureP :: Required 19 (Value B.ByteString) }
 	| OtherSignatureP
-		{ otherSignatureP :: Required 19 (Value B.ByteString) }
+		{ otherSignatureP :: Required 20 (Value B.ByteString) }
 	deriving (Generic)
 
 data PublicKeyP = PublicKeyP 
-	{ mkPublicKeyP :: Required 20 (Value B.ByteString) }
+	{ mkPublicKeyP :: Required 21 (Value B.ByteString) }
 	deriving (Generic)
 
 data PerhapsSignedP a
 	= GpgSignedP
-		{ gpgSignedValP :: Required 21 (Message a)
-		, gpgSigP :: Required 22 (Message GpgSigP)
-		, gpgKeyExportP :: Required 23 (Message GpgKeyExportP)
+		{ gpgSignedValP :: Required 22 (Message a)
+		, gpgSigP :: Required 23 (Message GpgSigP)
+		, gpgKeyExportP :: Required 24 (Message GpgKeyExportP)
 		}
 	| UnSignedP
-		{ mkUnSignedP :: Required 24 (Message a )
+		{ mkUnSignedP :: Required 25 (Message a )
 		}
 	deriving (Generic)
 
 data GpgSigP = GpgSigP
-	{ mkGpgSigP :: Required 25 (Value B.ByteString) }
+	{ mkGpgSigP :: Required 26 (Value B.ByteString) }
 	deriving (Generic)
 
 data GpgKeyExportP = GpgKeyExportP
-	{ mkGpgKeyExportP :: Required 26 (Value B.ByteString) }
+	{ mkGpgKeyExportP :: Required 27 (Value B.ByteString) }
 	deriving (Generic)
 
 data ElapsedTimeP = ElapsedTimeP
-	{ mkElapsedTimeP :: Required 27 (Value Double) }
+	{ mkElapsedTimeP :: Required 28 (Value Double) }
 	deriving (Generic)
 
 data AnyMessageP
-	= UserP { mkUserP :: Required 28 (Message (MessageP SeenP)) }
-	| DeveloperP { mkDeveloperP :: Required 29 (Message (MessageP EnteredP)) }
+	= UserP { mkUserP :: Required 29 (Message (MessageP SeenP)) }
+	| DeveloperP { mkDeveloperP :: Required 30 (Message (MessageP EnteredP)) }
 	deriving (Generic)
 
 data HashP = HashP
-	{ hashMethodP :: Required 30 (Message HashMethodP)
-	, hashValueP :: Required 31 (Value B.ByteString)
+	{ hashMethodP :: Required 31 (Message HashMethodP)
+	, hashValueP :: Required 32 (Value B.ByteString)
 	}
 	deriving (Generic)
 
 data HashMethodP
-	= SHA512P { mkSHA512P :: Required 32 (Value Bool) }
-	| SHA3P { mkSHA3P :: Required 33 (Value Bool) }
+	= SHA512P { mkSHA512P :: Required 33 (Value Bool) }
+	| SHA3P { mkSHA3P :: Required 34 (Value Bool) }
 	deriving (Generic)
 
 -- | Conversion between protocol buffer messages and debug-me's main Types.
@@ -190,8 +192,10 @@ instance ProtocolBuffer ControlActionP T.ControlAction where
 		{ enteredRejectedP = putField $ toProtocolBuffer $ T.enteredRejected t
 		, enteredLastAcceptedP = putField $ toProtocolBuffer <$> T.enteredLastAccepted t
 		}
-	toProtocolBuffer (T.SessionKey t) = SessionKeyP
-		{ sessionKeyP = putField $ toProtocolBuffer t }
+	toProtocolBuffer (T.SessionKey t v) = SessionKeyP
+		{ sessionKeyP = putField $ toProtocolBuffer t
+		, protocolVersionP = putField $ val v
+		}
 	toProtocolBuffer (T.SessionKeyAccepted t) = SessionKeyAcceptedP
 		{ sessionKeyAcceptedP = putField $ toProtocolBuffer t }
 	toProtocolBuffer (T.SessionKeyRejected t) = SessionKeyRejectedP
@@ -204,8 +208,9 @@ instance ProtocolBuffer ControlActionP T.ControlAction where
 		{ T.enteredRejected = fromProtocolBuffer $ getField $ enteredRejectedP p
 		, T.enteredLastAccepted = fromProtocolBuffer <$> getField (enteredLastAcceptedP p)
 		}
-	fromProtocolBuffer p@(SessionKeyP {}) = T.SessionKey $
-		fromProtocolBuffer $ getField $ sessionKeyP p
+	fromProtocolBuffer p@(SessionKeyP {}) = T.SessionKey
+		(fromProtocolBuffer $ getField $ sessionKeyP p)
+		(Val $ getField $ protocolVersionP p)
 	fromProtocolBuffer p@(SessionKeyAcceptedP {}) = T.SessionKeyAccepted $
 		fromProtocolBuffer $ getField $ sessionKeyAcceptedP p
 	fromProtocolBuffer p@(SessionKeyRejectedP {}) = T.SessionKeyRejected $
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
diff --git a/Types.hs b/Types.hs
index 79ce289..ce986c7 100644
--- a/Types.hs
+++ b/Types.hs
@@ -3,7 +3,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE DeriveGeneric, FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE DeriveGeneric, FlexibleInstances, FlexibleContexts, OverloadedStrings #-}
 
 {- | Main types for debug-me
  -
@@ -101,7 +101,7 @@ data ControlAction
 		, enteredLastAccepted :: Maybe Hash
 		-- ^ The last Entered value that was accepted.
 		}
-	| SessionKey (PerhapsSigned PublicKey)
+	| SessionKey (PerhapsSigned PublicKey) ProtocolVersion
 	-- ^ sent by user at start, and later by developer,
 	-- to indicate their session key
 	| SessionKeyAccepted PublicKey
@@ -112,12 +112,17 @@ data ControlAction
 	-- ^ sent by user or developer at any time
 	deriving (Show, Generic)
 
+type ProtocolVersion = Val
+
+currentProtocolVersion :: ProtocolVersion
+currentProtocolVersion = Val "1"
+
 type SenderName = Val
 
 instance DataSize ControlAction where
 	dataSize (EnteredRejected h1 h2) = dataSize h1 +
 		maybe 0 dataSize h2
-	dataSize (SessionKey k) = dataSize k
+	dataSize (SessionKey k v) = dataSize k + dataSize v
 	dataSize (SessionKeyAccepted k) = dataSize k
 	dataSize (SessionKeyRejected k) = dataSize k
 	dataSize (ChatMessage s m) = dataSize s + dataSize m
diff --git a/Verify.hs b/Verify.hs
index 63e81f6..c485683 100644
--- a/Verify.hs
+++ b/Verify.hs
@@ -31,9 +31,9 @@ verify opts = go 1 startState =<< streamLog (verifyLogFile opts)
 
 		-- Learn session keys before verifying signatures.
 		st' <- case msg of
-			User (ControlMessage (Control { control = SessionKey sk })) ->
+			User (ControlMessage (Control { control = SessionKey sk _ })) ->
 				addSessionKey lineno sk st
-			Developer (ControlMessage (Control { control = SessionKey sk })) ->
+			Developer (ControlMessage (Control { control = SessionKey sk _ })) ->
 				addSessionKey lineno sk st
 			_ -> return st
 
diff --git a/doc/protocol.mdwn b/doc/protocol.mdwn
index 2c4887e..94f4ee1 100644
--- a/doc/protocol.mdwn
+++ b/doc/protocol.mdwn
@@ -107,3 +107,13 @@ The prevActivity and prevEntered hashes are actually not included in the
 data sent across the wire. They are left out to save space, and get
 added back in by the receiver. The receiver uses the signature of the
 message to tell when it's found the right hashes to add back in.
+
+## protocol versioning
+
+The SessionKey control messages include a field for the protocol version.
+Since the user starts by sending a SessionKey, the included version
+specifies the protocol version used by the rest of the protocol. When
+developers connect, their clients will need to check that version,
+and avoid sending any messages using features from a later version.
+
+The current protocol version is "1".