diff options
Diffstat (limited to 'dht/src/Network/Tox/TCP.hs')
-rw-r--r-- | dht/src/Network/Tox/TCP.hs | 34 |
1 files changed, 18 insertions, 16 deletions
diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs index 1da302b6..626d4714 100644 --- a/dht/src/Network/Tox/TCP.hs +++ b/dht/src/Network/Tox/TCP.hs | |||
@@ -160,22 +160,22 @@ tcpStream crypto mkst = StreamHandshake | |||
160 | , streamAddr = nodeAddr | 160 | , streamAddr = nodeAddr |
161 | } | 161 | } |
162 | 162 | ||
163 | newtype SessionData = SessionData (MVar (IntMap.IntMap NodeId)) | 163 | newtype SessionData = SessionData (TMVar (IntMap.IntMap NodeId)) |
164 | 164 | ||
165 | newSessionData :: NodeInfo -> IO SessionData | 165 | newSessionData :: NodeInfo -> IO SessionData |
166 | newSessionData _ = SessionData <$> newMVar IntMap.empty | 166 | newSessionData _ = atomically $ SessionData <$> newTMVar IntMap.empty |
167 | 167 | ||
168 | getRelayedRemote :: SessionData -> ConId -> IO NodeId | 168 | getRelayedRemote :: SessionData -> ConId -> STM NodeId |
169 | getRelayedRemote (SessionData keymapVar) (ConId i) = do | 169 | getRelayedRemote (SessionData keymapVar) (ConId i) = do |
170 | keymap <- takeMVar keymapVar | 170 | keymap <- takeTMVar keymapVar |
171 | let k = fromMaybe UDP.zeroID $ IntMap.lookup (fromIntegral i) keymap | 171 | let k = fromMaybe UDP.zeroID $ IntMap.lookup (fromIntegral i) keymap |
172 | putMVar keymapVar keymap | 172 | putTMVar keymapVar keymap |
173 | return k | 173 | return k |
174 | 174 | ||
175 | setRelayedRemote :: SessionData -> ConId -> NodeId -> IO () | 175 | setRelayedRemote :: SessionData -> ConId -> NodeId -> STM () |
176 | setRelayedRemote (SessionData keymapVar) (ConId conid) nid = do | 176 | setRelayedRemote (SessionData keymapVar) (ConId conid) nid = do |
177 | keymap <- takeMVar keymapVar | 177 | keymap <- takeTMVar keymapVar |
178 | putMVar keymapVar $ IntMap.insert (fromIntegral conid) nid keymap | 178 | putTMVar keymapVar $ IntMap.insert (fromIntegral conid) nid keymap |
179 | 179 | ||
180 | toxTCP :: TransportCrypto -> IO ( TCPCache (SessionProtocol (SessionData,RelayPacket) RelayPacket) | 180 | toxTCP :: TransportCrypto -> IO ( TCPCache (SessionProtocol (SessionData,RelayPacket) RelayPacket) |
181 | , TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket) ) | 181 | , TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket) ) |
@@ -367,7 +367,7 @@ type RelayCache = TCPCache (SessionProtocol (SessionData,RelayPacket) RelayPacke | |||
367 | newClient :: TransportCrypto | 367 | newClient :: TransportCrypto |
368 | -> ((Nonce8 -> QR.Result (Bool,RelayPacket) -> IO ()) -> a) -- ^ store mvar for relay query | 368 | -> ((Nonce8 -> QR.Result (Bool,RelayPacket) -> IO ()) -> a) -- ^ store mvar for relay query |
369 | -> (a -> Nonce8 -> RelayPacket -> IO void) -- ^ load mvar for relay query | 369 | -> (a -> Nonce8 -> RelayPacket -> IO void) -- ^ load mvar for relay query |
370 | -> (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId))) -- ^ lookup sender of onion query | 370 | -> (SockAddr -> Nonce8 -> STM (Maybe (OnionDestination RouteId))) -- ^ lookup sender of onion query |
371 | -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute)) -- ^ lookup OnionRoute by id | 371 | -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute)) -- ^ lookup OnionRoute by id |
372 | -> IO ( ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a) | 372 | -> IO ( ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a) |
373 | , RelayCache | 373 | , RelayCache |
@@ -375,8 +375,9 @@ newClient :: TransportCrypto | |||
375 | , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) ) | 375 | , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) ) |
376 | , RelayClient ) | 376 | , RelayClient ) |
377 | newClient crypto store load lookupSender getRoute = do | 377 | newClient crypto store load lookupSender getRoute = do |
378 | let runio io = return () -- TODO: run IO action | ||
378 | (tcpcache,net0) <- toxTCP crypto | 379 | (tcpcache,net0) <- toxTCP crypto |
379 | (relaynet,net1) <- partitionRelay net0 | 380 | (relaynet,net1) <- partitionRelay runio net0 |
380 | (onionnet,net2) <- partitionOnion crypto lookupSender getRoute net1 | 381 | (onionnet,net2) <- partitionOnion crypto lookupSender getRoute net1 |
381 | let net3 = {- XXX: Client type forces this pointless layering. -} | 382 | let net3 = {- XXX: Client type forces this pointless layering. -} |
382 | layerTransport ((Right .) . (,) . (,) False . snd) (,) net2 | 383 | layerTransport ((Right .) . (,) . (,) False . snd) (,) net2 |
@@ -428,12 +429,13 @@ showViaRelay (ViaRelay mcon nid tcp) = | |||
428 | "TCP:" ++ maybe "(oob)" (\(ConId con) -> "(" ++ show con ++ ")") mcon | 429 | "TCP:" ++ maybe "(oob)" (\(ConId con) -> "(" ++ show con ++ ")") mcon |
429 | ++ show nid ++ "@@" ++ show (nodeAddr tcp) | 430 | ++ show nid ++ "@@" ++ show (nodeAddr tcp) |
430 | 431 | ||
431 | partitionRelay :: TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket) | 432 | partitionRelay :: (IO () -> STM ()) |
433 | -> TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket) | ||
432 | -> IO ( Transport err ViaRelay ByteString | 434 | -> IO ( Transport err ViaRelay ByteString |
433 | , TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket)) | 435 | , TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket)) |
434 | partitionRelay tr = partitionTransportM parse encode tr | 436 | partitionRelay runio tr = partitionTransportM parse encode tr |
435 | where | 437 | where |
436 | parse :: ((SessionData,RelayPacket), NodeInfo) -> IO (Either (ByteString, ViaRelay) ((SessionData,RelayPacket),NodeInfo)) | 438 | parse :: ((SessionData,RelayPacket), NodeInfo) -> STM (Either (ByteString, ViaRelay) ((SessionData,RelayPacket),NodeInfo)) |
437 | parse ((st,RelayData bs conid), ni) = do | 439 | parse ((st,RelayData bs conid), ni) = do |
438 | nid <- getRelayedRemote st conid | 440 | nid <- getRelayedRemote st conid |
439 | return $ Left (bs, ViaRelay (Just conid) nid ni) | 441 | return $ Left (bs, ViaRelay (Just conid) nid ni) |
@@ -463,7 +465,7 @@ partitionRelay tr = partitionTransportM parse encode tr | |||
463 | 465 | ||
464 | 466 | ||
465 | partitionOnion :: TransportCrypto | 467 | partitionOnion :: TransportCrypto |
466 | -> (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId))) | 468 | -> (SockAddr -> Nonce8 -> STM (Maybe (OnionDestination RouteId))) |
467 | -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute)) | 469 | -> (UDP.NodeInfo -> RouteId -> IO (Maybe OnionRoute)) |
468 | -> TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket) | 470 | -> TransportA err NodeInfo (SessionData,RelayPacket) (Bool,RelayPacket) |
469 | -> IO ( Transport err (OnionDestination RouteId) (OnionMessage Encrypted) | 471 | -> IO ( Transport err (OnionDestination RouteId) (OnionMessage Encrypted) |
@@ -471,8 +473,8 @@ partitionOnion :: TransportCrypto | |||
471 | partitionOnion crypto lookupSender getRoute tr = partitionTransportM parse encode tr | 473 | partitionOnion crypto lookupSender getRoute tr = partitionTransportM parse encode tr |
472 | where | 474 | where |
473 | parse :: ((SessionData,RelayPacket), NodeInfo) | 475 | parse :: ((SessionData,RelayPacket), NodeInfo) |
474 | -> IO (Either (OnionMessage Encrypted , OnionDestination RouteId) | 476 | -> STM (Either (OnionMessage Encrypted , OnionDestination RouteId) |
475 | ((SessionData,RelayPacket), NodeInfo)) | 477 | ((SessionData,RelayPacket), NodeInfo)) |
476 | parse pass@((_,OnionPacketResponse msg@(OnionAnnounceResponse n8 _ _)), nodeA) = do | 478 | parse pass@((_,OnionPacketResponse msg@(OnionAnnounceResponse n8 _ _)), nodeA) = do |
477 | m <- lookupSender (nodeAddr nodeA) n8 | 479 | m <- lookupSender (nodeAddr nodeA) n8 |
478 | case m of | 480 | case m of |