Removed obsolete partitionAndForkTransport hack.

3 files changed, 14 insertions, 60 deletions

diff --git a/dht/src/Network/QueryResponse.hs b/dht/src/Network/QueryResponse.hs
index 1bfa995f..89723da2 100644
--- a/dht/src/Network/QueryResponse.hs
+++ b/dht/src/Network/QueryResponse.hs
@@ -52,7 +52,7 @@ import Data.TableMethods
 -- | An inbound packet or condition raised while monitoring a connection.
 data Arrival err addr x
     = Terminated       -- ^ Virtual message that signals EOF.
-    | ParseError !err  -- ^ A badly-formed message was recieved.
+    | ParseError !err  -- ^ A badly-formed message was received.
     | Arrival { arrivedFrom :: !addr , arrivedMsg  :: !x } -- ^ Inbound message.
 
 -- | Three methods are required to implement a datagram based query\/response protocol.
@@ -157,36 +157,6 @@ partitionTransport :: ((b,a) -> Either (x,xaddr) (b,a))
 partitionTransport parse encodex tr =
     partitionTransportM (return . parse) (return . encodex) tr
 
-
-partitionAndForkTransport ::
-                      (dst -> msg -> IO ())
-                      -> ((b,a) -> IO (Either (x,xaddr) (b,a)))
-                      -> ((x,xaddr) -> IO (Maybe (Either (msg,dst) (b,a))))
-                      -> Transport err a b
-                      -> IO (Transport err xaddr x, Transport err a b)
-partitionAndForkTransport forkedSend parse encodex tr = do
-    tchan <- atomically newTChan
-    let xtr = tr { awaitMessage = \kont -> fix $ \again -> do
-                    awaitMessage tr $ \case
-                        Arrival a b -> parse (b,a) >>= \case
-                            Left (x,xaddr) -> kont $ Arrival xaddr x
-                            Right (b,a)    -> atomically (writeTChan tchan (Arrival a b)) >> join (atomically again)
-                        ParseError e     -> kont $ ParseError e
-                        Terminated       -> atomically (writeTChan tchan Terminated) >> kont Terminated
-                 , sendMessage = \addr' msg' -> do
-                    msg_addr <- encodex (msg',addr')
-                    case msg_addr of
-                        Just (Right (b,a))    -> sendMessage tr a b
-                        Just (Left (msg,dst)) -> forkedSend dst msg
-                        Nothing               -> return ()
-                 }
-        ytr = Transport
-                { awaitMessage   = \kont -> readTChan tchan >>= pure . kont
-                , sendMessage    = sendMessage tr
-                , setActive      = \_ -> return ()
-                }
-    return (xtr, ytr)
-
 -- |
 --      * f add x --> Nothing, consume x
 --                --> Just id, leave x to a different handler
diff --git a/dht/src/Network/Tox/Onion/Transport.hs b/dht/src/Network/Tox/Onion/Transport.hs
index 913d339d..6319ed2f 100644
--- a/dht/src/Network/Tox/Onion/Transport.hs
+++ b/dht/src/Network/Tox/Onion/Transport.hs
@@ -58,55 +58,39 @@ import Network.Tox.DHT.Transport (SendNodes(..))
 import Network.Tox.NodeId
 import Network.QueryResponse
 
