improve plugin interface

Plugins will now be handed the xmpp session once it is created so they can tie the knot if necessary

source/Network/Xmpp/Concurrent.hs

@@ -138,12 +138,14 @@ newSession stream config realm mbSasl = runErrorT $ do
     eh <- lift $ newEmptyTMVarIO
     ros <- liftIO . newTVarIO $ Roster Nothing Map.empty
     rew <- lift $ newTVarIO 60
-    let rosterH = if (enableRoster config) then [handleRoster ros $ out writeSem]
+    let out = writeStanza writeSem
+    let rosterH = if (enableRoster config) then [handleRoster ros out ]
                                            else []
+    (sStanza, ps) <- initPlugins out $ plugins config
     let stanzaHandler = runHandlers $ List.concat
-                        [ pluginHandlers writeSem
+                        [ inHandler <$> ps
-                        , [ toChan stanzaChan (out writeSem)
+                        , [ toChan stanzaChan out
-                          , handleIQ iqHands (out writeSem)
+                          , handleIQ iqHands out
                           ]
                         , rosterH
                         ]
@@ -159,26 +161,22 @@ newSession stream config realm mbSasl = runErrorT $ do
                        , stopThreads = kill
                        , conf = config
                        , rosterRef = ros
+                       , sendStanza' = sStanza
                        , sRealm = realm
                        , sSaslCredentials = mbSasl
                        , reconnectWait = rew
                        }
     liftIO . atomically $ putTMVar eh $ EventHandlers { connectionClosedHandler =
                                                  onConnectionClosed config sess }
+    liftIO . forM_ ps $ \p -> onSessionUp p sess
     return sess
   where
-    -- Each inbound plugin may need to send outbound stanzas. Those stanzas have
+    initPlugins out' = go out' []
-    -- to be treated by the plugins "outward" of the handling plugin. We generate
+      where
-    -- the list of outbound plugins with "reverse . tails $ outHandler <$>
+        go out ps' [] = return (out, ps')
-    -- (plugins config))
+        go out ps' (p:ps) = do
-    pluginHandlers ws = List.zipWith ($)
+            p' <- p out
-                            (inHandler <$> List.reverse (plugins config))
+            go (outHandler p') (p' : ps') ps
-                            (List.map (runOut ws) . List.reverse . List.tails
-                                 $ outHandler <$> (plugins config))
-    -- Treat stanza with all plugins
-    out ws = runOut ws $ outHandler <$> (plugins config)
-    -- Compose a list of Stanza transformers
-    runOut ws = List.foldr ($) (writeStanza ws)
 
 connectStream :: HostName
               -> SessionConfiguration

source/Network/Xmpp/Concurrent/Basic.hs

@@ -1,7 +1,6 @@
 {-# OPTIONS_HADDOCK hide #-}
 module Network.Xmpp.Concurrent.Basic where
 
-import           Control.Applicative ((<$>))
 import           Control.Concurrent.STM
 import qualified Control.Exception as Ex
 import           Control.Monad.State.Strict
@@ -28,13 +27,9 @@ writeStanza sem a = do
 sendRawStanza :: Stanza -> Session -> IO Bool
 sendRawStanza a session = writeStanza (writeSemaphore session) a
 
-
+-- | Send a stanza to the server, managed by plugins
--- | Send a stanza to the server, handing it to plugins.
 sendStanza :: Stanza -> Session -> IO Bool
-sendStanza a session = do
+sendStanza = flip sendStanza'
-    let ts = outHandler <$> plugins (conf session)
-    foldr ($) (flip sendRawStanza session) ts $ a
-
 
 -- | Get the channel of incoming stanzas.
 getStanzaChan :: Session -> TChan Stanza

source/Network/Xmpp/Concurrent/Types.hs

@@ -6,6 +6,7 @@ module Network.Xmpp.Concurrent.Types where
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import qualified Control.Exception.Lifted as Ex
+import           Control.Monad.Error
 import qualified Data.ByteString as BS
 import           Data.Default
 import qualified Data.Map as Map
@@ -15,14 +16,20 @@ import           Data.Typeable
 import           Data.XML.Types (Element)
 import           Network
 import           Network.Xmpp.IM.Roster.Types
-import           Network.Xmpp.Types
 import           Network.Xmpp.Sasl.Types
+import           Network.Xmpp.Types
 
 
-data Plugin = Plugin { inHandler :: StanzaHandler
+data Plugin' = Plugin' { inHandler :: Stanza -> IO [Stanza]
-                     , outHandler :: (Stanza -> IO Bool) -> Stanza -> IO Bool
+                       , outHandler :: Stanza -> IO Bool
+                          -- | In order to allow plugins to tie the knot (Plugin
+                          -- / Session) we pass the plugin the completed Session
+                          -- once it exists
+                       , onSessionUp :: Session -> IO ()
                        }
 
+type Plugin = (Stanza -> IO Bool) -> ErrorT XmppFailure IO Plugin'
+
 -- | Configuration for the @Session@ object.
 data SessionConfiguration = SessionConfiguration
     { -- | Configuration for the @Stream@ object.
@@ -80,6 +87,7 @@ data Session = Session
     , stopThreads :: IO ()
     , rosterRef :: TVar Roster
     , conf :: SessionConfiguration
+    , sendStanza' :: Stanza -> IO Bool
     , sRealm :: HostName
     , sSaslCredentials :: Maybe (ConnectionState -> [SaslHandler] , Maybe Text)
     , reconnectWait :: TVar Int