From 9102a47c6c68039a288a6ee8f43fe14b034ce356 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 18 Apr 2017 14:18:16 -0400
Subject: add --replay option

This commit was sponsored by Ole-Morten Duesund on Patreon.
---
 Replay.hs      | 27 +++++++++++++++++++++++----
 Session.hs     | 13 +++++++++++++
 TODO           |  3 ++-
 debug-me.cabal |  2 ++
 debug-me.hs    |  6 +++---
 5 files changed, 43 insertions(+), 8 deletions(-)
 create mode 100644 Session.hs

diff --git a/Replay.hs b/Replay.hs
index 599ca77..b50bc40 100644
--- a/Replay.hs
+++ b/Replay.hs
@@ -3,10 +3,29 @@ module Replay where
 import Types
 import Log
 import CmdLine
+import Session
+
+import qualified Data.ByteString as B
+import System.IO
+import Control.Concurrent.Thread.Delay
 
 replay :: ReplayOpts -> IO ()
-replay opts = go =<< loadLog (replayLogFile opts)
+replay opts = go Nothing =<< loadLog (replayLogFile opts)
   where
-	go [] = return ()
-	go (l:ls) = do
-		go ls
+	go _ [] = sessionDone
+	go prevts (l:ls) = do
+		case prevts of
+			Nothing -> return ()
+			Just t ->
+				let s = loggedTimestamp l - t
+				    ms = s * 1000000
+				in delay (ceiling ms)
+
+		case loggedActivity l of
+			ActivityEntered {} -> return ()
+			ActivitySeen a -> case activity a of
+				Rejected {} -> return ()
+				Proto s -> do
+					B.hPut stdout (val (seenData s))
+					hFlush stdout
+		go (Just $ loggedTimestamp l) ls
diff --git a/Session.hs b/Session.hs
new file mode 100644
index 0000000..e7bf674
--- /dev/null
+++ b/Session.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts #-}
+
+module Session where
+
+import qualified Data.ByteString as B
+
+startSession :: B.ByteString
+startSession = ">>> debug-me session starting"
+
+sessionDone :: IO ()
+sessionDone = do
+	putStrLn ""
+	putStrLn ">>> debug-me session is done"
diff --git a/TODO b/TODO
index 24f9f35..bfe4e07 100644
--- a/TODO
+++ b/TODO
@@ -1,4 +1,5 @@
-* Add timings, so logs can be replayed.
+* loadLog should verify the hashes (and signatures) in the log, and
+  refuse to use logs that are not valid proofs of a session.
 * potential DOS where developer sends Activity Entered that all
   refer back to the first Activity Seen. This requires the user
   side to keep a Backlog containing all later Activity Seen, so uses
diff --git a/debug-me.cabal b/debug-me.cabal
index 37d8357..cc34c0c 100644
--- a/debug-me.cabal
+++ b/debug-me.cabal
@@ -37,6 +37,7 @@ Executable debug-me
     , optparse-applicative (>= 0.12)
     , graphviz (== 2999.18.*)
     , time (>= 1.6)
+    , unbounded-delays (>= 0.1)
   Other-Modules:
     CmdLine
     Graphviz
@@ -44,6 +45,7 @@ Executable debug-me
     Log
     Pty
     Replay
+    Session
     Types
     Val
 
diff --git a/debug-me.hs b/debug-me.hs
index 0b51878..3cc1f09 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -9,6 +9,7 @@ import CmdLine
 import Log
 import Graphviz
 import Replay
+import Session
 
 import Control.Concurrent
 import Control.Concurrent.Async
@@ -32,9 +33,8 @@ main = do
  
 test :: IO ()
 test = do
-	exitstatus <- go ">>> debug-me session starting"
-	putStrLn ""
-	putStrLn ">>> debug-me session is done"
+	exitstatus <- go startSession
+	sessionDone
 	exitWith exitstatus
   where
 	go startmsg = runWithPty "dash" [] $ \(p, ph) -> do
-- 
cgit v1.2.3