avoid exposing auth tokens in debug
This commit is contained in:
parent
e71755abc9
commit
52ccd44812
1 changed files with 13 additions and 5 deletions
18
P2P/IO.hs
18
P2P/IO.hs
|
@ -98,7 +98,7 @@ runNet conn runner f = case f of
|
||||||
SendMessage m next -> do
|
SendMessage m next -> do
|
||||||
v <- liftIO $ tryNonAsync $ do
|
v <- liftIO $ tryNonAsync $ do
|
||||||
let l = unwords (formatMessage m)
|
let l = unwords (formatMessage m)
|
||||||
debugM "p2p" ("P2P > " ++ l)
|
debugMessage "P2P >" m
|
||||||
hPutStrLn (connOhdl conn) l
|
hPutStrLn (connOhdl conn) l
|
||||||
hFlush (connOhdl conn)
|
hFlush (connOhdl conn)
|
||||||
case v of
|
case v of
|
||||||
|
@ -109,10 +109,10 @@ runNet conn runner f = case f of
|
||||||
case v of
|
case v of
|
||||||
Left e -> return (Left (show e))
|
Left e -> return (Left (show e))
|
||||||
Right Nothing -> return (Left "protocol error")
|
Right Nothing -> return (Left "protocol error")
|
||||||
Right (Just l) -> do
|
Right (Just l) -> case parseMessage l of
|
||||||
liftIO $ debugM "p2p" ("P2P < " ++ l)
|
Just m -> do
|
||||||
case parseMessage l of
|
liftIO $ debugMessage "P2P <" m
|
||||||
Just m -> runner (next m)
|
runner (next m)
|
||||||
Nothing -> runner $ do
|
Nothing -> runner $ do
|
||||||
let e = ERROR $ "protocol parse error: " ++ show l
|
let e = ERROR $ "protocol parse error: " ++ show l
|
||||||
net $ sendMessage e
|
net $ sendMessage e
|
||||||
|
@ -150,6 +150,14 @@ runNet conn runner f = case f of
|
||||||
-- all Proto actions.
|
-- all Proto actions.
|
||||||
runnerio = runNetProto conn
|
runnerio = runNetProto conn
|
||||||
|
|
||||||
|
debugMessage :: String -> Message -> IO ()
|
||||||
|
debugMessage prefix m = debugM "p2p" $
|
||||||
|
prefix ++ " " ++ unwords (formatMessage safem)
|
||||||
|
where
|
||||||
|
safem = case m of
|
||||||
|
AUTH u _ -> AUTH u nullAuthToken
|
||||||
|
_ -> m
|
||||||
|
|
||||||
-- Send exactly the specified number of bytes or returns False.
|
-- Send exactly the specified number of bytes or returns False.
|
||||||
--
|
--
|
||||||
-- The ByteString can be larger or smaller than the specified length.
|
-- The ByteString can be larger or smaller than the specified length.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue