xmpp: --debug now enables a sanitized dump of the XMPP protocol

So I can debug these damn google talk presence issues.
This commit is contained in:
Joey Hess 2013-03-16 15:29:51 -04:00
parent 7cfa1d5363
commit e3354cf19c
3 changed files with 28 additions and 13 deletions

View file

@ -14,6 +14,7 @@ import Data.Text (Text)
import Control.Concurrent.STM
import Control.Concurrent.MSampleVar
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import qualified Data.Set as S
import qualified Data.Map as M
@ -60,6 +61,16 @@ readdressNetMessage (PairingNotification stage _ uuid) c = PairingNotification s
readdressNetMessage (Pushing _ stage) c = Pushing c stage
readdressNetMessage m _ = m
{- Convert a NetMessage to something that can be logged. -}
sanitizeNetMessage :: NetMessage -> NetMessage
sanitizeNetMessage (Pushing c stage) = Pushing c $ case stage of
ReceivePackOutput _ -> ReceivePackOutput elided
SendPackOutput _ -> SendPackOutput elided
s -> s
where
elided = B8.pack "<elided>"
sanitizeNetMessage m = m
{- Things that initiate either side of a push, but do not actually send data. -}
isPushInitiation :: PushStage -> Bool
isPushInitiation CanPush = True