summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-27 10:29:33 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-27 10:29:33 -0400
commit952cc2941091518e61345f005b6e218bc34f75ec (patch)
treec5130b0dc4733f96b0855321919fe508b6d15fdc
parent937b55549b4ba72b0392d7e139e592a40eec2101 (diff)
downloaddebug-me-952cc2941091518e61345f005b6e218bc34f75ec.tar.gz
don't need Maybe ElapsedTime
Make it a monoid and use mempty = 0
-rw-r--r--Replay.hs6
-rw-r--r--Role/Developer.hs5
-rw-r--r--Role/User.hs5
-rw-r--r--Types.hs8
4 files changed, 14 insertions, 10 deletions
diff --git a/Replay.hs b/Replay.hs
index 8d2e3ae..c2c520e 100644
--- a/Replay.hs
+++ b/Replay.hs
@@ -15,7 +15,7 @@ replay opts = go =<< streamLog (replayLogFile opts)
go (Right l:ls) = do
case loggedMessage l of
User (ActivityMessage a) -> do
- maybe (return ()) realisticDelay (elapsedTime a)
+ realisticDelay (elapsedTime a)
B.hPut stdout $ val $ seenData $ activity a
hFlush stdout
User (ControlMessage _) -> return ()
@@ -24,4 +24,6 @@ replay opts = go =<< streamLog (replayLogFile opts)
go (Left l:_) = error $ "Failed to parse a line of the log: " ++ l
realisticDelay :: ElapsedTime -> IO ()
-realisticDelay (ElapsedTime n) = delay $ ceiling $ n * 1000000
+realisticDelay (ElapsedTime n)
+ | n < 1 = return ()
+ | otherwise = delay $ ceiling $ n * 1000000
diff --git a/Role/Developer.hs b/Role/Developer.hs
index a0e178e..b0d66a5 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -88,7 +88,7 @@ sendTtyInput ichan devstate logger = go
let act = mkSigned (developerSessionKey ds) $
Activity entered
(Just $ lastActivity ds)
- (Just $ mkElapsedTime (lastActivityTs ds) ts)
+ (mkElapsedTime (lastActivityTs ds) ts)
writeTMChan ichan (ActivityMessage act)
let acth = hash act
let ds' = ds
@@ -241,7 +241,6 @@ getServerMessage ochan devstate ts = do
-- Does not check the signature.
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?
@@ -307,7 +306,7 @@ processSessionStart ochan logger = do
<$> atomically (readTMChan ochan)
logger startmsg
let (starthash, output) = case startmsg of
- User (ActivityMessage act@(Activity (Seen (Val b)) Nothing Nothing _))
+ User (ActivityMessage act@(Activity (Seen (Val b)) Nothing _ _))
| verifySigned sigverifier act ->
(hash act, TtyOutput b)
_ -> error $ "Unexpected startup message: " ++ show startmsg
diff --git a/Role/User.hs b/Role/User.hs
index be546cf..e0599a8 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -84,7 +84,7 @@ 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 Nothing
+ let act = mkSigned sk $ Activity (Seen (Val starttxt')) Nothing mempty
let startmsg = ActivityMessage act
B.hPut stdout starttxt'
hFlush stdout
@@ -143,7 +143,7 @@ instance SendableToDeveloper Seen where
mkSigned (userSessionKey st) $
Activity seen
(loggedHash prev)
- (Just $ mkElapsedTime (lastSeenTs st) now)
+ (mkElapsedTime (lastSeenTs st) now)
let l = mkLog (User msg) now
writeTMChan ochan msg
writeTVar us $ st
@@ -306,7 +306,6 @@ 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 _ _ Nothing _) _ = False
isLegalEntered (Activity a (Just hp) _ _) us
| loggedHash lastact == Just hp = True
| B.null (val (echoData a)) = False -- optimisation
diff --git a/Types.hs b/Types.hs
index 75d22cf..678455c 100644
--- a/Types.hs
+++ b/Types.hs
@@ -60,7 +60,7 @@ instance DataSize a => DataSize (Message a) where
data Activity a = Activity
{ activity :: a
, prevActivity :: Maybe Hash
- , elapsedTime :: Maybe ElapsedTime
+ , elapsedTime :: ElapsedTime
, activitySignature :: Signature
}
deriving (Show, Generic)
@@ -68,7 +68,7 @@ data Activity a = Activity
instance DataSize a => DataSize (Activity a) where
dataSize a = dataSize (activity a)
+ maybe 0 dataSize (prevActivity a)
- + maybe 0 dataSize (elapsedTime a)
+ + dataSize (elapsedTime a)
+ dataSize (activitySignature a)
-- | A control message, which can be sent asynchronously.
@@ -157,6 +157,10 @@ newtype ElapsedTime = ElapsedTime Double
mkElapsedTime :: POSIXTime -> POSIXTime -> ElapsedTime
mkElapsedTime start end = ElapsedTime $ fromRational $ toRational (end - start)
+instance Monoid ElapsedTime where
+ mempty = ElapsedTime 0
+ mappend (ElapsedTime a) (ElapsedTime b) = ElapsedTime (a+b)
+
instance DataSize ElapsedTime where
dataSize _ = 16 -- 128 bit Double