diff options
Diffstat (limited to 'Role/User.hs')
| -rw-r--r-- | Role/User.hs | 25 |
1 files changed, 11 insertions, 14 deletions
diff --git a/Role/User.hs b/Role/User.hs index 1e842d0..e999b1c 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -37,8 +37,7 @@ run os = fromMaybe (ExitFailure 101) <$> connect putStr "Connecting to debug-me server..." hFlush stdout usv <- newEmptyTMVarIO - let recentactivity = userStateRecentActivity usv - runClientApp $ clientApp (InitMode mempty) recentactivity User developerMessages $ \ochan ichan sid -> do + runClientApp $ clientApp (InitMode mempty) User developerMessages $ \ochan ichan sid -> do let url = sessionIDUrl sid "localhost" 8081 putStrLn "" putStrLn "Others can connect to this session and help you debug by running:" @@ -89,14 +88,11 @@ data UserState = UserState } -- | RecentActivity that uses the UserState. -userStateRecentActivity :: TMVar (TVar UserState) -> RecentActivity -userStateRecentActivity usv = go =<< tryReadTMVar usv - where - go Nothing = noRecentActivity - go (Just us) = do - st <- readTVar us - let hs = mapMaybe loggedHash $ toList $ backLog st - return (sigVerifier st, hs) +userStateRecentActivity :: TVar UserState -> RecentActivity +userStateRecentActivity us = do + st <- readTVar us + let hs = mapMaybe loggedHash $ toList $ backLog st + return (sigVerifier st, hs) -- | Start by establishing our session key, and displaying the starttxt. startProtocol :: B.ByteString -> TMChan (Message Seen) -> Logger -> IO (TVar UserState) @@ -189,7 +185,7 @@ instance SendableToDeveloper ControlAction where -- | Read things to be entered from the TMChan, verify if they're legal, -- and send them to the Pty. Also handles control messages from the -- developer. -sendPtyInput :: TMChan (Message Entered) -> TMChan (Message Seen) -> TMChan ControlInput -> Pty -> TVar UserState -> Logger -> IO () +sendPtyInput :: TMChan (MissingHashes (Message Entered)) -> TMChan (Message Seen) -> TMChan ControlInput -> Pty -> TVar UserState -> Logger -> IO () sendPtyInput ichan ochan controlinput p us logger = go where go = do @@ -220,15 +216,16 @@ data Input -- signature of the message is only verified against the key in it), and -- make sure it's legal before returning it. If it's not legal, sends a -- Reject message. -getDeveloperMessage :: TMChan (Message Entered) -> TMChan (Message Seen) -> TVar UserState -> POSIXTime -> STM (Maybe Input) +getDeveloperMessage :: TMChan (MissingHashes (Message Entered)) -> TMChan (Message Seen) -> TVar UserState -> POSIXTime -> STM (Maybe Input) getDeveloperMessage ichan ochan us now = maybe (return Nothing) (\msg -> Just <$> getDeveloperMessage' msg ochan us now) =<< readTMChan ichan -getDeveloperMessage' :: Message Entered -> TMChan (Message Seen) -> TVar UserState -> POSIXTime -> STM Input -getDeveloperMessage' msg ochan us now = do +getDeveloperMessage' :: MissingHashes (Message Entered) -> TMChan (Message Seen) -> TVar UserState -> POSIXTime -> STM Input +getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do st <- readTVar us + Developer msg <- restoreHashes (userStateRecentActivity us) (MissingHashes (Developer wiremsg)) case msg of ControlMessage (Control (SessionKey spk) _) -> do let sigverifier = mkSigVerifier $ case spk of |