diff options
author | joe <joe@jerkface.net> | 2018-06-16 13:42:19 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2018-06-16 13:42:19 -0400 |
commit | ef58d2af90f387960e188365b0dfdd507fcbebc8 (patch) | |
tree | 4f38729ea319e52775b975afc9ac143c41e06fef /src | |
parent | c65f59c83c787e14efb5a58d32807b3bcb300de5 (diff) |
Fill in needed parameters to toxManager.
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/Tox.hs | 37 |
1 files changed, 21 insertions, 16 deletions
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 091c268d..29b980b7 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs | |||
@@ -1,4 +1,3 @@ | |||
1 | {-# LANGUAGE ViewPatterns #-} | ||
2 | {-# LANGUAGE CPP #-} | 1 | {-# LANGUAGE CPP #-} |
3 | {-# LANGUAGE DeriveDataTypeable #-} | 2 | {-# LANGUAGE DeriveDataTypeable #-} |
4 | {-# LANGUAGE DeriveFoldable #-} | 3 | {-# LANGUAGE DeriveFoldable #-} |
@@ -12,8 +11,10 @@ | |||
12 | {-# LANGUAGE NamedFieldPuns #-} | 11 | {-# LANGUAGE NamedFieldPuns #-} |
13 | {-# LANGUAGE PatternSynonyms #-} | 12 | {-# LANGUAGE PatternSynonyms #-} |
14 | {-# LANGUAGE RankNTypes #-} | 13 | {-# LANGUAGE RankNTypes #-} |
14 | {-# LANGUAGE RecursiveDo #-} | ||
15 | {-# LANGUAGE ScopedTypeVariables #-} | 15 | {-# LANGUAGE ScopedTypeVariables #-} |
16 | {-# LANGUAGE TupleSections #-} | 16 | {-# LANGUAGE TupleSections #-} |
17 | {-# LANGUAGE ViewPatterns #-} | ||
17 | module Network.Tox where | 18 | module Network.Tox where |
18 | 19 | ||
19 | import Debug.Trace | 20 | import Debug.Trace |
@@ -446,21 +447,25 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do | |||
446 | tbl6 = DHT.routing6 $ mkrouting (error "missing client") | 447 | tbl6 = DHT.routing6 $ mkrouting (error "missing client") |
447 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id | 448 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id |
448 | $ \client net -> onInbound (DHT.updateRouting client (mkrouting client) orouter) net | 449 | $ \client net -> onInbound (DHT.updateRouting client (mkrouting client) orouter) net |
449 | mgr <- toxManager (Parameters { dhtRouting = mkrouting dhtclient | 450 | -- TODO: Refactor so this recursive do is unnecessary. |
450 | , onToxSession = return () -- TODO | 451 | rec (mgr,sessionsState) <- do |
451 | }) | 452 | mgr <- toxManager (Parameters { dhtRouting = mkrouting dhtclient |
452 | 453 | , roster = roster | |
453 | let policylookup key = do | 454 | , sessions = sessionsState |
454 | mp <- connections mgr | 455 | , dhtClient = dhtclient |
455 | case Map.lookup key mp of | 456 | , onToxSession = return () -- TODO |
456 | Nothing -> return OpenToConnect | 457 | }) |
457 | Just conn -> Connection.connPolicy conn | 458 | let policylookup key = do |
458 | 459 | mp <- connections mgr | |
459 | let sessionsState = sessionsState0 { sendHandshake = sendMessage handshakes | 460 | case Map.lookup key mp of |
460 | , sendSessionPacket = sendMessage cryptonet | 461 | Nothing -> return OpenToConnect |
461 | , transportCrypto = crypto | 462 | Just conn -> Connection.connPolicy conn |
462 | , netCryptoPolicyByKey = policylookup | 463 | |
463 | } | 464 | return (mgr, sessionsState0 { sendHandshake = sendMessage handshakes |
465 | , sendSessionPacket = sendMessage cryptonet | ||
466 | , transportCrypto = crypto | ||
467 | , netCryptoPolicyByKey = policylookup | ||
468 | }) | ||
464 | 469 | ||
465 | orouter' <- forkRouteBuilder orouter | 470 | orouter' <- forkRouteBuilder orouter |
466 | $ \nid ni -> fmap (\(_,ns,_)->ns) | 471 | $ \nid ni -> fmap (\(_,ns,_)->ns) |