Use one Tox Connection.Manager for all tox friend-sessions.

1 files changed, 40 insertions, 16 deletions

diff --git a/Connection/Tox.hs b/Connection/Tox.hs
index 29f6b0e4..24ad220f 100644
--- a/Connection/Tox.hs
+++ b/Connection/Tox.hs
@@ -1,13 +1,17 @@
+{-# LANGUAGE GADTs #-}
 module Connection.Tox where
 
 import qualified Connection   as G
          ;import Connection   (Manager (..), Policy (..))
 import Control.Concurrent.STM
-import Crypto.Tox
-import Network.Tox
+-- import Crypto.Tox
+import Data.Dependent.Sum
+import Data.Functor.Identity
 import qualified Data.Map     as Map
+-- import Data.Maybe
+import Network.Tox
 import Network.Tox.NodeId
-import PingMachine
+-- import PingMachine
 import Text.Read
 
 
@@ -73,21 +77,31 @@ data ToxProgress
 
 
 data Parameters = Parameters
-    { -- | Various Tox transports and clients.  XXX: This includes a lot of
-      -- irrelevant secret keys.
+    { -- | Various Tox transports and clients.
       toxTransports :: Tox
-      -- | This node's public user key.  The relevant secret key will be obtained
-      -- from 'toxTransports'.
-    , myToxIdentity :: NodeId
       -- | Thread to be forked when a connection is established.
       -- TODO: this function should accept relevant parameters.
     , onToxSession  :: IO ()
     }
 
+data Key = Key NodeId{-me-} NodeId{-them-}
+
+data Transient a where
+    IsDormant               :: Transient ()
+    IsAcquiringCookie       :: Transient ()
+    IsAwaitingHandshake     :: Transient ()
+    IsAwaitingSessionPacket :: Transient ()
+    IsEstablished           :: Transient ()
+
+data SessionState = SessionState
+    { sessionStatus :: G.Connection ToxProgress
+    , transient     :: DSum Transient Identity
+    }
+
 -- | This function will fork threads as necessary.
 setToxPolicy :: Parameters
-             -> TVar (Map.Map NodeId (G.Connection ToxProgress))
-             -> NodeId {- their public userkey -}
+             -> TVar (Map.Map Key SessionState)
+             -> Key
              -> Policy
              -> IO ()
 setToxPolicy params conmap k policy = case policy of
@@ -103,14 +117,24 @@ setToxPolicy params conmap k policy = case policy of
         return ()
 
 
-toxManager :: Parameters -> IO (Manager ToxProgress NodeId{- their public userkey -})
+showKey_ :: Key -> String
+showKey_ (Key me them) = show me ++ ":" ++ show them
+
+stringToKey_ :: String -> Maybe Key
+stringToKey_ s = let (xs,ys) = break (==':') s
+                 in if null ys then Nothing
+                               else do me <- readMaybe xs
+                                       them <- readMaybe (drop 1 ys)
+                                       return $ Key me them
+
+toxManager :: Parameters -> IO (Manager ToxProgress Key)
 toxManager params = do
     conmap <- newTVarIO Map.empty
     return Manager
-        { setPolicy    = setToxPolicy params conmap -- k -> Policy -> IO ()
-        , connections  = readTVar conmap            -- STM (Map k (Connection status))
-        , stringToKey  = readMaybe                  -- String -> Maybe k
-        , showProgress = show                       -- status -> String
-        , showKey      = show                       -- k -> String
+        { setPolicy    = setToxPolicy params conmap             -- k -> Policy -> IO ()
+        , connections  = fmap sessionStatus <$> readTVar conmap -- STM (Map k (Connection status))
+        , stringToKey  = stringToKey_                           -- String -> Maybe k
+        , showProgress = show                                   -- status -> String
+        , showKey      = showKey_                               -- k -> String
         }