dump developer state on protocol error

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