1 files changed, 57 insertions, 0 deletions

diff --git a/Connection/Tox.hs b/Connection/Tox.hs
new file mode 100644
index 00000000..58e1cb42
--- /dev/null
+++ b/Connection/Tox.hs
@@ -0,0 +1,57 @@
+module Connection.Tox where
+
+import qualified Connection   as G
+         ;import Connection   (Manager (..), Policy (..))
+import Control.Concurrent.STM
+import Crypto.Tox
+import Network.Tox
+import qualified Data.Map     as Map
+import Network.Tox.NodeId
+import PingMachine
+import Text.Read
+
+
+data ToxProgress = ToxInProgress -- TODO
+    deriving Show
+
+data Parameters = Parameters
+    { -- | Various Tox transports and clients.  XXX: This includes a lot of
+      -- irrelevant secret keys.
+      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 ()
+    }
+
+-- | This function will fork threads as necessary.
+setToxPolicy :: Parameters
+             -> TVar (Map.Map NodeId (G.Connection ToxProgress))
+             -> NodeId {- their public userkey -}
+             -> Policy
+             -> IO ()
+setToxPolicy params conmap k policy = case policy of
+    TryingToConnect -> do
+        -- TODO initiate connecting if we haven't already
+        -- When established, invoke 'onToxSession'.
+        return ()
+    RefusingToConnect -> do
+        -- TODO disconnect or cancel any pending connection
+        return ()
+    OpenToConnect -> do
+        -- TODO passively accept connections if they initiate.
+        return ()
+
+
+toxManager :: Parameters -> IO (Manager ToxProgress NodeId{- their public userkey -})
+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
+        }