-{-
 encodeOnionAddr :: TransportCrypto
                    -> (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
                    -> (OnionMessage Encrypted,OnionDestination RouteId)
                    -> IO (Maybe (ByteString, SockAddr))
--}
-encodeOnionAddr :: TransportCrypto
-                     -> (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
-                     -> (OnionMessage Encrypted, OnionDestination RouteId)
-                     -> IO (Maybe
-                             (Either (TCP.RelayPacket, TCP.NodeInfo) (ByteString, SockAddr)))
 encodeOnionAddr crypto _ (msg,OnionToOwner ni p) =
-    return $ Just $ Right ( runPut $ putResponse (OnionResponse p msg)
-                          , nodeAddr ni )
+    return $ Just ( runPut $ putResponse (OnionResponse p msg)
+                  , nodeAddr ni )
 encodeOnionAddr crypto getRoute (msg,OnionDestination x ni Nothing) = do
     encodeOnionAddr crypto getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
-    -- dput XMisc $ "ONION encode missing routeid"
-    -- return Nothing
 encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
     let go route = do
-            mreq <- wrapForRoute crypto msg ni route
-            case mreq of
-                Right req -> return $ Right ( runPut $ putRequest req , nodeAddr $ routeNodeA route)
-                Left o | Just port <- routeRelayPort route
-                          -> return $ Left ( o, TCP.NodeInfo (routeNodeA route) port)
+            req <- wrapForRoute crypto msg ni route
+            return ( runPut $ putRequest req , nodeAddr $ routeNodeA route)
     m <- {-# SCC "encodeOnionAddr.getRoute" #-} getRoute ni rid
     x <- {-# SCC "encodeOnionAddr.wrapForRoute" #-} mapM go m
     return x
 
--- wrapForRoute :: TransportCrypto -> OnionMessage Encrypted -> NodeInfo -> OnionRoute -> IO (OnionRequest N0)
 wrapForRoute :: TransportCrypto
                       -> OnionMessage Encrypted
                       -> NodeInfo
                       -> OnionRoute
-                      -> IO (Either TCP.RelayPacket (OnionRequest N0))
-wrapForRoute crypto msg ni r@OnionRoute{routeRelayPort=Nothing} =
+                      -> IO (OnionRequest N0)
+wrapForRoute crypto msg ni r =
     wrapIndirectHops crypto msg ni r $ \nonce saddr msg' -> do
         fwd <- wrapOnion crypto (routeAliasA r)
                                 nonce
                                 (id2key . nodeId $ routeNodeA r)
                                 saddr
                                 msg'
-        return $ Right OnionRequest { onionNonce    = nonce
-                                    , onionForward  = fwd
-                                    , pathFromOwner = NoReturnPath
-                                    }
-wrapForRoute crypto msg ni r@OnionRoute { routeRelayPort = Just _ } =
-    wrapIndirectHops crypto msg ni r $ \nonce saddr fwd ->
-        return $ Left $ TCP.OnionPacket nonce $ Addressed (nodeAddr $ routeNodeB r) fwd
+        return $ OnionRequest { onionNonce    = nonce
+                              , onionForward  = fwd
+                              , pathFromOwner = NoReturnPath
+                              }
 
 wrapIndirectHops :: TransportCrypto
                       -> OnionMessage Encrypted
diff --git a/dht/src/Network/Tox/Transport.hs b/dht/src/Network/Tox/Transport.hs
index 12886245..ff99b747 100644
--- a/dht/src/Network/Tox/Transport.hs
+++ b/dht/src/Network/Tox/Transport.hs
@@ -38,14 +38,14 @@ toxTransport ::
           -> SockAddr -- ^ UDP bind-address
           -> UDPTransport
           -> Transport String ViaRelay B.ByteString
-          -> (TCP.NodeInfo -> RelayPacket -> IO ())   -- ^ TCP server-bound callback.
+          -> (TCP.NodeInfo -> RelayPacket -> IO ())   -- ^ (UNUSED) TCP server-bound callback.
           -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP client-bound callback.
           -> IO ( Transport String Multi.SessionAddress (CryptoPacket Encrypted)
                 , Transport String Multi.NodeInfo (DHTMessage Encrypted8)
                 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
                 , Transport String AnnouncedRendezvous (PublicKey,OnionData)
                 , Transport String Multi.SessionAddress (Handshake Encrypted))
-toxTransport crypto orouter closeLookup addr udp relaynet tcp2server tcp2client = do
+toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do
     (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp
     (dhtUDP,udp1) <- partitionTransportM (parseDHTAddr (pendingCookiesUDP crypto) nodeInfo)
                                       (fmap Just . encodeDHTAddr nodeAddr)
@@ -60,7 +60,7 @@ toxTransport crypto orouter closeLookup addr udp relaynet tcp2server tcp2client
         [ Multi.UDP :=> ByAddress dhtUDP
         , Multi.TCP :=> ByAddress dhtTCP
         ]
-    (onion1,udp2) <- partitionAndForkTransport tcp2server
+    (onion1,udp2) <- partitionTransportM
                              (parseOnionAddr $ lookupSender orouter)
                              (encodeOnionAddr crypto $ lookupRoute orouter)
                              udp1