1 files changed, 44 insertions, 42 deletions

diff --git a/SendMessage.hs b/SendMessage.hs
index ff779e11..6e8ea2b9 100644
--- a/SendMessage.hs
+++ b/SendMessage.hs
@@ -1,11 +1,15 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
-module SendMessage where
+module SendMessage
+    ( sendMessage
+    , CommandCache(..)
+    , newOutgoingConnections
+    , OutgoingConnections
+    ) where
 
 import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
 import Control.Monad.Trans.Maybe
 import Control.Concurrent.STM
 import Control.Concurrent (forkIO)
@@ -22,8 +26,6 @@ import GHC.Conc
 import Data.IORef
 import qualified Data.Map as Map
 import           Data.Map as Map (Map)
-import qualified Data.Set as Set
-import           Data.Set as Set (Set,(\\))
 import Data.XML.Types as XML (Event)
 import System.IO
     ( BufferMode(..)
@@ -34,8 +36,7 @@ import Network.BSD
     ( getProtocolNumber
     )
 import Network.Socket 
-    ( Family
-    , connect
+    ( connect
     , socketToHandle
     , sClose
     , Socket(..)
@@ -43,7 +44,6 @@ import Network.Socket
     , SocketType(..)
     )
 
-import Todo
 import XMPPTypes (Peer(..),discardPort,peerAddr,withPort,socketFamily)
 import SocketLike
 import ServerC (packetSink)
@@ -52,14 +52,7 @@ import Data.Conduit (Sink,Source)
 import qualified Data.ByteString as S (ByteString)
 import XMLToByteStrings
 
-type ByteStringSink = Data.Conduit.Sink S.ByteString IO ()
-
-type OutgoingToPeer sock cache msg =
-         sock
-         -> cache
-         -> TChan msg
-         -> ByteStringSink
-         -> IO (Maybe msg)
+type ByteStringSink = Sink S.ByteString IO ()
 
 -- |Strict version of 'modifyIORef'
 modifyIORef' :: IORef a -> (a -> a) -> IO ()
@@ -69,16 +62,45 @@ modifyIORef' ref f = do
     x' `seq` writeIORef ref x'
 
 
-sendMessage  :: 
-    (cache, msg -> cache -> cache, OutBoundXML RestrictedSocket cache msg) -> TVar (Map Peer (TChan msg, ThreadId)) -> msg -> Peer -> IO ()
-sendMessage (newCache,updateCache,toPeer) cons msg peer0 = do
+class CommandCache cache where
+    type CacheableCommand cache
+
+    emptyCache :: cache
+
+    updateCache :: CacheableCommand cache -> cache -> cache
+
+
+data OutgoingConnections cache = 
+        OutgoingConnections (TVar (Map Peer (TChan (CacheableCommand cache), ThreadId)))
+                            (OutBoundXML RestrictedSocket cache (CacheableCommand cache))                        
+
+
+newOutgoingConnections ::
+  ( RestrictedSocket
+       -> cache
+       -> TChan (CacheableCommand cache)
+       -> (Maybe (CacheableCommand cache) -> IO ())
+       -> Source IO [XML.Event] )
+
+  -> STM (OutgoingConnections cache)
+
+newOutgoingConnections interpretCommands = do
+    remotes <- newTVar (Map.empty)
+    return (OutgoingConnections remotes interpretCommands)
+    
+
+
+sendMessage
+  :: CommandCache a =>
+     OutgoingConnections a -> CacheableCommand a -> Peer -> IO ()
+sendMessage (OutgoingConnections cons interpretCommands) msg peer0 = do
     let peer = discardPort peer0
     found <- atomically $ do
         consmap <- readTVar cons
         return (Map.lookup peer consmap)
     let newEntry = do
           chan <- atomically newTChan
-          t <- forkIO $ connect_to_server chan peer (newCache,updateCache,toPeer)
+          t <- forkIO $ connect_to_server chan peer interpretCommands -- (newCache,updateCache,toPeer)
           -- L.putStrLn $ "remote-map new: " <++> showPeer peer
           return (True,(chan,t))
     (is_new,entry) <- maybe newEntry
@@ -103,11 +125,11 @@ sendMessage (newCache,updateCache,toPeer) cons msg peer0 = do
         readTVar cons >>= writeTVar cons . Map.insert peer entry
 
 
-connect_to_server chan peer (newCache,updateCache,toPeer) = (>> return ()) . runMaybeT $ do
+connect_to_server chan peer toPeer = (>> return ()) . runMaybeT $ do
     let port = 5269 :: Int
     -- We'll cache Presence notifications until the socket
     -- is ready.
-    cached <- liftIO $ newIORef newCache
+    cached <- liftIO $ newIORef emptyCache
 
     let cacheCmd msg cached = modifyIORef' cached (updateCache msg)
 
@@ -128,7 +150,7 @@ connect_to_server chan peer (newCache,updateCache,toPeer) = (>> return ()) . run
                 hSetBuffering h NoBuffering
                 cache <- readIORef $ cached
                 -- hint garbage collector: we're done with this...
-                writeIORef cached newCache
+                writeIORef cached emptyCache 
                 return (cache,packetSink h)
             MaybeT $ handleOutgoingToPeer toPeer (restrictSocket sock) cache chan snk
 
@@ -139,14 +161,6 @@ connect_to_server chan peer (newCache,updateCache,toPeer) = (>> return ()) . run
 connect' :: SockAddr -> Int -> IO (Maybe Socket)
 connect' addr port = do
     proto <- getProtocolNumber "tcp"
-    {-
-    -- Given (host :: HostName) ...
-    let hints = defaultHints { addrFlags = [AI_ADDRCONFIG]
-                             , addrProtocol = proto
-                             , addrSocketType = Stream }
-    addrs <- getAddrInfo (Just hints) (Just host) (Just serv)
-    firstSuccessful $ map tryToConnect addrs
-    -}
     let getport (SockAddrInet port _) = port
         getport (SockAddrInet6 port _ _ _) = port
     let doException e = do
@@ -165,18 +179,6 @@ connect' addr port = do
         )
 
 
-{-
-mmInsert val key mm = Map.alter f key mm
-            where 
-                f Nothing    = Just $ Set.singleton val
-                f (Just set) = Just $ Set.insert val set
--}
-
--- newCache = todo
--- cacheCmd :: msg -> cache -> IO ()
--- cacheCmd _ cached = todo
--- toPeer = todo
-
 type OutBoundXML sock cache msg =
          sock
          -> cache