summaryrefslogtreecommitdiffhomepage
path: root/Role/User.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-26 16:15:43 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-26 16:18:01 -0400
commit52f9c68869fa8956db55980f0b36ba817f825ffb (patch)
treeb288b73ee5766a0048b1e2d593a0d0ec130044c0 /Role/User.hs
parent62f7653e39e95d3e9cd308810e487e3cdee84d52 (diff)
downloaddebug-me-52f9c68869fa8956db55980f0b36ba817f825ffb.tar.gz
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.
Diffstat (limited to 'Role/User.hs')
-rw-r--r--Role/User.hs25
1 files changed, 17 insertions, 8 deletions
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) =