diff options
Diffstat (limited to 'Role/Developer.hs')
| -rw-r--r-- | Role/Developer.hs | 45 |
1 files changed, 33 insertions, 12 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index 604ac6d..d8d9d2c 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -108,8 +108,10 @@ data DeveloperState = DeveloperState , enteredSince :: [Hash] -- ^ Messages we've sent since the last Seen. , lastActivity :: Hash + -- ^ Last Entered or Seen activity , lastActivityTs :: POSIXTime - -- ^ Last message sent or received. + , lastEntered :: Maybe Hash + -- ^ Last Entered activity (either from us or another developer). , fromOtherDevelopersSince :: [Hash] -- ^ Messages received from other developers since the last Seen. -- (The next Seen may chain from one of these.) @@ -126,7 +128,8 @@ data DeveloperState = DeveloperState developerStateRecentActivity :: TVar DeveloperState -> RecentActivity developerStateRecentActivity devstate = do st <- readTVar devstate - let hs = lastSeen st : enteredSince st ++ fromOtherDevelopersSince st + let hs = lastSeen st : fromMaybe (lastSeen st) (lastEntered st) + : enteredSince st ++ fromOtherDevelopersSince st return (userSigVerifier st <> developerSigVerifier st, hs) -- | Read things typed by the developer, and forward them to the TMChan. @@ -154,6 +157,7 @@ sendTtyInput ichan devstate logger = go let act = mkSigned (developerSessionKey ds) $ Activity entered (Just $ lastActivity ds) + (lastEntered ds) (mkElapsedTime (lastActivityTs ds) ts) writeTMChan ichan (ActivityMessage act) let acth = hash act @@ -162,6 +166,7 @@ sendTtyInput ichan devstate logger = go , enteredSince = enteredSince ds ++ [acth] , lastActivity = acth , lastActivityTs = ts + , lastEntered = Just acth } writeTVar devstate ds' return act @@ -203,11 +208,11 @@ sendTtyOutput ochan devstate controlinput logger = go forwardcontrol msg = case msg of User (ControlMessage c) -> fwd c Developer (ControlMessage c) -> case control c of - Rejected _ -> return () - SessionKey _ -> return () - SessionKeyAccepted _ -> return () - SessionKeyRejected _ -> return () - ChatMessage _ _ -> fwd c + EnteredRejected {} -> return () + SessionKey {} -> return () + SessionKeyAccepted {} -> return () + SessionKeyRejected {} -> return () + ChatMessage {} -> fwd c _ -> return () fwd = atomically . writeTMChan controlinput . ControlInputAction . control @@ -308,20 +313,21 @@ getServerMessage ochan devstate ts = do ignore = getServerMessage ochan devstate ts - processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _)) = do + processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _ _)) = do let (legal, ds') = isLegalSeen act ds ts if legal then do writeTVar devstate ds' return (TtyOutput b) else return (ProtocolError ds $ "Illegal Seen value: " ++ show act) - processuser ds (ControlMessage (Control (Rejected _) _)) = do + processuser ds (ControlMessage (Control (er@EnteredRejected {}) _)) = do -- When they rejected a message we sent, -- anything we sent subsequently will -- also be rejected, so forget about it. let ds' = ds { sentSince = mempty , enteredSince = mempty + , lastEntered = enteredLastAccepted er } writeTVar devstate ds' return Beep @@ -345,8 +351,8 @@ getServerMessage ochan devstate ts = do -- -- Does not check the signature. isLegalSeen :: Activity Seen -> DeveloperState -> POSIXTime -> (Bool, DeveloperState) -isLegalSeen (Activity _ Nothing _ _) ds _ = (False, ds) -isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts +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? | hp == lastSeen ds || hp `elem` fromOtherDevelopersSince ds = @@ -364,6 +370,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts , enteredSince = es' , lastActivity = acth , lastActivityTs = ts + , lastEntered = newlastentered , fromOtherDevelopersSince = mempty } -- Does it chain to something we've entered since the last Seen @@ -384,12 +391,25 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts , enteredSince = es' , lastActivity = acth , lastActivityTs = ts + , lastEntered = newlastentered , fromOtherDevelopersSince = mempty } where acth = hash act yes ds' = (True, ds') + -- If there are multiple developers, need to set our lastEntered + -- to the prevEntered from the Activity Seen, so we can follow on to + -- another developer's activity. + -- + -- But, if there's lag, we may have sent some Activity Entered + -- that had not reached the user yet when it constructed the + -- Activity Seen, so check if the prevEntered is one of the + -- things we've enteredSince; if so keep our lastEntered. + newlastentered = case prevEntered act of + Just v | v `notElem` enteredSince ds -> Just v + _ -> lastEntered ds + -- | Start by reading the initial two messages from the user, -- their session key and the startup message. processSessionStart :: MySessionKey -> TMChan (MissingHashes AnyMessage) -> Logger -> TMVar (TVar DeveloperState) -> IO (TVar DeveloperState, Output) @@ -412,7 +432,7 @@ processSessionStart sk ochan logger dsv = do <$> atomically (readTMChan ochan) logger startmsg let (starthash, output) = case startmsg of - User (ActivityMessage act@(Activity (Seen (Val b)) Nothing _ _)) + User (ActivityMessage act@(Activity (Seen (Val b)) Nothing Nothing _ _)) | verifySigned sigverifier act -> (hash act, TtyOutput b) | otherwise -> @@ -424,6 +444,7 @@ processSessionStart sk ochan logger dsv = do , enteredSince = mempty , lastActivity = starthash , lastActivityTs = ts + , lastEntered = Nothing , fromOtherDevelopersSince = mempty , developerSessionKey = sk , userSigVerifier = sigverifier |