3 files changed, 97 insertions, 96 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 515f155d..1bf6efc5 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -47,7 +47,6 @@ import System.Endian
 import Network.BitTorrent.DHT.Token           as Token
 
 import Connection
-import Connection.Tox
 import Crypto.Tox
 import Data.Word64Map                        (fitsInInt)
 import qualified Data.Word64Map              (empty)
@@ -207,7 +206,6 @@ data Tox extra  = Tox
     , toxOnionRoutes    :: OnionRouter
     , toxContactInfo    :: ContactInfo extra
     , toxAnnounceToLan  :: IO ()
-    , toxMgr            :: Manager ToxProgress Key
     }
 
 -- | initiate a netcrypto session, blocking
@@ -438,25 +436,22 @@ newToxOverTransport keydb addr mbSessionsState suppliedDHTKey udp = do
         tbl6 = DHT.routing6 $ mkrouting (error "missing client")
     dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id
                     $ \client net -> onInbound (DHT.updateRouting client (mkrouting client) orouter) net
-    -- TODO: Refactor so this recursive do is unnecessary.
-    rec (mgr,sessionsState) <- do
-        mgr <- toxManager (Parameters { dhtRouting   = mkrouting dhtclient
-                                      , roster       = roster
-                                      , sessions     = sessionsState
-                                      , dhtClient    = dhtclient
-                                      , onToxSession = return () -- TODO
-                                      })
-        let policylookup key = do
-                mp <- connections mgr
-                case Map.lookup key mp of
-                    Nothing -> return OpenToConnect
-                    Just conn -> Connection.connPolicy conn
-
-        return (mgr, sessionsState0 { sendHandshake     = sendMessage handshakes
-                                    , sendSessionPacket = sendMessage cryptonet
-                                    , transportCrypto   = crypto
-                                    , netCryptoPolicyByKey = policylookup
-                                    })
+
+    let sessionsState = sessionsState0 { sendHandshake     = sendMessage handshakes
+                                       , sendSessionPacket = sendMessage cryptonet
+                                       , transportCrypto   = crypto
+                                       -- ToxContact -> STM Policy
+                                       , netCryptoPolicyByKey = policylookup
+                                       }
+        policylookup (ToxContact me them) = do
+            macnt <- HashMap.lookup me <$> readTVar (accounts roster)
+            case macnt of
+                Nothing   -> return RefusingToConnect
+                Just acnt -> do
+                    mc <- HashMap.lookup them <$> readTVar (contacts acnt)
+                    case mc of
+                        Nothing -> return RefusingToConnect
+                        Just c  -> fromMaybe RefusingToConnect <$> readTVar (contactPolicy c)
 
     orouter' <- forkRouteBuilder orouter
         $ \nid ni -> fmap (\(_,ns,_)->ns)
@@ -487,7 +482,6 @@ newToxOverTransport keydb addr mbSessionsState suppliedDHTKey udp = do
         , toxOnionRoutes    = orouter
         , toxContactInfo    = roster
         , toxAnnounceToLan  = return ()
-        , toxMgr            = mgr
         }
 
 onionTimeout :: Tox extra -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int)
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 07c033b6..3269f5dd 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -52,80 +52,9 @@ import Data.InOrOut
 import DPut
 import Text.Printf
 import Data.Bool
-import Connection (Status(..), Policy(..))
 import Network.Tox.Handshake
 
--- | This type indicates the progress of a tox encrypted friend link
--- connection.  Two scenarios are illustrated below.  The parenthesis show the
--- current 'G.Status' 'ToxProgress' of the session.
---
---
--- Perfect handshake scenario:
---
---  Peer 1                                  Peer 2
---  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
---                     Cookie request ->
---                                       <- Cookie response
---  (InProgress AwaitingHandshake)          (Dormant/InProgress AcquiringCookie)
---                   Handshake packet ->
---                                          * accepts connection
---                                          (InProgress AwaitingSessionPacket)
---                                       <- Handshake packet
---  *accepts connection
---  (InProgress AwaitingSessionPacket)
---                   Encrypted packet -> <- Encrypted packet
---  *confirms connection                    *confirms connection
---  (Established)                           (Established)
---
---                           Connection successful.
---
---                  Encrypted packets -> <- Encrypted packets
---
---
---
---
---  More realistic handshake scenario:
---  Peer 1                                  Peer 2
---  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
---                      Cookie request ->   *packet lost*
---                      Cookie request ->
---                                        <- Cookie response
---  (InProgress AwaitingHandshake)           (Dormant/InProgress AcquiringCookie)
---
---                                           *Peer 2 randomly starts new connection to peer 1
---                                           (InProgress AcquiringCookie)
---                                        <- Cookie request
---                     Cookie response ->
---                                           (InProgress AwaitingHandshake)
---
---                    Handshake packet -> <- Handshake packet
---  *accepts connection                      * accepts connection
---  (InProgress AwaitingSessionPacket)      (InProgress AwaitingSessionPacket)
---
---                    Encrypted packet -> <- Encrypted packet
---  *confirms connection                     *confirms connection
---  (Established)                           (Established)
---
---                              Connection successful.
---
---                   Encrypted packets -> <- Encrypted packets
-data ToxProgress
-    = AwaitingDHTKey        -- ^ Waiting to receive their DHT key.
-    | AcquiringIPAddress    -- ^ Searching DHT to obtain their node's IP & port.
-    | AcquiringCookie       -- ^ Attempting to obtain a cookie.
-    | AwaitingHandshake     -- ^ Waiting to receive a handshake.
-    | AwaitingSessionPacket -- ^ Connection is "accepted" but not yet "confirmed".
-    deriving (Eq,Ord,Enum,Show)
-
-type LookupPolicyFunction = Key -> STM Policy
-
-data Key = Key NodeId{-me-} NodeId{-them-}
- deriving (Eq,Ord)
-
-instance Show Key where show = show . showKey_
-
-showKey_ :: Key -> String
-showKey_ (Key me them) = show me ++ ":" ++ show them
+type LookupPolicyFunction = ToxContact -> STM Policy
 
 -- * These types are isomorphic to Maybe, but have the advantage of documenting
 --   when an item is expected to become known.
