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.

1 files changed, 25 insertions, 12 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index 89ce2cf..8e27b30 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -20,6 +20,7 @@ import qualified Data.Text as T
 import Data.List
 import Data.Maybe
 import Control.Monad
+import Data.Time.Clock.POSIX
 
 run :: DeveloperOpts -> IO ()
 run = run' developer . debugUrl
@@ -49,6 +50,7 @@ data DeveloperState = DeveloperState
 	, enteredSince :: [Hash]
 	-- ^ Messages we've sent since the last Seen.
 	, lastActivity :: Hash
+	, lastActivityTs :: POSIXTime
 	-- ^ Last message sent or received.
 	, fromOtherDevelopersSince :: [Hash]
 	-- ^ Messages received from other developers since the last Seen.
@@ -71,6 +73,7 @@ sendTtyInput ichan devstate logger = go
 			then return ()
 			else send b
 	send b = do
+		ts <- getPOSIXTime
 		act <- atomically $ do
 			ds <- readTVar devstate
 			let ed = if lastActivity ds == lastSeen ds
@@ -83,13 +86,16 @@ sendTtyInput ichan devstate logger = go
 				, echoData = Val ed
 				}
 			let act = mkSigned (developerSessionKey ds) $
-				Activity entered (Just $ lastActivity ds)
+				Activity entered
+					(Just $ lastActivity ds)
+					(Just $ mkElapsedTime (lastActivityTs ds) ts)
 			writeTMChan ichan (ActivityMessage act)
 			let acth = hash act
 			let ds' = ds
 				{ sentSince = sentSince ds ++ [b]
 				, enteredSince = enteredSince ds ++ [acth]
 				, lastActivity = acth
+				, lastActivityTs = ts
 				}
 			writeTVar devstate ds'
 			return act
@@ -101,7 +107,8 @@ sendTtyOutput :: TMChan LogMessage -> TVar DeveloperState -> Logger -> IO ()
 sendTtyOutput ochan devstate logger = go
   where
 	go = do
-		v <- atomically $ getServerMessage ochan devstate
+		ts <- getPOSIXTime
+		v <- atomically $ getServerMessage ochan devstate ts
 		case v of
 			Nothing -> return ()
 			Just (o, l) -> do
@@ -123,8 +130,9 @@ authUser ichan ochan devstate logger = do
 	waitresp pk
   where
 	waitresp pk = do
+		ts <- getPOSIXTime
 		(o, msg) <- fromMaybe (error "Looks like that debug-me session is over.")
-			<$> atomically (getServerMessage ochan devstate)
+			<$> atomically (getServerMessage ochan devstate ts)
 		logger msg
 		emitOutput o
 		case o of
@@ -157,9 +165,9 @@ emitOutput NoOutput =
 
 -- | Get messages from server, check their signature, and make sure that they
 -- 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
+getServerMessage :: TMChan LogMessage -> TVar DeveloperState -> POSIXTime -> STM (Maybe (Output, LogMessage))
+getServerMessage ochan devstate ts = do
+	let ignore = getServerMessage ochan devstate ts
 	mmsg <- readTMChan ochan
 	case mmsg of
 		Nothing -> return Nothing
@@ -193,8 +201,8 @@ getServerMessage ochan devstate = do
 					return (Just (NoOutput, Developer msg))
 				else ignore
   where
-	processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _)) = do
-		let (legal, ds') = isLegalSeen act ds
+	processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _)) = do
+		let (legal, ds') = isLegalSeen act ds ts
 		if legal
 			then do
 				writeTVar devstate ds'
@@ -227,9 +235,10 @@ getServerMessage ochan devstate = do
 -- ones, and returns an updated DeveloperState.
 --
 -- Does not check the signature.
-isLegalSeen :: Activity Seen -> DeveloperState -> (Bool, DeveloperState)
-isLegalSeen (Activity _ Nothing _) ds = (False, ds)
-isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
+isLegalSeen :: Activity Seen -> DeveloperState -> POSIXTime -> (Bool, DeveloperState)
+isLegalSeen (Activity _ Nothing _ _) ds _ = (False, ds)
+isLegalSeen (Activity _ _ Nothing _) ds _ = (False, ds)
+isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts
 	-- 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 = 
@@ -246,6 +255,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
 			, sentSince = ss'
 			, enteredSince = es'
 			, lastActivity = acth
+			, lastActivityTs = ts
 			, fromOtherDevelopersSince = mempty
 			}
 	-- Does it chain to something we've entered since the last Seen
@@ -265,6 +275,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
 				, sentSince = ss'
 				, enteredSince = es'
 				, lastActivity = acth
+				, lastActivityTs = ts
 				, fromOtherDevelopersSince = mempty
 				}
   where
@@ -289,16 +300,18 @@ processSessionStart ochan logger = do
 		<$> atomically (readTMChan ochan)
 	logger startmsg
 	let (starthash, output) = case startmsg of
-		User (ActivityMessage act@(Activity (Seen (Val b)) Nothing _))
+		User (ActivityMessage act@(Activity (Seen (Val b)) Nothing Nothing _))
 			| verifySigned sigverifier act ->
 				(hash act, TtyOutput b)
 		_ -> error $ "Unexpected startup message: " ++ show startmsg
 	sk <- genMySessionKey
+	ts <- getPOSIXTime
 	st <- newTVarIO $ DeveloperState
 		{ lastSeen = starthash
 		, sentSince = mempty
 		, enteredSince = mempty
 		, lastActivity = starthash
+		, lastActivityTs = ts
 		, fromOtherDevelopersSince = mempty
 		, developerSessionKey = sk
 		, userSigVerifier = sigverifier