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,47 +138,45 @@ 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
                         ]
     (kill, wLock, streamState, reader) <- ErrorT $ startThreadsWith writeSem stanzaHandler eh stream
     idGen <- liftIO $ sessionStanzaIDs config
     let sess = Session { stanzaCh = stanzaChan
-                     , iqHandlers = iqHands
+                       , iqHandlers = iqHands
-                     , writeSemaphore = wLock
+                       , writeSemaphore = wLock
-                     , readerThread = reader
+                       , readerThread = reader
-                     , idGenerator = idGen
+                       , idGenerator = idGen
-                     , streamRef = streamState
+                       , streamRef = streamState
-                     , eventHandlers = eh
+                       , eventHandlers = eh
-                     , stopThreads = kill
+                       , stopThreads = kill
-                     , conf = config
+                       , conf = config
-                     , rosterRef = ros
+                       , rosterRef = ros
-                     , sRealm = realm
+                       , sendStanza' = sStanza
-                     , sSaslCredentials = mbSasl
+                       , sRealm = realm
-                     , reconnectWait = rew
+                       , 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,13 +16,19 @@ 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 :: Stanza -> IO [Stanza]
+                       , 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 ()
+                       }
 
-data Plugin = Plugin { inHandler :: StanzaHandler
+type Plugin = (Stanza -> IO Bool) -> ErrorT XmppFailure IO Plugin'
-                     , outHandler :: (Stanza -> IO Bool) -> Stanza -> IO Bool
-                     }
 
 -- | Configuration for the @Session@ object.
 data SessionConfiguration = SessionConfiguration
@@ -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