@@ -1075,7 +1004,7 @@ handshakeH sessions addrRaw hshake@(Handshake (Cookie n24 ecookie) nonce24 encry
                     case Map.lookup addr sessionsmap of
                         Nothing -> do
                             dmsg $ "sockaddr(" ++ show addr ++ ") not in session map(" ++ show (map (second ncSessionId) (Map.assocs sessionsmap)) ++ "), so freshCryptoSession"
-                            let k = Key (key2id . toPublic $ key) (key2id remotePublicKey)
+                            let k = ToxContact (key2id . toPublic $ key) (key2id remotePublicKey)
                             policy <- netCryptoPolicyByKey sessions k
                             case policy of
                                 x | x `elem` [OpenToConnect,TryingToConnect] -> 
diff --git a/src/Network/Tox/NodeId.hs b/src/Network/Tox/NodeId.hs
index 3a732b43..d5da692a 100644
--- a/src/Network/Tox/NodeId.hs
+++ b/src/Network/Tox/NodeId.hs
@@ -33,7 +33,10 @@ module Network.Tox.NodeId
     , parseNoSpamId
     , nospam64
     , nospam16
-    , verifyChecksum) where
+    , verifyChecksum
+    , ToxContact(..)
+    , ToxProgress(..)
+    ) where
 
 import Control.Applicative
 import Control.Arrow
@@ -617,3 +620,78 @@ solveBase64NoSpamID b64digits pub = do
     let nospam' = fromIntegral (n64' `shiftR` 32)
         cksum'  = fromIntegral (n64' `shiftR` 16)
     return $ NoSpamId (NoSpam nospam' (Just cksum')) pub
+
+-- | This type indicates a roster-link relationship between a local toxid and a
+-- remote toxid.  Note that these toxids are represented as the type 'NodeId'
+-- even though they are long-term keys rather than the public keys of Tox DHT
+-- nodes.
+data ToxContact = ToxContact NodeId{-me-} NodeId{-them-}
+ deriving (Eq,Ord)
+
+instance Show ToxContact where show = show . showToxContact_
+
+showToxContact_ :: ToxContact -> String
+showToxContact_ (ToxContact me them) = show me ++ ":" ++ show them
+
+-- | This type indicates the progress of a tox encrypted friend link
+-- connection.  Two scenarios are illustrated below.  The parenthesis show the
+-- current 'G.Status' 'ToxProgress' of the session.
+--
+--
+-- Perfect handshake scenario:
+--
+--  Peer 1                                  Peer 2
+--  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
+--                     Cookie request ->
+--                                       <- Cookie response
+--  (InProgress AwaitingHandshake)          (Dormant/InProgress AcquiringCookie)
+--                   Handshake packet ->
+--                                          * accepts connection
+--                                          (InProgress AwaitingSessionPacket)
+--                                       <- Handshake packet
+--  *accepts connection
+--  (InProgress AwaitingSessionPacket)
+--                   Encrypted packet -> <- Encrypted packet
+--  *confirms connection                    *confirms connection
+--  (Established)                           (Established)
+--
+--                           Connection successful.
+--
+--                  Encrypted packets -> <- Encrypted packets
+--
+--
+--
+--
+--  More realistic handshake scenario:
+--  Peer 1                                  Peer 2
+--  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
+--                      Cookie request ->   *packet lost*
+--                      Cookie request ->
+--                                        <- Cookie response
+--  (InProgress AwaitingHandshake)           (Dormant/InProgress AcquiringCookie)
+--
+--                                           *Peer 2 randomly starts new connection to peer 1
+--                                           (InProgress AcquiringCookie)
+--                                        <- Cookie request
+--                     Cookie response ->
+--                                           (InProgress AwaitingHandshake)
+--
+--                    Handshake packet -> <- Handshake packet
+--  *accepts connection                      * accepts connection
+--  (InProgress AwaitingSessionPacket)      (InProgress AwaitingSessionPacket)
+--
+--                    Encrypted packet -> <- Encrypted packet
+--  *confirms connection                     *confirms connection
+--  (Established)                           (Established)
+--
+--                              Connection successful.
+--
+--                   Encrypted packets -> <- Encrypted packets
+data ToxProgress
+    = AwaitingDHTKey        -- ^ Waiting to receive their DHT key.
+    | AcquiringIPAddress    -- ^ Searching DHT to obtain their node's IP & port.
+    | AcquiringCookie       -- ^ Attempting to obtain a cookie.
+    | AwaitingHandshake     -- ^ Waiting to receive a handshake.
+    | AwaitingSessionPacket -- ^ Connection is "accepted" but not yet "confirmed".
+    deriving (Eq,Ord,Enum,Show)
+