mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

debug dump P2P messages

Browse source
This commit is contained in:
Joey Hess 2016-12-09 16:45:36 -04:00
parent 9dd510bf29
commit 217c3b0a21
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
1 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
P2P/IO.hs
View file

@ -40,6 +40,7 @@ import Control.Concurrent
import Control.Concurrent.Async
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import System.Log.Logger (debugM)
-- Type of interpreters of the Proto free monad.
type RunProto m = forall a. (MonadIO m, MonadMask m) => Proto a -> m (Either String a)
@ -96,7 +97,9 @@ runNet :: (MonadIO m, MonadMask m) => P2PConnection -> RunProto m -> NetF (Proto
runNet conn runner f = case f of
SendMessage m next -> do
v <- liftIO $ tryNonAsync $ do
hPutStrLn (connOhdl conn) (unwords (formatMessage m))
let l = unwords (formatMessage m)
debugM "p2p" ("P2P > " ++ l)
hPutStrLn (connOhdl conn) l
hFlush (connOhdl conn)
case v of
Left e -> return (Left (show e))
@ -106,12 +109,14 @@ runNet conn runner f = case f of
case v of
Left e -> return (Left (show e))
Right Nothing -> return (Left "protocol error")
Right (Just l) -> case parseMessage l of
Just m -> runner (next m)
Nothing -> runner $ do
let e = ERROR $ "protocol parse error: " ++ show l
net $ sendMessage e
next e
Right (Just l) -> do
liftIO $ debugM "p2p" ("P2P < " ++ l)
case parseMessage l of
Just m -> runner (next m)
Nothing -> runner $ do
let e = ERROR $ "protocol parse error: " ++ show l
net $ sendMessage e
next e
SendBytes len b p next -> do
v <- liftIO $ tryNonAsync $ do
ok <- sendExactly len b (connOhdl conn) p