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

So I can debug these damn google talk presence issues.

1 files changed, 11 insertions, 0 deletions

diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs
index 55bf896bd..05e51045d 100644
--- a/Assistant/Types/NetMessager.hs
+++ b/Assistant/Types/NetMessager.hs
@@ -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