diff options
author | joe <joe@jerkface.net> | 2013-06-16 22:28:06 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-06-16 22:28:06 -0400 |
commit | b5770d982d2cb7d95ae400172a8bb1ca923a0de4 (patch) | |
tree | c2931f2d63d7ecd9e45d2e5457cc0d633fddeeb3 /Presence/XMPPServer.hs | |
parent | 41c757e3e851ba197248df18f144805babc4e1f9 (diff) |
removed some debug noise.
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r-- | Presence/XMPPServer.hs | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs index 05b12b73..5008213c 100644 --- a/Presence/XMPPServer.hs +++ b/Presence/XMPPServer.hs | |||
@@ -24,11 +24,14 @@ import AdaptServer | |||
24 | import Text.XML.HaXml.Lex (xmlLex) | 24 | import Text.XML.HaXml.Lex (xmlLex) |
25 | import Text.XML.HaXml.Parse (xmlParseWith,element,{-doctypedecl,-}processinginstruction,elemOpenTag,elemCloseTag) | 25 | import Text.XML.HaXml.Parse (xmlParseWith,element,{-doctypedecl,-}processinginstruction,elemOpenTag,elemCloseTag) |
26 | import Text.XML.HaXml.Types as Hax (ElemTag,QName(..),Namespace(..),Element(..),Content(..),AttValue(..)) | 26 | import Text.XML.HaXml.Types as Hax (ElemTag,QName(..),Namespace(..),Element(..),Content(..),AttValue(..)) |
27 | import qualified Text.XML.HaXml.Pretty as PP | ||
28 | import Text.PrettyPrint | ||
27 | import Data.Maybe | 29 | import Data.Maybe |
28 | import Debug.Trace | 30 | import Debug.Trace |
29 | import Control.Arrow | 31 | import Control.Arrow |
30 | import LocalPeerCred | 32 | import LocalPeerCred |
31 | import Network.Socket | 33 | import Network.Socket |
34 | import Data.String | ||
32 | 35 | ||
33 | 36 | ||
34 | 37 | ||
@@ -135,7 +138,7 @@ iqresponse host (Elem _ attrs content) = do | |||
135 | guard (hasElem "session" content) | 138 | guard (hasElem "session" content) |
136 | Just (iqresult host id Nothing)) | 139 | Just (iqresult host id Nothing)) |
137 | 140 | ||
138 | "get" -> trace ("iq-get "++show (attrs,content)) $ do | 141 | "get" -> {- trace ("iq-get "++show (attrs,content)) $ -} do |
139 | (tag,as) <- lookup (N "xmlns") (anytagattrs content) | 142 | (tag,as) <- lookup (N "xmlns") (anytagattrs content) |
140 | xmlns <- fmap pack $ listToMaybe . astring $ as | 143 | xmlns <- fmap pack $ listToMaybe . astring $ as |
141 | let servicekind = case tag of { (N s) -> pack s ; _ -> "query" } | 144 | let servicekind = case tag of { (N s) -> pack s ; _ -> "query" } |
@@ -173,8 +176,10 @@ doCon st elem cont = do | |||
173 | host = "localhost" | 176 | host = "localhost" |
174 | hsend r = do | 177 | hsend r = do |
175 | hPutStrLn h r | 178 | hPutStrLn h r |
176 | L.putStrLn $ "SENT:\n" <++> r | 179 | L.putStrLn $ "\nOUT:\n" <++> r |
177 | 180 | ||
181 | putStrLn $ (show $ hang (text "\nIN:") 2 $ pp elem) ++ "\n" | ||
182 | |||
178 | case elem of | 183 | case elem of |
179 | OpenTag _ -> | 184 | OpenTag _ -> |
180 | hsend (greet host) | 185 | hsend (greet host) |
@@ -189,7 +194,6 @@ doCon st elem cont = do | |||
189 | 194 | ||
190 | _ -> return () -- putStrLn $ "unhandled: "++show v | 195 | _ -> return () -- putStrLn $ "unhandled: "++show v |
191 | 196 | ||
192 | putStrLn (show elem) | ||
193 | cont () | 197 | cont () |
194 | 198 | ||
195 | instance Show Hax.ElemTag where | 199 | instance Show Hax.ElemTag where |
@@ -202,6 +206,9 @@ data XmppObject e i t c | |||
202 | | CloseTag c | 206 | | CloseTag c |
203 | deriving Show | 207 | deriving Show |
204 | 208 | ||
209 | pp (Element e) = PP.element e | ||
210 | pp o = fromString (show o) | ||
211 | |||
205 | streamName = QN (Namespace {nsPrefix= "stream" , nsURI="http://etherx.jabber.org/streams" }) "stream" | 212 | streamName = QN (Namespace {nsPrefix= "stream" , nsURI="http://etherx.jabber.org/streams" }) "stream" |
206 | 213 | ||
207 | xmppParse ls = | 214 | xmppParse ls = |