latency simulations

1 files changed, 14 insertions, 13 deletions

diff --git a/debug-me.hs b/debug-me.hs
index bd80f01..4c034b9 100644
--- a/debug-me.hs
+++ b/debug-me.hs
@@ -36,8 +36,9 @@ main = do
 		cancel uthread
 		return exitstatus
 
+-- | 800 ms is about the latency to geosync orbit
 networkDelay :: IO ()
-networkDelay = threadDelay 1000000
+networkDelay = threadDelay 800000 -- 150000 -- 800000
 
 developer :: TChan (Activity Entered) -> TChan (Activity Seen) -> IO ()
 developer ichan ochan = do
@@ -58,7 +59,7 @@ data DeveloperState = DeveloperState
 	}
 	deriving (Show)
 
--- | Read things typed by the user, and forward them to the TChan.
+-- | Read things typed by the developer, and forward them to the TChan.
 sendTtyInput :: TChan (Activity Entered) -> TVar DeveloperState -> IO ()
 sendTtyInput ichan devstate = go
   where
@@ -80,7 +81,7 @@ sendTtyInput ichan devstate = go
 			writeTVar devstate ds'
 		go
 
--- | Read activity from the TChan and display it.
+-- | Read activity from the TChan and display it to the developer.
 sendTtyOutput :: TChan (Activity Seen) -> TVar DeveloperState -> IO ()
 sendTtyOutput ochan devstate = go
   where
@@ -95,21 +96,19 @@ sendTtyOutput ochan devstate = go
 		case act of
 			Activity (Seen b) hp sig
 				| hp == lastSeen ds -> do
+					let ss = sentSince ds
+					let ss' = if b `B.isPrefixOf` ss
+						then B.drop (B.length b) ss
+						else mempty
 					let ds' = DeveloperState
 						{ lastSeen = hash act
-						-- XXX is this right?
-						-- What if we get
-						-- a Seen that is
-						-- part of what
-						-- sentSince
-						-- contained?
-						, sentSince = mempty
+						, sentSince = ss'
 						}
 					writeTVar devstate ds'
 					return b
 			-- Got an activity out of order or
 			-- missed one somehow. Ignore it?
-			_ -> return ("bad input")
+			_ -> return mempty
 
 user :: Pty -> TChan (Activity Entered) -> TChan (Activity Seen) -> ProcessHandle -> IO ()
 user p ichan ochan ph = do
@@ -135,7 +134,9 @@ sendPtyOutput p ochan backlog ph = go
 			then do
 				terminateProcess ph
 				return ()
-			else send b
+			else do
+				-- networkDelay
+				send b
 	send b = do
 		atomically $ do
 			Backlog (bl@((prevhash, _) :| _)) <- readTVar backlog
@@ -171,7 +172,7 @@ sendPtyInput ichan p backlog = go
 				hFlush h
 				go
 			Left e -> do
-				print e
+				-- print e
 				go
 
 -- | Truncate the Backlog to remove entries older than the one