From 52f9c68869fa8956db55980f0b36ba817f825ffb Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 26 Apr 2017 16:15:43 -0400
Subject: include elapsedTime in Activity

Time is relative, so the debug-me proof chain doesn't prove when things
happened, but it's still useful to have some idea of how long things
took to happen. This makes --replay work with logs gotten by --download.

Log still includes loggedTimestamp. This is a bit redundant, and is
unused now, but it's useful for log files to record when messages were
received.

This commit was sponsored by Riku Voipio.
---
 Role/User.hs | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

(limited to 'Role/User.hs')

diff --git a/Role/User.hs b/Role/User.hs
index 7a1c01c..fc6eaea 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -70,6 +70,7 @@ data UserState = UserState
 	{ backLog :: Backlog
 	, userSessionKey :: MySessionKey
 	, sigVerifier :: SigVerifier
+	, lastSeenTs :: POSIXTime
 	}
 
 -- | Start by establishing our session key, and displaying the starttxt.
@@ -83,16 +84,18 @@ 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
+	let act = mkSigned sk $ Activity (Seen (Val starttxt')) Nothing Nothing
 	let startmsg = ActivityMessage act
 	B.hPut stdout starttxt'
 	hFlush stdout
 	initialmessage startmsg
-	l <- mkLog (User startmsg) <$> getPOSIXTime
+	now <- getPOSIXTime
+	let l = mkLog (User startmsg) now
 	newTVarIO $ UserState
 		{ backLog = l :| []
 		, userSessionKey = sk
 		, sigVerifier = mempty
+		, lastSeenTs = now
 		}
 
 -- | Forward things the user types to the Pty.
@@ -138,10 +141,15 @@ instance SendableToDeveloper Seen where
 		let bl@(prev :| _) = backLog st
 		let msg = ActivityMessage $
 			mkSigned (userSessionKey st) $ 
-				Activity seen (loggedHash prev)
+				Activity seen
+					(loggedHash prev)
+					(Just $ mkElapsedTime (lastSeenTs st) now)
 		let l = mkLog (User msg) now
 		writeTMChan ochan msg
-		writeTVar us $ st { backLog = l :| toList bl }
+		writeTVar us $ st
+			{ backLog = l :| toList bl
+			, lastSeenTs = now
+			}
 		return msg
 
 instance SendableToDeveloper ControlAction where
@@ -252,7 +260,7 @@ checkDeveloperPublicKey ochan us logger pk = 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
@@ -262,7 +270,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
@@ -291,8 +299,9 @@ reduceBacklog (b :| l) = b :| go 0 (take 1000 l)
 --
 -- 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 _ _ Nothing _) _ = False
+isLegalEntered (Activity a (Just hp) _ _) us
 	| loggedHash lastact == Just hp = True
 	| B.null (val (echoData a)) = False -- optimisation
 	| any (== Just hp) (map loggedHash bl) =
-- 
cgit v1.2.3