1 files changed, 59 insertions, 2 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 6e0f5c5f..7eb0fbc5 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -192,8 +192,10 @@ peerKeyToResolvedName k@(PeerKey { callBackAddress=addr }) = do
     return $ maybe (peerKeyToText k) Text.pack mname 
 
 
+wlog :: String -> IO ()
 wlog s = putStrLn s
- where _ = s :: String
+
+wlogb :: ByteString -> IO ()
 wlogb s = Strict8.putStrLn s
 
 xmlStream :: ReadCommand -> WriteCommand -> ( Source IO XML.Event
@@ -226,10 +228,14 @@ type FlagCommand = STM Bool
 type ReadCommand = IO (Maybe ByteString)
 type WriteCommand = ByteString -> IO Bool
 
+cloneStanza :: StanzaWrap (TChan a) -> STM (StanzaWrap (TChan a))
 cloneStanza stanza = do
     dupped <- cloneTChan (stanzaChan stanza)
     return stanza { stanzaChan = dupped }
 
+copyToChannel
+  :: MonadIO m =>
+     (Event -> a) -> TChan a -> TVar (Maybe [Event]) -> ConduitM Event Event m ()
 copyToChannel f chan closer_stack = awaitForever copy
  where
     copy x = do 
@@ -251,6 +257,7 @@ prettyPrint prefix =
         =$= CB.lines 
         =$ CL.mapM_ (wlogb . (prefix <>))
 
+swapNamespace :: Monad m => Text -> Text -> ConduitM Event Event m ()
 swapNamespace old new = awaitForever swapit
  where
     swapit (EventBeginElement n as) | nameNamespace n==Just old =
@@ -259,6 +266,7 @@ swapNamespace old new = awaitForever swapit
         yield $ EventEndElement (n { nameNamespace = Just new })
     swapit x = yield x
 
+fixHeaders :: Monad m => Stanza -> ConduitM Event Event m ()
 fixHeaders Stanza { stanzaTo=mto, stanzaFrom=mfrom } = do
     x <- await
     maybe (return ()) f x
@@ -272,6 +280,7 @@ fixHeaders Stanza { stanzaTo=mto, stanzaFrom=mfrom } = do
         as'' = maybe as' (\from->attr "from" from:as') mfrom
     
 
+sendModifiedStanzaToPeer :: Stanza -> TChan Stanza -> IO ()
 sendModifiedStanzaToPeer stanza chan = do
     (echan,clsrs,quitvar) <- conduitToChan c
     ioWriteChan chan
@@ -283,6 +292,7 @@ sendModifiedStanzaToPeer stanza chan = do
  where
     c = stanzaToConduit stanza =$= swapNamespace "jabber:client" "jabber:server" =$= fixHeaders stanza
 
+sendModifiedStanzaToClient :: Stanza -> TChan Stanza -> IO ()
 sendModifiedStanzaToClient stanza chan = do
     (echan,clsrs,quitvar) <- conduitToChan c
     ioWriteChan chan
@@ -295,6 +305,8 @@ sendModifiedStanzaToClient stanza chan = do
     c = stanzaToConduit stanza =$= swapNamespace "jabber:server" "jabber:client" =$= fixHeaders stanza
 
 -- id,to, and from are taken as-is from reply list
+-- todo: this should probably be restricted to IO monad
+sendReply :: (Functor m, MonadIO m) => TMVar () -> StanzaType -> [Event] -> TChan Stanza -> m ()
 sendReply donevar stype reply replychan = do
     if null reply then return ()
     else do
@@ -363,8 +375,13 @@ C->Unrecognized     <bind xmlns="urn:ietf:params:xml:ns:xmpp-bind"/>
 C->Unrecognized </iq>
 -}
 
+ioWriteChan :: MonadIO m => TChan a -> a -> m ()
 ioWriteChan c v = liftIO . atomically $ writeTChan c v
 
+parsePresenceStatus
+  :: ( MonadThrow m
+     , MonadIO m
+     ) => Text -> NestingXML o m (Maybe StanzaType)
 parsePresenceStatus ns = do
 
     let toStat "away" = Away
@@ -399,6 +416,10 @@ parsePresenceStatus ns = do
                                    , presencePriority = prio
                                    , presenceStatus = status
                                    }
+grokPresence
+  :: ( MonadThrow m
+     , MonadIO m
+     ) => Text -> XML.Event -> NestingXML o m (Maybe StanzaType)
 grokPresence ns stanzaTag = do
     let typ = lookupAttrib "type" (tagAttrs stanzaTag)
     case typ of
@@ -413,6 +434,10 @@ grokPresence ns stanzaTag = do
         Just "subscribe"   -> return . Just $ PresenceRequestSubscription True
         _ -> return Nothing
 
+parseMessage
+  :: ( MonadThrow m
+     , MonadIO m
+     ) => Text -> XML.Event -> NestingXML o m StanzaType
 parseMessage ns stanza = do
     let bodytag = Name { nameNamespace = Just ns
                        , nameLocalName = "body"
@@ -462,11 +487,19 @@ parseMessage ns stanza = do
         msgThread = if msgThreadContent th/="" then Just th else Nothing
     }
 
+grokMessage
+  :: ( MonadThrow m
+     , MonadIO m
+     ) => Text -> XML.Event -> NestingXML o m (Maybe StanzaType)
 grokMessage ns stanzaTag = do
     t <- parseMessage ns stanzaTag
     return $ Just t
 
