diff options
Diffstat (limited to 'Connection/Tox.hs')
-rw-r--r-- | Connection/Tox.hs | 56 |
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 #-} | ||
1 | module Connection.Tox where | 2 | module Connection.Tox where |
2 | 3 | ||
3 | import qualified Connection as G | 4 | import qualified Connection as G |
4 | ;import Connection (Manager (..), Policy (..)) | 5 | ;import Connection (Manager (..), Policy (..)) |
5 | import Control.Concurrent.STM | 6 | import Control.Concurrent.STM |
6 | import Crypto.Tox | 7 | -- import Crypto.Tox |
7 | import Network.Tox | 8 | import Data.Dependent.Sum |
9 | import Data.Functor.Identity | ||
8 | import qualified Data.Map as Map | 10 | import qualified Data.Map as Map |
11 | -- import Data.Maybe | ||
12 | import Network.Tox | ||
9 | import Network.Tox.NodeId | 13 | import Network.Tox.NodeId |
10 | import PingMachine | 14 | -- import PingMachine |
11 | import Text.Read | 15 | import Text.Read |
12 | 16 | ||
13 | 17 | ||
@@ -73,21 +77,31 @@ data ToxProgress | |||
73 | 77 | ||
74 | 78 | ||
75 | data Parameters = Parameters | 79 | data 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 | ||
87 | data Key = Key NodeId{-me-} NodeId{-them-} | ||
88 | |||
89 | data Transient a where | ||
90 | IsDormant :: Transient () | ||
91 | IsAcquiringCookie :: Transient () | ||
92 | IsAwaitingHandshake :: Transient () | ||
93 | IsAwaitingSessionPacket :: Transient () | ||
94 | IsEstablished :: Transient () | ||
95 | |||
96 | data 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. |
88 | setToxPolicy :: Parameters | 102 | setToxPolicy :: 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 () |
93 | setToxPolicy params conmap k policy = case policy of | 107 | setToxPolicy 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 | ||
106 | toxManager :: Parameters -> IO (Manager ToxProgress NodeId{- their public userkey -}) | 120 | showKey_ :: Key -> String |
121 | showKey_ (Key me them) = show me ++ ":" ++ show them | ||
122 | |||
123 | stringToKey_ :: String -> Maybe Key | ||
124 | stringToKey_ 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 | |||
130 | toxManager :: Parameters -> IO (Manager ToxProgress Key) | ||
107 | toxManager params = do | 131 | toxManager 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 | ||