diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-30 13:09:26 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-30 13:09:26 -0400 |
commit | 89d4e18cdb6ed1c3e7916dd66cf907bedf58a549 (patch) | |
tree | 2d7d5964fa08c311c88448548994ebc96e8f030b /Role | |
parent | ff1ead88d0ed4494dbe668cf18b02f8cea482d69 (diff) | |
download | debug-me-89d4e18cdb6ed1c3e7916dd66cf907bedf58a549.tar.gz |
dump developer state on protocol error
Diffstat (limited to 'Role')
-rw-r--r-- | Role/Developer.hs | 11 | ||||
-rw-r--r-- | Role/Downloader.hs | 2 |
2 files changed, 7 insertions, 6 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index 1deb3a0..56af3b4 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -115,6 +115,7 @@ data DeveloperState = DeveloperState , developerSigVerifier :: SigVerifier -- ^ Used to verify signatures on messages from other developers. } + deriving (Show) -- | RecentActivity that uses the DeveloperState. developerStateRecentActivity :: TMVar (TVar DeveloperState) -> RecentActivity @@ -242,13 +243,13 @@ authUser spk ichan ochan devstate logger = do data Output = TtyOutput B.ByteString | Beep - | ProtocolError String + | ProtocolError DeveloperState String | GotControl ControlAction | NoOutput emitOutput :: Output -> IO () -emitOutput (ProtocolError e) = - error ("Protocol error: " ++ e) +emitOutput (ProtocolError ds e) = + error ("Protocol error: " ++ e ++ "\nState: " ++ show ds) emitOutput (TtyOutput b) = do B.hPut stdout b hFlush stdout @@ -275,7 +276,7 @@ getServerMessage ochan devstate ts = do then do o <- processuser ds msg return (Just (o, User msg)) - else return $ Just (ProtocolError $ "Bad signature on message from user: " ++ show msg, User msg) + else return $ Just (ProtocolError ds $ "Bad signature on message from user: " ++ show msg, User msg) -- When other developers connect, learn their SessionKeys. Just (Developer msg@(ControlMessage (Control (SessionKey spk) _))) -> do let sigverifier = mkSigVerifier $ case spk of @@ -306,7 +307,7 @@ getServerMessage ochan devstate ts = do then do writeTVar devstate ds' return (TtyOutput b) - else return (ProtocolError $ "Illegal Seen value: " ++ show act) + else return (ProtocolError ds $ "Illegal Seen value: " ++ show act) processuser ds (ControlMessage (Control (Rejected _) _)) = do -- When they rejected a message we sent, -- anything we sent subsequently will diff --git a/Role/Downloader.hs b/Role/Downloader.hs index c3d6b73..094e7de 100644 --- a/Role/Downloader.hs +++ b/Role/Downloader.hs @@ -32,5 +32,5 @@ downloader dsv _ichan ochan sid = do Just (o, msg) -> do _ <- logger msg case o of - ProtocolError e -> error ("Protocol error: " ++ e) + ProtocolError {} -> emitOutput o _ -> go logger st |