diff options
Diffstat (limited to 'Role/Developer.hs')
-rw-r--r-- | Role/Developer.hs | 37 |
1 files changed, 25 insertions, 12 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index 89ce2cf..8e27b30 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -20,6 +20,7 @@ import qualified Data.Text as T import Data.List import Data.Maybe import Control.Monad +import Data.Time.Clock.POSIX run :: DeveloperOpts -> IO () run = run' developer . debugUrl @@ -49,6 +50,7 @@ data DeveloperState = DeveloperState , enteredSince :: [Hash] -- ^ Messages we've sent since the last Seen. , lastActivity :: Hash + , lastActivityTs :: POSIXTime -- ^ Last message sent or received. , fromOtherDevelopersSince :: [Hash] -- ^ Messages received from other developers since the last Seen. @@ -71,6 +73,7 @@ sendTtyInput ichan devstate logger = go then return () else send b send b = do + ts <- getPOSIXTime act <- atomically $ do ds <- readTVar devstate let ed = if lastActivity ds == lastSeen ds @@ -83,13 +86,16 @@ sendTtyInput ichan devstate logger = go , echoData = Val ed } let act = mkSigned (developerSessionKey ds) $ - Activity entered (Just $ lastActivity ds) + Activity entered + (Just $ lastActivity ds) + (Just $ mkElapsedTime (lastActivityTs ds) ts) writeTMChan ichan (ActivityMessage act) let acth = hash act let ds' = ds { sentSince = sentSince ds ++ [b] , enteredSince = enteredSince ds ++ [acth] , lastActivity = acth + , lastActivityTs = ts } writeTVar devstate ds' return act @@ -101,7 +107,8 @@ sendTtyOutput :: TMChan LogMessage -> TVar DeveloperState -> Logger -> IO () sendTtyOutput ochan devstate logger = go where go = do - v <- atomically $ getServerMessage ochan devstate + ts <- getPOSIXTime + v <- atomically $ getServerMessage ochan devstate ts case v of Nothing -> return () Just (o, l) -> do @@ -123,8 +130,9 @@ authUser ichan ochan devstate logger = do waitresp pk where waitresp pk = do + ts <- getPOSIXTime (o, msg) <- fromMaybe (error "Looks like that debug-me session is over.") - <$> atomically (getServerMessage ochan devstate) + <$> atomically (getServerMessage ochan devstate ts) logger msg emitOutput o case o of @@ -157,9 +165,9 @@ emitOutput NoOutput = -- | Get messages from server, check their signature, and make sure that they -- are properly chained from past messages, before returning. -getServerMessage :: TMChan LogMessage -> TVar DeveloperState -> STM (Maybe (Output, LogMessage)) -getServerMessage ochan devstate = do - let ignore = getServerMessage ochan devstate +getServerMessage :: TMChan LogMessage -> TVar DeveloperState -> POSIXTime -> STM (Maybe (Output, LogMessage)) +getServerMessage ochan devstate ts = do + let ignore = getServerMessage ochan devstate ts mmsg <- readTMChan ochan case mmsg of Nothing -> return Nothing @@ -193,8 +201,8 @@ getServerMessage ochan devstate = do return (Just (NoOutput, Developer msg)) else ignore where - processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _)) = do - let (legal, ds') = isLegalSeen act ds + processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _)) = do + let (legal, ds') = isLegalSeen act ds ts if legal then do writeTVar devstate ds' @@ -227,9 +235,10 @@ getServerMessage ochan devstate = do -- ones, and returns an updated DeveloperState. -- -- Does not check the signature. -isLegalSeen :: Activity Seen -> DeveloperState -> (Bool, DeveloperState) -isLegalSeen (Activity _ Nothing _) ds = (False, ds) -isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds +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? | hp == lastSeen ds || hp `elem` fromOtherDevelopersSince ds = @@ -246,6 +255,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds , sentSince = ss' , enteredSince = es' , lastActivity = acth + , lastActivityTs = ts , fromOtherDevelopersSince = mempty } -- Does it chain to something we've entered since the last Seen @@ -265,6 +275,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds , sentSince = ss' , enteredSince = es' , lastActivity = acth + , lastActivityTs = ts , fromOtherDevelopersSince = mempty } where @@ -289,16 +300,18 @@ processSessionStart ochan logger = 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) _ -> error $ "Unexpected startup message: " ++ show startmsg sk <- genMySessionKey + ts <- getPOSIXTime st <- newTVarIO $ DeveloperState { lastSeen = starthash , sentSince = mempty , enteredSince = mempty , lastActivity = starthash + , lastActivityTs = ts , fromOtherDevelopersSince = mempty , developerSessionKey = sk , userSigVerifier = sigverifier |