Moved resolving duty to Connection manager.

1 files changed, 23 insertions, 10 deletions

diff --git a/Connection/Tcp.hs b/Connection/Tcp.hs
index c6f3a8ce..35083198 100644
--- a/Connection/Tcp.hs
+++ b/Connection/Tcp.hs
@@ -52,6 +52,7 @@ import Control.Monad.Fix
 -- import Control.Monad.STM
 -- import Control.Monad.Trans.Resource
 import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.Maybe
 import System.IO.Error (isDoesNotExistError)
 import System.IO
     ( IOMode(..)
@@ -71,12 +72,15 @@ import Data.Time.Clock (getCurrentTime,diffUTCTime)
 -- import SockAddr ()
 -- import System.Locale (defaultTimeLocale)
 
+import qualified Data.Text as Text
+         ;import Data.Text (Text)
+import DNSCache
 import InterruptibleDelay
 import PingMachine
 import Network.StreamServer
 import Network.SocketLike hiding (sClose)
 import qualified Connection as G
-         ;import Connection (Manager (..), Policy(..))
+         ;import Connection (Manager (..), PeerAddress (..), Policy (..))
 import DPut
 
 
@@ -763,15 +767,22 @@ debugNoise str = return ()
 
 data TCPStatus = Resolving | AwaitingRead | AwaitingWrite
 
-tcpManager :: ( Show k, Ord k, Ord conkey ) =>
-              (conkey -> (SockAddr, ConnectionParameters conkey u, Miliseconds))
-              -> (String -> Maybe k)
-              -> (k -> IO (Maybe conkey))
-              -> Server conkey u releaseKey x
-              -> IO (Manager TCPStatus k)
-tcpManager grokKey s2k resolvKey sv = do
+-- SockAddr -> (SockAddr, ConnectionParameters SockAddr ConnectionData, Miliseconds)
+
+
+tcpManager :: (PeerAddress -> (SockAddr, ConnectionParameters PeerAddress u, Miliseconds))
+              -- -> (String -> Maybe Text)
+              -- -> (Text -> IO (Maybe PeerAddress))
+              -> Server PeerAddress u releaseKey x
+              -> IO (Manager TCPStatus Text)
+tcpManager grokKey sv = do
     rmap <- atomically $ newTVar Map.empty -- Map k (Maybe conkey)
     nullping <- forkPingMachine "tcpManager" 0 0
+    (rslv,rev) <- do
+        dns <- newDNSCache
+        let rslv k = map PeerAddress <$> forwardResolve dns k
+            rev (PeerAddress addr) = reverseResolve dns addr
+        return (rslv,rev)
     return Manager {
       setPolicy = \k -> \case
         TryingToConnect -> join $ atomically $ do
@@ -782,7 +793,7 @@ tcpManager grokKey s2k resolvKey sv = do
                     modifyTVar' rmap $ Map.insert k Nothing
                     return $ void $ forkIO $ do
                     myThreadId >>= flip labelThread ("resolve."++show k)
-                    mconkey <- resolvKey k
+                    mconkey <- listToMaybe <$> rslv k
                     case mconkey of
                         Nothing     -> atomically $ modifyTVar' rmap $ Map.delete k
                         Just conkey -> do
@@ -795,12 +806,14 @@ tcpManager grokKey s2k resolvKey sv = do
         ck <- Map.lookup k <$> readTVar rmap
         return $ exportConnection c (join ck)
     , connections = Map.keys <$> readTVar rmap
-    , stringToKey = s2k
+    , stringToKey = Just . Text.pack
     , showProgress = \case
         Resolving     -> "resolving"
         AwaitingRead  -> "awaiting inbound"
         AwaitingWrite -> "awaiting outbound"
     , showKey = show
+    , resolvePeer    = rslv
+    , reverseAddress = rev
     }
 
 exportConnection :: Ord conkey => Map conkey (ConnectionRecord u) -> Maybe conkey -> G.Connection TCPStatus