summaryrefslogtreecommitdiff
path: root/src/Network/Tox/DHT/Handlers.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-10-02 18:27:12 -0400
committerjoe <joe@jerkface.net>2017-10-02 18:27:12 -0400
commitf7a3c6c057244c8ca14bb9c6ad4bdfb4629ac154 (patch)
tree833b7bd39883e56a16a230244fec04f06d8ac755 /src/Network/Tox/DHT/Handlers.hs
parentd408e6c3148106c6dbc8afe24a1488619adf34e1 (diff)
Stubs for maintaining onion routes.
Diffstat (limited to 'src/Network/Tox/DHT/Handlers.hs')
-rw-r--r--src/Network/Tox/DHT/Handlers.hs20
1 files changed, 12 insertions, 8 deletions
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index 4e43c4a7..c9adc860 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -14,6 +14,7 @@ import Network.Address (WantIP (..), ipFamily, testIdBit,fromSockA
14import qualified Network.Kademlia.Routing as R 14import qualified Network.Kademlia.Routing as R
15import Control.TriadCommittee 15import Control.TriadCommittee
16import System.Global6 16import System.Global6
17import OnionRouter
17 18
18import qualified Data.ByteArray as BA 19import qualified Data.ByteArray as BA
19import qualified Data.ByteString.Char8 as C8 20import qualified Data.ByteString.Char8 as C8
@@ -104,6 +105,7 @@ data Routing = Routing
104 , sched6 :: !( TVar (Int.PSQ POSIXTime) ) 105 , sched6 :: !( TVar (Int.PSQ POSIXTime) )
105 , routing6 :: !( TVar (R.BucketList NodeInfo) ) 106 , routing6 :: !( TVar (R.BucketList NodeInfo) )
106 , committee6 :: TriadCommittee NodeId SockAddr 107 , committee6 :: TriadCommittee NodeId SockAddr
108 , orouter :: OnionRouter
107 } 109 }
108 110
109newRouting :: SockAddr -> TransportCrypto 111newRouting :: SockAddr -> TransportCrypto
@@ -123,6 +125,7 @@ newRouting addr crypto update4 update6 = do
123 maybe (tentative_info { nodeIP = tentative_ip6 }) 125 maybe (tentative_info { nodeIP = tentative_ip6 })
124 (\ip6 -> tentative_info { nodeIP = IPv6 ip6 }) 126 (\ip6 -> tentative_info { nodeIP = IPv6 ip6 })
125 <$> global6 127 <$> global6
128 orouter <- newOnionRouter
126 atomically $ do 129 atomically $ do
127 let nobkts = R.defaultBucketCount :: Int 130 let nobkts = R.defaultBucketCount :: Int
128 tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts 131 tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts
@@ -131,7 +134,7 @@ newRouting addr crypto update4 update6 = do
131 committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6 134 committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6
132 sched4 <- newTVar Int.empty 135 sched4 <- newTVar Int.empty
133 sched6 <- newTVar Int.empty 136 sched6 <- newTVar Int.empty
134 return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 137 return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 orouter
135 138
136 139
137-- TODO: This should cover more cases 140-- TODO: This should cover more cases
@@ -241,24 +244,25 @@ updateRouting client routing naddr msg = do
241 hPutStrLn stderr $ "updateRouting "++show (typ,tid) 244 hPutStrLn stderr $ "updateRouting "++show (typ,tid)
242 -- TODO: check msg type 245 -- TODO: check msg type
243 case prefer4or6 naddr Nothing of 246 case prefer4or6 naddr Nothing of
244 Want_IP4 -> updateTable client naddr (routing4 routing) (committee4 routing) (sched4 routing) 247 Want_IP4 -> updateTable client naddr (orouter routing) (routing4 routing) (committee4 routing) (sched4 routing)
245 Want_IP6 -> updateTable client naddr (routing6 routing) (committee6 routing) (sched6 routing) 248 Want_IP6 -> updateTable client naddr (orouter routing) (routing6 routing) (committee6 routing) (sched6 routing)
246 249
247updateTable :: Client -> NodeInfo -> TVar (R.BucketList NodeInfo) -> TriadCommittee NodeId SockAddr -> TVar (Int.PSQ POSIXTime) -> IO () 250updateTable :: Client -> NodeInfo -> OnionRouter -> TVar (R.BucketList NodeInfo) -> TriadCommittee NodeId SockAddr -> TVar (Int.PSQ POSIXTime) -> IO ()
248updateTable client naddr tbl committee sched = do 251updateTable client naddr orouter tbl committee sched = do
249 self <- atomically $ R.thisNode <$> readTVar tbl 252 self <- atomically $ R.thisNode <$> readTVar tbl
250 when (nodeIP self /= nodeIP naddr) $ do 253 when (nodeIP self /= nodeIP naddr) $ do
251 -- TODO: IP address vote? 254 -- TODO: IP address vote?
252 insertNode (toxKademlia client committee tbl sched) naddr 255 insertNode (toxKademlia client committee orouter tbl sched) naddr
253 256
254toxKademlia :: Client -> TriadCommittee NodeId SockAddr -> TVar (R.BucketList NodeInfo) -> TVar (Int.PSQ POSIXTime) -> Kademlia NodeId NodeInfo 257toxKademlia :: Client -> TriadCommittee NodeId SockAddr -> OnionRouter -> TVar (R.BucketList NodeInfo) -> TVar (Int.PSQ POSIXTime) -> Kademlia NodeId NodeInfo
255toxKademlia client committee var sched 258toxKademlia client committee orouter var sched
256 = Kademlia quietInsertions 259 = Kademlia quietInsertions
257 toxSpace 260 toxSpace
258 (vanillaIO var $ ping client) 261 (vanillaIO var $ ping client)
259 { tblTransition = \tr -> do 262 { tblTransition = \tr -> do
260 io1 <- transitionCommittee committee tr 263 io1 <- transitionCommittee committee tr
261 io2 <- touchBucket toxSpace (15*60) var sched tr 264 io2 <- touchBucket toxSpace (15*60) var sched tr
265 hookBucketList orouter tr
262 return $ do 266 return $ do
263 io1 >> io2 267 io1 >> io2
264 {- 268 {-