summaryrefslogtreecommitdiff
path: root/Connection
diff options
context:
space:
mode:
Diffstat (limited to 'Connection')
-rw-r--r--Connection/Tcp.hs23
1 files changed, 11 insertions, 12 deletions
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
790 (saddr,params,ms) -> ConnectWithEndlessRetry saddr params ms 790 (saddr,params,ms) -> ConnectWithEndlessRetry saddr params ms
791 OpenToConnect -> dput XMisc "TODO: TCP OpenToConnect" 791 OpenToConnect -> dput XMisc "TODO: TCP OpenToConnect"
792 RefusingToConnect -> dput XMisc "TODO: TCP RefusingToConnect" 792 RefusingToConnect -> dput XMisc "TODO: TCP RefusingToConnect"
793 , connections = do 793 , status = \k -> do
794 c <- readTVar $ conmap sv 794 c <- readTVar (conmap sv)
795 fmap (exportConnection nullping c) <$> readTVar rmap 795 ck <- Map.lookup k <$> readTVar rmap
796 return $ exportConnection c (join ck)
797 , connections = Map.keys <$> readTVar rmap
796 , stringToKey = s2k 798 , stringToKey = s2k
797 , showProgress = \case 799 , showProgress = \case
798 Resolving -> "resolving" 800 Resolving -> "resolving"
@@ -801,19 +803,16 @@ tcpManager grokKey s2k resolvKey sv = do
801 , showKey = show 803 , showKey = show
802 } 804 }
803 805
804exportConnection :: Ord conkey => PingMachine -> Map conkey (ConnectionRecord u) -> Maybe conkey -> G.Connection TCPStatus 806exportConnection :: Ord conkey => Map conkey (ConnectionRecord u) -> Maybe conkey -> G.Connection TCPStatus
805exportConnection nullping conmap mkey = G.Connection 807exportConnection conmap mkey = G.Connection
806 { G.connStatus = case mkey of 808 { G.connStatus = case mkey of
807 Nothing -> return $ G.Dormant 809 Nothing -> G.Dormant
808 Just conkey -> case Map.lookup conkey conmap of 810 Just conkey -> case Map.lookup conkey conmap of
809 Nothing -> return $ G.InProgress Resolving 811 Nothing -> G.InProgress Resolving
810 Just (ConnectionRecord ckont cstate cdata) -> return $ case cstate of 812 Just (ConnectionRecord ckont cstate cdata) -> case cstate of
811 SaneConnection {} -> G.Established 813 SaneConnection {} -> G.Established
812 ConnectionPair {} -> G.Established 814 ConnectionPair {} -> G.Established
813 ReadOnlyConnection {} -> G.InProgress AwaitingWrite 815 ReadOnlyConnection {} -> G.InProgress AwaitingWrite
814 WriteOnlyConnection {} -> G.InProgress AwaitingRead 816 WriteOnlyConnection {} -> G.InProgress AwaitingRead
815 , G.connPolicy = return TryingToConnect 817 , G.connPolicy = TryingToConnect
816 , G.connPingLogic = case mkey >>= flip Map.lookup conmap of
817 Nothing -> nullping
818 Just (ConnectionRecord _ cstate _) -> connPingTimer cstate
819 } 818 }