diff options
Diffstat (limited to 'Connection')
-rw-r--r-- | Connection/Tcp.hs | 23 |
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 | ||
804 | exportConnection :: Ord conkey => PingMachine -> Map conkey (ConnectionRecord u) -> Maybe conkey -> G.Connection TCPStatus | 806 | exportConnection :: Ord conkey => Map conkey (ConnectionRecord u) -> Maybe conkey -> G.Connection TCPStatus |
805 | exportConnection nullping conmap mkey = G.Connection | 807 | exportConnection 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 | } |