From 263b547ad43dff0e4948e860ac8d1cfa4f4cf0f1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Apr 2017 12:51:12 -0400 Subject: avoid STM crash on protocol error --- Role/Developer.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Role') diff --git a/Role/Developer.hs b/Role/Developer.hs index 0277bed..d210e50 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -275,7 +275,7 @@ getServerMessage ochan devstate ts = do then do o <- processuser ds msg return (Just (o, User msg)) - else ignore + else return $ Just (ProtocolError $ "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 +306,7 @@ getServerMessage ochan devstate ts = do then do writeTVar devstate ds' return (TtyOutput b) - else return (ProtocolError $ "Illegal Seen value: " ++ show (act, hash act)) + else return (ProtocolError $ "Illegal Seen value: " ++ show act) processuser ds (ControlMessage (Control (Rejected _) _)) = do -- When they rejected a message we sent, -- anything we sent subsequently will -- cgit v1.2.3