renames (pushN -> pushElement, push -> pushStanza, pushOpen ->

pushOpenElement, pullSink -> pullToSink, xpStreamEntity ->
xpStreamStanza); minor formatting and documentation additions in Monad

src/Network/XMPP/Marshal.hs

@@ -14,8 +14,8 @@ import Data.XML.Types
 import Network.XMPP.Pickle
 import Network.XMPP.Types
 
-xpStreamEntity :: PU [Node] (Either XmppStreamError Stanza)
+xpStreamStanza :: PU [Node] (Either XmppStreamError Stanza)
-xpStreamEntity = xpEither xpStreamError xpStanza
+xpStreamStanza = xpEither xpStreamError xpStanza
 
 xpStanza :: PU [Node] Stanza
 xpStanza = xpAlt stanzaSel

src/Network/XMPP/Monad.hs

@@ -32,36 +32,38 @@ import           Text.XML.Stream.Elements
 import           Text.XML.Stream.Parse as XP
 import           Text.XML.Unresolved(InvalidEventStream(..))
 
-pushN :: Element -> XMPPConMonad Bool
+pushElement :: Element -> XMPPConMonad Bool
-pushN x = do
+pushElement x = do
-  sink <- gets sConPushBS
+    sink <- gets sConPushBS
-  liftIO . sink $ renderElement x
+    liftIO . sink $ renderElement x
-
+
-push :: Stanza -> XMPPConMonad Bool
+pushStanza :: Stanza -> XMPPConMonad Bool
-push = pushN . pickleElem xpStanza
+pushStanza = pushElement . pickleElem xpStanza
-
+
-pushOpen :: Element -> XMPPConMonad Bool
+pushOpenElement :: Element -> XMPPConMonad Bool
-pushOpen e = do
+pushOpenElement e = do
-  sink <- gets sConPushBS
+    sink <- gets sConPushBS
-  liftIO . sink $ renderOpenElement e
+    liftIO . sink $ renderOpenElement e
-
+
-pullSink :: Sink Event IO b -> XMPPConMonad b
+-- `Connect-and-resumes' the given sink to the connection source, and pulls a
-pullSink snk = do
+-- `b' value.
-  source <- gets sConSrc
+pullToSink :: Sink Event IO b -> XMPPConMonad b
-  (_, r) <- lift $ source $$+ snk
+pullToSink snk = do
-  return r
+    source <- gets sConSrc
+    (_, r) <- lift $ source $$+ snk
+    return r
 
 pullElement :: XMPPConMonad Element
 pullElement = do
     Ex.catch (do
-        e <- pullSink (elements =$ CL.head)
+        e <- pullToSink (elements =$ CL.head)
         case e of
             Nothing -> liftIO $ Ex.throwIO StreamConnectionError
             Just r -> return r
         )
         (\(InvalidEventStream s) -> liftIO . Ex.throwIO $ StreamXMLError s)
 
-
+-- Pulls an element and unpickles it.
 pullPickle :: PU [Node] a -> XMPPConMonad a
 pullPickle p = do
     res <- unpickleElem p <$> pullElement
@@ -69,27 +71,30 @@ pullPickle p = do
         Left e -> liftIO . Ex.throwIO $ StreamXMLError e
         Right r -> return r
 
+-- Pulls a stanza from the stream. Throws an error on failure.
 pullStanza  :: XMPPConMonad Stanza
 pullStanza = do
-    res <- pullPickle xpStreamEntity
+    res <- pullPickle xpStreamStanza
     case res of
         Left e -> liftIO . Ex.throwIO $ StreamError e
         Right r -> return r
 