-grokStanza "jabber:server" stanzaTag = 
+
+
+grokStanza
+  ::  Text -> XML.Event -> NestingXML o IO (Maybe StanzaType)
+ggrokStanza "jabber:server" stanzaTag = 
             case () of
                 _ | stanzaTag `isServerIQOf` "get" -> grokStanzaIQGet stanzaTag
                 _ | stanzaTag `isServerIQOf` "result" -> grokStanzaIQResult stanzaTag
@@ -606,6 +639,7 @@ readUntilNothing ch = do
                 return (x:xs))
               x
 
+streamFeatures :: Text -> [XML.Event]
 streamFeatures "jabber:client" =
     [ EventBeginElement (streamP "features") []
     , EventBeginElement "{urn:ietf:params:xml:ns:xmpp-bind}bind" []
@@ -625,6 +659,7 @@ streamFeatures "jabber:server" =
     []
 
 
+greet' :: Text -> Text -> [XML.Event]
 greet' namespace host =
     [ EventBeginDocument
     , EventBeginElement (streamP "stream")
@@ -636,6 +671,7 @@ greet' namespace host =
         ]
     ] ++ streamFeatures namespace
 
+consid :: Maybe Text -> [(Name, [Content])] -> [(Name, [Content])]
 consid Nothing = id
 consid (Just sid) = (("id",[ContentText sid]):)
 
@@ -644,6 +680,7 @@ data XMPPState
     = PingSlot
  deriving (Eq,Ord)
 
+mkname :: Text -> Text -> XML.Name
 mkname namespace name = (Name name (Just namespace) Nothing)
 
 makePing :: Text -> Maybe Text -> Text -> Text -> [XML.Event]
@@ -660,6 +697,7 @@ makePing namespace mid to from =
        , EventEndElement "{urn:xmpp:ping}ping"
        , EventEndElement $ mkname namespace "iq"]
 
+makePong :: Text -> Maybe Text -> Text -> Text -> [XML.Event]
 makePong namespace mid to from =
        -- Note: similar to session reply
        [ EventBeginElement (mkname namespace "iq")
@@ -685,6 +723,7 @@ iq_bind_reply mid jid =
     , EventEndElement "{jabber:client}iq"
     ]
 
+iq_session_reply :: Maybe Text -> Text -> [XML.Event]
 iq_session_reply mid host =
     -- Note: similar to Pong
     [ EventBeginElement "{jabber:client}iq" 
@@ -694,6 +733,7 @@ iq_session_reply mid host =
     , EventEndElement "{jabber:client}iq"
     ]
 
+iq_service_unavailable :: Maybe Text -> Text -> XML.Name -> [XML.Event]
 iq_service_unavailable mid host {- mjid -} req =
     [ EventBeginElement "{jabber:client}iq" 
         (consid mid [("type",[ContentText "error"])
@@ -731,6 +771,7 @@ wrapStanzaList xs = do
     mfrom = m >>= lookupAttrib "from" . tagAttrs
     mid = m >>= lookupAttrib "id" . tagAttrs
 
+wrapStanzaConduit :: Monad m => StanzaWrap a -> ConduitM Event (Either (StanzaWrap Event) Event) m ()
 wrapStanzaConduit stanza = do
     mfirst <- await
     flip (maybe $ return ()) mfirst $ \first -> do
@@ -749,6 +790,7 @@ greet namespace =
     ]
 -}
 
+goodbye :: [XML.Event]
 goodbye = 
     [ EventEndElement (streamP "stream")
     , EventEndDocument
@@ -888,6 +930,7 @@ data PeerState
     | PeerConnected (TChan Stanza)
 -}
 
+peerKey :: (Socket,SockAddr) -> IO (ConnectionKey,SockAddr)
 peerKey (sock,addr) = do
     peer <- 
       sIsConnected sock >>= \c -> 
@@ -896,6 +939,7 @@ peerKey (sock,addr) = do
     laddr <- getSocketName sock
     return $ (PeerKey (peer `withPort` fromIntegral peerport),laddr)
 
+clientKey :: (Socket,SockAddr) -> IO (ConnectionKey,SockAddr)
 clientKey (sock,addr) = do
     paddr <- getPeerName sock
     return $ (ClientKey addr,paddr)
@@ -934,6 +978,9 @@ xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set)
                              else [] )
                 yield $ EventEndElement "{jabber:iq:roster}item"
 
+conduitToChan
+  :: Conduit () IO Event
+     -> IO (TChan Event, TVar (Maybe [Event]), TMVar a)
 conduitToChan c = do
     chan <- atomically newTChan
     clsrs <- atomically $ newTVar (Just [])
@@ -943,6 +990,11 @@ conduitToChan c = do
         atomically $ writeTVar clsrs Nothing
     return (chan,clsrs,quitvar)
 
+sendRoster ::
+    StanzaWrap a
+    -> XMPPServerParameters
+    -> TChan (StanzaWrap (TChan Event))
+    -> IO ()
 sendRoster query xmpp replyto = do
     let k = case stanzaOrigin query of
              NetworkOrigin k _ -> Just k
@@ -999,6 +1051,11 @@ socketFromKey sv k = do
                         -- Shouldnt happen anyway.
         Just cd -> return $ cdata cd
 
+monitor ::
+    Server ConnectionKey SockAddr
+    -> ConnectionParameters ConnectionKey SockAddr
+    -> XMPPServerParameters
+    -> IO b
 monitor sv params xmpp = do
     chan <- return $ serverEvent sv
     stanzas <- atomically newTChan