diff options
Diffstat (limited to 'Role/User.hs')
| -rw-r--r-- | Role/User.hs | 20 |
1 files changed, 17 insertions, 3 deletions
diff --git a/Role/User.hs b/Role/User.hs index e0599a8..fe679a5 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -11,6 +11,7 @@ import Crypto import CmdLine import WebSockets import SessionID +import PrevActivity import Control.Concurrent.Async import Control.Concurrent.STM @@ -31,17 +32,20 @@ run os = fromMaybe (ExitFailure 101) <$> connect connect = do putStr "Connecting to debug-me server..." hFlush stdout - runClientApp $ clientApp (InitMode mempty) User developerMessages $ \ochan ichan sid -> do + usv <- newEmptyTMVarIO + let recentactivity = userStateRecentActivity usv + runClientApp $ clientApp (InitMode mempty) recentactivity 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:" putStrLn $ " debug-me --debug " ++ url hFlush stdout - withLogger "debug-me.log" $ go ochan ichan - go ochan ichan logger = do + withLogger "debug-me.log" $ go ochan ichan usv + go ochan ichan usv logger = do (cmd, cmdparams) <- shellCommand os runWithPty cmd cmdparams $ \(p, ph) -> do us <- startProtocol startSession ochan logger + atomically $ putTMVar usv us p1 <- async $ sendPtyOutput p ochan us logger p2 <- async $ sendPtyInput ichan ochan p us logger `race` forwardTtyInputToPty p @@ -73,6 +77,16 @@ data UserState = UserState , lastSeenTs :: POSIXTime } +-- | 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) + -- | Start by establishing our session key, and displaying the starttxt. startProtocol :: B.ByteString -> TMChan (Message Seen) -> Logger -> IO (TVar UserState) startProtocol starttxt ochan logger = do |