-catchPush p = Ex.catch (p >> return True)
+-- Performs the given IO operation, catches any errors and re-throws everything
-                       (\e -> case GIE.ioe_type e of
+-- except the `ResourceVanished' error.
-                                   GIE.ResourceVanished -> return False
+catchPush :: IO () -> IO Bool
-                                   _ -> Ex.throwIO e
+catchPush p = Ex.catch
-                       )
+    (p >> return True)
-
+    (\e -> case GIE.ioe_type e of
-zeroSource :: Source IO output
+         GIE.ResourceVanished -> return False
-zeroSource = liftIO . Ex.throwIO $ StreamConnectionError
+         _ -> Ex.throwIO e
-
+    )
+
+-- XmppConnection state used when there is no connection.
 xmppNoConnection :: XmppConnection
 xmppNoConnection = XmppConnection
                { sConSrc    = zeroSource
                , sRawSrc    = zeroSource
-               , sConPushBS = \_ -> return False
+               , sConPushBS = \_ -> return False -- Nothing has been sent.
                , sConHandle = Nothing
                , sFeatures  = SF Nothing [] []
                , sConnectionState = XmppConnectionClosed
@@ -98,51 +103,62 @@ xmppNoConnection = XmppConnection
                , sResource  = Nothing
                , sCloseConnection = return ()
                }
+  where
+    zeroSource :: Source IO output
+    zeroSource = liftIO . Ex.throwIO $ StreamConnectionError
 
+-- Connects to the given hostname on port 5222 (TODO: Make this dynamic) and
+-- updates the XMPPConMonad XmppConnection state.
 xmppRawConnect :: HostName -> Text -> XMPPConMonad ()
 xmppRawConnect host hostname = do
-  uname <- gets sUsername
+    uname <- gets sUsername
-  con <- liftIO $ do
+    con <- liftIO $ do
-      con <- connectTo host (PortNumber 5222)
+        con <- connectTo host (PortNumber 5222)
-      hSetBuffering con NoBuffering
+        hSetBuffering con NoBuffering
-      return con
+        return con
-  let raw = sourceHandle con
+    let raw = sourceHandle con
-  src <- liftIO . bufferSource $ raw $= XP.parseBytes def
+    src <- liftIO . bufferSource $ raw $= XP.parseBytes def
-  let st = XmppConnection
+    let st = XmppConnection
-             src
+            src
-             (raw)
+            raw
-             (catchPush . BS.hPut con)
+            (catchPush . BS.hPut con)
-             (Just con)
+            (Just con)
-             (SF Nothing [] [])
+            (SF Nothing [] [])
-             XmppConnectionPlain
+            XmppConnectionPlain
-             (Just hostname)
+            (Just hostname)
-             uname
+            uname
-             Nothing
+            Nothing
-             (hClose con)
+            (hClose con)
-  put st
+    put st
-
+
+-- Execute a XMPPConMonad computation.
 xmppNewSession :: XMPPConMonad a -> IO (a, XmppConnection)
-xmppNewSession action = do
+xmppNewSession action = runStateT action xmppNoConnection
-  runStateT action xmppNoConnection
 
+-- Closes the connection and updates the XMPPConMonad XmppConnection state.
 xmppKillConnection :: XMPPConMonad ()
 xmppKillConnection = do
     cc <- gets sCloseConnection
     void . liftIO $ (Ex.try cc :: IO (Either Ex.SomeException ()))
     put xmppNoConnection
 
-xmppSendIQ' :: StanzaId -> Maybe JID -> IQRequestType
+-- Sends an IQ request and waits for the response. If the response ID does not
-            -> Maybe LangTag -> Element
+-- match the outgoing ID, an error is thrown.
+xmppSendIQ' :: StanzaId
+            -> Maybe JID
+            -> IQRequestType
+            -> Maybe LangTag
+            -> Element
             -> XMPPConMonad (Either IQError IQResult)
 xmppSendIQ' iqID to tp lang body = do
-    push . IQRequestS $ IQRequest iqID Nothing to lang tp body
+    pushStanza . IQRequestS $ IQRequest iqID Nothing to lang tp body
     res <- pullPickle $ xpEither xpIQError xpIQResult
     case res of
         Left e -> return $ Left e
         Right iq' -> do
-            unless (iqID == iqResultID iq') . liftIO . Ex.throwIO $
+            unless
-                StreamXMLError
+                (iqID == iqResultID iq') . liftIO . Ex.throwIO $
-              ("In xmppSendIQ' IDs don't match: " ++ show iqID ++
+                    StreamXMLError
-              " /= " ++ show (iqResultID iq') ++ " .")
+                ("In xmppSendIQ' IDs don't match: " ++ show iqID ++ " /= " ++
+                    show (iqResultID iq') ++ " .")
             return $ Right iq'
-

src/Network/XMPP/Pickle.hs

@@ -73,6 +73,7 @@ unpickleElem' p x = case unpickle (xpNodeElem p) x of
   Left l -> error $ l ++ "\n  saw: " ++ ppElement x
   Right r -> r
 
+-- Given a pickler and an element, produces an object.
 unpickleElem :: PU [Node] a -> Element -> Either String a
 unpickleElem p x = unpickle (xpNodeElem p) x
 

src/Network/XMPP/SASL.hs

@@ -66,7 +66,7 @@ xmppSASL uname passwd = runErrorT $ do
         unless ("DIGEST-MD5" `elem` mechanisms) .
             throwError $ AuthMechanismError mechanisms
         -- Push element and receive the challenge (in XMPPConMonad).
-        _ <- lift . pushN $ saslInitE "DIGEST-MD5" -- TODO: Check boolean?
+        _ <- lift . pushElement $ saslInitE "DIGEST-MD5" -- TODO: Check boolean?
         challenge' <- lift $ B64.decode . Text.encodeUtf8 <$>
             pullPickle challengePickle
         challenge <- case challenge' of
@@ -76,13 +76,13 @@ xmppSASL uname passwd = runErrorT $ do
             Left _ -> throwError AuthChallengeError
             Right p -> return p
         g <- liftIO Random.newStdGen
-        _ <- lift . pushN . -- TODO: Check boolean?
+        _ <- lift . pushElement . -- TODO: Check boolean?
             saslResponseE $ createResponse g realm pairs
         challenge2 <- lift $ pullPickle (xpEither failurePickle challengePickle)
         case challenge2 of
             Left _x -> throwError AuthXmlError
             Right _ -> return ()
-        lift $ pushN saslResponse2E
+        lift $ pushElement saslResponse2E
         e <- lift pullElement
         case e of
             Element "{urn:ietf:params:xml:ns:xmpp-sasl}success" [] [] ->

src/Network/XMPP/Stream.hs

@@ -61,9 +61,9 @@ xmppStartStream = runErrorT $ do
     hostname' <- gets sHostname
     case hostname' of
         Nothing -> throwError StreamConnectionError
-        Just hostname -> lift . pushOpen $
+        Just hostname -> lift . pushOpenElement $
             pickleElem pickleStream ("1.0", Nothing, Just hostname)
-    features <- ErrorT . pullSink $ runErrorT xmppStream
+    features <- ErrorT . pullToSink $ runErrorT xmppStream
     modify (\s -> s {sFeatures = features})
     return ()
 

src/Network/XMPP/TLS.hs

@@ -53,7 +53,7 @@ startTLS params = Ex.handle (return . Left . TLSError) . runErrorT $ do
     handle' <- lift $ gets sConHandle
     handle <- maybe (throwError TLSNoConnection) return handle'
     when (stls features == Nothing) $ throwError TLSNoServerSupport
-    lift $ pushN starttlsE
+    lift $ pushElement starttlsE
     answer <- lift $ pullElement
     case answer of
         Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] [] -> return ()