From 952cc2941091518e61345f005b6e218bc34f75ec Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 27 Apr 2017 10:29:33 -0400 Subject: don't need Maybe ElapsedTime Make it a monoid and use mempty = 0 --- Replay.hs | 6 ++++-- Role/Developer.hs | 5 ++--- Role/User.hs | 5 ++--- Types.hs | 8 ++++++-- 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 -- cgit v1.2.3