1 files changed, 2 insertions, 141 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 11a27660..a102ed5a 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -102,8 +102,9 @@ import qualified System.Random
 import Data.Void (Void)
 import DPut
 import DebugTag
-import Stanza.Type
+import Stanza.Build
 import Stanza.Parse
+import Stanza.Types
 
 -- peerport :: PortNumber
 -- peerport = 5269
@@ -450,36 +451,6 @@ sendReply donevar stype reply replychan = do
         liftIO . atomically $ writeTVar (stanzaClosers replyStanza) Nothing
         -- liftIO $ wlog "finished reply stanza"
 
-stanzaFromList :: StanzaType -> [Event] -> IO Stanza
-stanzaFromList stype reply = do
-    let stanzaTag = listToMaybe reply
-        mid   = stanzaTag >>= lookupAttrib "id" . tagAttrs
-        mfrom = stanzaTag >>= lookupAttrib "from" . tagAttrs
-        mto = stanzaTag >>= lookupAttrib "to" . tagAttrs
-        {-
-        isInternal (InternalEnableHack {}) = True
-        isInternal (InternalCacheId {}) = True
-        isInternal _ = False
-        -}
-    (donevar,replyChan,replyClsrs) <- atomically $ do
-        donevar <- newEmptyTMVar -- TMVar ()
-        replyChan <- newLockedChan
-        replyClsrs <- newTVar (Just [])
-        return (donevar,replyChan, replyClsrs)
-    forkIO $ do
-        forM_ reply $ atomically . writeLChan replyChan
-        atomically $ do putTMVar donevar ()
-                        writeTVar replyClsrs Nothing
-    return Stanza { stanzaType = stype
-                  , stanzaId = mid
-                  , stanzaTo = mto      -- as-is from reply list
-                  , stanzaFrom = mfrom  -- as-is from reply list
-                  , stanzaChan = replyChan
-                  , stanzaClosers = replyClsrs
-                  , stanzaInterrupt = donevar
-                  , stanzaOrigin = LocalPeer
-                  }
-
 
 
 {-
@@ -492,95 +463,6 @@ C->Unrecognized </iq>
 -}
 
 
-mkname :: Text -> Text -> XML.Name
-mkname namespace name = (Name name (Just namespace) Nothing)
-
-makeMessage :: Text -> Text -> Text -> Text -> IO Stanza
-makeMessage namespace from to bod =
-    stanzaFromList typ
-     $ [ EventBeginElement (mkname namespace "message")
-            [ attr "from" from
-            , attr "to" to
-            ]
-       , EventBeginElement (mkname namespace "body") []
-       , EventContent (ContentText bod)
-       , EventEndElement (mkname namespace "body")
-       , EventEndElement (mkname namespace "message") ]
- where
-    typ = Message { msgThread = Nothing
-                  , msgLangMap = [("", lsm)]
-                  }
-    lsm = LangSpecificMessage
-            { msgBody = Just bod
-            , msgSubject = Nothing }
-
-makeInformSubscription :: Text -> Text -> Text -> Bool -> IO Stanza
-makeInformSubscription namespace from to approved =
-    stanzaFromList (PresenceInformSubscription approved)
-      $ [ EventBeginElement (mkname namespace "presence")
-            [ attr "from" from
-            , attr "to" to
-            , attr "type" $ if approved then "subscribed"
-                                        else "unsubscribed" ]
-        , EventEndElement (mkname namespace "presence")]
-
-makePresenceStanza :: Text -> Maybe Text -> JabberShow -> IO Stanza
-makePresenceStanza namespace mjid pstat = do
-    stanzaFromList PresenceStatus { presenceShow = pstat
-                                  , presencePriority = Nothing
-                                  , presenceStatus = []
-                                  , presenceWhiteList = []
-                                  }
-      $ [ EventBeginElement (mkname namespace "presence")
-            (setFrom $ typ pstat) ]
-        ++ (shw pstat >>= jabberShow) ++
-        [ EventEndElement (mkname namespace "presence")]
- where
-    setFrom = maybe id
-                    (\jid -> (attr "from" jid :) )
-                    mjid
-    typ Offline = [attr "type" "unavailable"]
-    typ _       = []
-    shw ExtendedAway = ["xa"]
-    shw Chatty       = ["chat"]
-    shw Away         = ["away"]
-    shw DoNotDisturb = ["dnd"]
-    shw _            = []
-    jabberShow stat =
-      [ EventBeginElement "{jabber:client}show" []
-      , EventContent (ContentText stat)
-      , EventEndElement "{jabber:client}show" ]
-
-makeRosterUpdate :: Text -> Text -> [(Name, Text)] -> IO Stanza
-makeRosterUpdate tojid contact as = do
-    let attrs = map (uncurry attr) as
-    stanzaFromList Unrecognized
-      [ EventBeginElement "{jabber:client}iq"
-            [ attr "to"   tojid
-            , attr "id"   "someid"
-            , attr "type" "set"
-            ]
-      , EventBeginElement "{jabber:iq:roster}query" []
-      , EventBeginElement "{jabber:iq:roster}item" (attr "jid" contact : attrs)
-      , EventEndElement   "{jabber:iq:roster}item"
-      , EventEndElement   "{jabber:iq:roster}query"
-      , EventEndElement "{jabber:client}iq"
-      ]
-
-makePong :: Text -> Maybe Text -> Text -> Text -> [XML.Event]
-makePong namespace mid to from =
-       -- Note: similar to session reply
-       [ EventBeginElement (mkname namespace "iq")
-         $(case mid of
-               Just c -> (("id",[ContentText c]):)
-               _      -> id)
-               [ attr "type" "result"
-               , attr "to"   to
-               , attr "from" from
-               ]
-       , EventEndElement (mkname namespace "iq")
-       ]
-
 xmppInbound :: ConnectionData
                 -> XMPPServerParameters -- ^ XXX: unused
                 -> (Text, IO Text, IO Text, TChan Stanza -> StanzaOrigin)
@@ -1549,24 +1431,3 @@ forkXmpp XMPPServer { _xmpp_sv          = sv
     return mt
 
 
-#if MIN_VERSION_stm(2,4,0)
-#else
--- |Clone a 'TChan': similar to dupTChan, but the cloned channel starts with the
--- same content available as the original channel.
---
--- Terrible inefficient implementation provided to build against older libraries.
-cloneTChan :: TChan a -> STM (TChan a)
-cloneTChan chan = do
-    contents <- chanContents' chan
-    chan2 <- dupTChan chan
-    mapM_ (writeTChan chan) contents
-    return chan2
- where
-    chanContents' chan = do
-        b <- isEmptyTChan chan
-        if b then return [] else do
-        x <- readTChan chan
-        xs <- chanContents' chan
-        return (x:xs)
-#endif
-