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, 59 insertions, 24 deletions

diff --git a/ProtocolBuffers.hs b/ProtocolBuffers.hs
index d5d6a0e..2d59528 100644
--- a/ProtocolBuffers.hs
+++ b/ProtocolBuffers.hs
@@ -48,9 +48,6 @@ data MessageP a
 
 data ActivityP a = ActivityP
 	{ activityP :: Required 6 (Message a)
-	-- This is not included, because the hash is never actually sent
-	-- over the wire!
-	-- , prevAtivityP :: Optional 7 (Message HashP)
 	, elapsedTimeP :: Required 8 (Message ElapsedTimeP)
 	, activitySignatureP :: Required 9 (Message SignatureP)
 	}
@@ -63,52 +60,65 @@ data ControlP = ControlP
 	deriving (Generic)
 
 data ControlActionP
-	= RejectedP
-		{ rejectedP :: Required 12 (Message (ActivityP EnteredP)) }
+	= EnteredRejectedP
+		{ enteredRejectedP :: Required 12 (Message HashP)
+		, enteredLastAcceptedP :: Optional 13 (Message HashP)
+		}
 	| SessionKeyP
-		{ sessionKeyP :: Required 13 (Message (PerhapsSignedP PublicKeyP)) }
+		{ sessionKeyP :: Required 14 (Message (PerhapsSignedP PublicKeyP)) }
 	| 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)
+		{ gpgSignedValP :: Required 22 (Message a)
+		, gpgSigP :: Required 23 (Message GpgSigP)
 		}
 	| UnSignedP
-		{ mkUnSignedP :: Required 23 (Message a )
+		{ mkUnSignedP :: Required 24 (Message a )
 		}
 	deriving (Generic)
 
 data GpgSigP = GpgSigP
-	{ mkGpgSigP :: Required 24 (Value B.ByteString) }
+	{ mkGpgSigP :: Required 25 (Value B.ByteString) }
 	deriving (Generic)
 
 data ElapsedTimeP = ElapsedTimeP
-	{ mkElapsedTimeP :: Required 25 (Value Double) }
+	{ mkElapsedTimeP :: Required 26 (Value Double) }
 	deriving (Generic)
 
 data AnyMessageP
-	= UserP { mkUserP :: Required 26 (Message (MessageP SeenP)) }
-	| DeveloperP { mkDeveloperP :: Required 27 (Message (MessageP EnteredP)) }
+	= UserP { mkUserP :: Required 27 (Message (MessageP SeenP)) }
+	| DeveloperP { mkDeveloperP :: Required 28 (Message (MessageP EnteredP)) }
+	deriving (Generic)
+
+data HashP = HashP
+	{ hashMethodP :: Required 29 (Message HashMethodP)
+	, hashValueP :: Required 30 (Value B.ByteString)
+	}
+	deriving (Generic)
+
+data HashMethodP
+	= SHA512P { mkSHA512P :: Required 31 (Value Bool) }
+	| SHA3P { mkSHA3P :: Required 32 (Value Bool) }
 	deriving (Generic)
 
 -- | Conversion between protocol buffer messages and debug-me's main Types.
@@ -155,6 +165,7 @@ instance ProtocolBuffer p t => ProtocolBuffer (ActivityP p) (T.Activity t) where
 	fromProtocolBuffer p = T.Activity
 		{ T.activity = fromProtocolBuffer $ getField $ activityP p
 		, T.prevActivity = Nothing -- not sent over the wire
+		, T.prevEntered = Nothing -- not sent over the wire
 		, T.elapsedTime = fromProtocolBuffer $ getField $ elapsedTimeP p
 		, T.activitySignature = fromProtocolBuffer $ getField $ activitySignatureP p
 		}
@@ -170,8 +181,10 @@ instance ProtocolBuffer ControlP T.Control where
 		}
 
 instance ProtocolBuffer ControlActionP T.ControlAction where
-	toProtocolBuffer (T.Rejected t) = RejectedP
-		{ rejectedP = putField $ toProtocolBuffer t }
+	toProtocolBuffer t@(T.EnteredRejected {}) = EnteredRejectedP
+		{ enteredRejectedP = putField $ toProtocolBuffer $ T.enteredRejected t
+		, enteredLastAcceptedP = putField $ toProtocolBuffer <$> T.enteredLastAccepted t
+		}
 	toProtocolBuffer (T.SessionKey t) = SessionKeyP
 		{ sessionKeyP = putField $ toProtocolBuffer t }
 	toProtocolBuffer (T.SessionKeyAccepted t) = SessionKeyAcceptedP
@@ -182,8 +195,10 @@ instance ProtocolBuffer ControlActionP T.ControlAction where
 		{ chatMessageSenderName = putField (val sendername)
 		, chatMessage = putField (val t)
 		}
-	fromProtocolBuffer p@(RejectedP {}) = T.Rejected $
-		fromProtocolBuffer $ getField $ rejectedP p
+	fromProtocolBuffer p@(EnteredRejectedP {}) = T.EnteredRejected
+		{ T.enteredRejected = fromProtocolBuffer $ getField $ enteredRejectedP p
+		, T.enteredLastAccepted = fromProtocolBuffer <$> getField (enteredLastAcceptedP p)
+		}
 	fromProtocolBuffer p@(SessionKeyP {}) = T.SessionKey $
 		fromProtocolBuffer $ getField $ sessionKeyP p
 	fromProtocolBuffer p@(SessionKeyAcceptedP {}) = T.SessionKeyAccepted $
@@ -204,6 +219,22 @@ instance ProtocolBuffer SignatureP T.Signature where
 	fromProtocolBuffer p@(OtherSignatureP {}) = T.OtherSignature $
 		Val $ getField $ otherSignatureP p
 
+instance ProtocolBuffer HashP T.Hash where
+	toProtocolBuffer t = HashP
+		{ hashMethodP = putField $ toProtocolBuffer $ T.hashMethod t
+		, hashValueP = putField $ val $ T.hashValue t
+		}
+	fromProtocolBuffer p = T.Hash
+		{ T.hashMethod = fromProtocolBuffer $ getField $ hashMethodP p
+		, T.hashValue = Val $ getField $ hashValueP p
+		}
+
+instance ProtocolBuffer HashMethodP T.HashMethod where
+	toProtocolBuffer T.SHA512 = SHA512P { mkSHA512P = putField True }
+	toProtocolBuffer T.SHA3 = SHA3P { mkSHA3P = putField True }
+	fromProtocolBuffer (SHA512P {}) = T.SHA512
+	fromProtocolBuffer (SHA3P {}) = T.SHA3
+
 instance ProtocolBuffer PublicKeyP T.PublicKey where
 	toProtocolBuffer (T.PublicKey t) = PublicKeyP
 		{ mkPublicKeyP = putField (val t) }
@@ -251,6 +282,10 @@ instance Encode ControlP
 instance Decode ControlP
 instance Encode ControlActionP
 instance Decode ControlActionP
+instance Encode HashP
+instance Decode HashP
+instance Encode HashMethodP
+instance Decode HashMethodP
 instance Encode SignatureP
 instance Decode SignatureP
 instance Encode PublicKeyP