From b94122bfb91a37bb141fdff05573cc02fd93c942 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Wed, 22 Aug 2018 22:57:14 -0400
Subject: More flexible Connection interface.

---
 Connection/Tcp.hs | 23 +++++++++++------------
 1 file changed, 11 insertions(+), 12 deletions(-)

(limited to 'Connection')

diff --git a/Connection/Tcp.hs b/Connection/Tcp.hs
index e6be15b7..c6f3a8ce 100644
--- a/Connection/Tcp.hs
+++ b/Connection/Tcp.hs
@@ -790,9 +790,11 @@ tcpManager grokKey s2k resolvKey sv = do
                                     (saddr,params,ms) -> ConnectWithEndlessRetry saddr params ms
         OpenToConnect     -> dput XMisc "TODO: TCP OpenToConnect"
         RefusingToConnect -> dput XMisc "TODO: TCP RefusingToConnect"
-    , connections = do
-        c <- readTVar $ conmap sv
-        fmap (exportConnection nullping c) <$> readTVar rmap
+    , status = \k -> do
+        c <- readTVar (conmap sv)
+        ck <- Map.lookup k <$> readTVar rmap
+        return $ exportConnection c (join ck)
+    , connections = Map.keys <$> readTVar rmap
     , stringToKey = s2k
     , showProgress = \case
         Resolving     -> "resolving"
@@ -801,19 +803,16 @@ tcpManager grokKey s2k resolvKey sv = do
     , showKey = show
     }
 
-exportConnection :: Ord conkey => PingMachine -> Map conkey (ConnectionRecord u) -> Maybe conkey -> G.Connection TCPStatus
-exportConnection nullping conmap mkey = G.Connection
+exportConnection :: Ord conkey => Map conkey (ConnectionRecord u) -> Maybe conkey -> G.Connection TCPStatus
+exportConnection conmap mkey = G.Connection
     { G.connStatus    = case mkey of
-        Nothing     -> return $ G.Dormant
+        Nothing     -> G.Dormant
         Just conkey -> case Map.lookup conkey conmap of
-            Nothing                                    -> return $ G.InProgress Resolving
-            Just (ConnectionRecord ckont cstate cdata) -> return $ case cstate of
+            Nothing                                    -> G.InProgress Resolving
+            Just (ConnectionRecord ckont cstate cdata) -> case cstate of
                 SaneConnection      {} -> G.Established
                 ConnectionPair      {} -> G.Established
                 ReadOnlyConnection  {} -> G.InProgress AwaitingWrite
                 WriteOnlyConnection {} -> G.InProgress AwaitingRead
-    , G.connPolicy    = return TryingToConnect
-    , G.connPingLogic = case mkey >>= flip Map.lookup conmap of
-            Nothing                            -> nullping
-            Just (ConnectionRecord _ cstate _) -> connPingTimer cstate
+    , G.connPolicy    = TryingToConnect
     }
-- 
cgit v1.2.3