summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Connection/Tox.hs56
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 @@
1{-# LANGUAGE GADTs #-}
1module Connection.Tox where 2module Connection.Tox where
2 3
3import qualified Connection as G 4import qualified Connection as G
4 ;import Connection (Manager (..), Policy (..)) 5 ;import Connection (Manager (..), Policy (..))
5import Control.Concurrent.STM 6import Control.Concurrent.STM
6import Crypto.Tox 7-- import Crypto.Tox
7import Network.Tox 8import Data.Dependent.Sum
9import Data.Functor.Identity
8import qualified Data.Map as Map 10import qualified Data.Map as Map
11-- import Data.Maybe
12import Network.Tox
9import Network.Tox.NodeId 13import Network.Tox.NodeId
10import PingMachine 14-- import PingMachine
11import Text.Read 15import Text.Read
12 16
13 17
@@ -73,21 +77,31 @@ data ToxProgress
73 77
74 78
75data Parameters = Parameters 79data Parameters = Parameters
76 { -- | Various Tox transports and clients. XXX: This includes a lot of 80 { -- | Various Tox transports and clients.
77 -- irrelevant secret keys.
78 toxTransports :: Tox 81 toxTransports :: Tox
79 -- | This node's public user key. The relevant secret key will be obtained
80 -- from 'toxTransports'.
81 , myToxIdentity :: NodeId
82 -- | Thread to be forked when a connection is established. 82 -- | Thread to be forked when a connection is established.
83 -- TODO: this function should accept relevant parameters. 83 -- TODO: this function should accept relevant parameters.
84 , onToxSession :: IO () 84 , onToxSession :: IO ()
85 } 85 }
86 86
87data Key = Key NodeId{-me-} NodeId{-them-}
88
89data Transient a where
90 IsDormant :: Transient ()
91 IsAcquiringCookie :: Transient ()
92 IsAwaitingHandshake :: Transient ()
93 IsAwaitingSessionPacket :: Transient ()
94 IsEstablished :: Transient ()
95
96data SessionState = SessionState
97 { sessionStatus :: G.Connection ToxProgress
98 , transient :: DSum Transient Identity
99 }
100
87-- | This function will fork threads as necessary. 101-- | This function will fork threads as necessary.
88setToxPolicy :: Parameters 102setToxPolicy :: Parameters
89 -> TVar (Map.Map NodeId (G.Connection ToxProgress)) 103 -> TVar (Map.Map Key SessionState)
90 -> NodeId {- their public userkey -} 104 -> Key
91 -> Policy 105 -> Policy
92 -> IO () 106 -> IO ()
93setToxPolicy params conmap k policy = case policy of 107setToxPolicy params conmap k policy = case policy of
@@ -103,14 +117,24 @@ setToxPolicy params conmap k policy = case policy of
103 return () 117 return ()
104 118
105 119
106toxManager :: Parameters -> IO (Manager ToxProgress NodeId{- their public userkey -}) 120showKey_ :: Key -> String
121showKey_ (Key me them) = show me ++ ":" ++ show them
122
123stringToKey_ :: String -> Maybe Key
124stringToKey_ s = let (xs,ys) = break (==':') s
125 in if null ys then Nothing
126 else do me <- readMaybe xs
127 them <- readMaybe (drop 1 ys)
128 return $ Key me them
129
130toxManager :: Parameters -> IO (Manager ToxProgress Key)
107toxManager params = do 131toxManager params = do
108 conmap <- newTVarIO Map.empty 132 conmap <- newTVarIO Map.empty
109 return Manager 133 return Manager
110 { setPolicy = setToxPolicy params conmap -- k -> Policy -> IO () 134 { setPolicy = setToxPolicy params conmap -- k -> Policy -> IO ()
111 , connections = readTVar conmap -- STM (Map k (Connection status)) 135 , connections = fmap sessionStatus <$> readTVar conmap -- STM (Map k (Connection status))
112 , stringToKey = readMaybe -- String -> Maybe k 136 , stringToKey = stringToKey_ -- String -> Maybe k
113 , showProgress = show -- status -> String 137 , showProgress = show -- status -> String
114 , showKey = show -- k -> String 138 , showKey = showKey_ -- k -> String
115 } 139 }
116 140