summaryrefslogtreecommitdiff
path: root/dht
diff options
context:
space:
mode:
Diffstat (limited to 'dht')
-rw-r--r--dht/src/Network/Tox/Crypto/Transport.hs8
-rw-r--r--dht/src/Network/Tox/Transport.hs15
2 files changed, 12 insertions, 11 deletions
diff --git a/dht/src/Network/Tox/Crypto/Transport.hs b/dht/src/Network/Tox/Crypto/Transport.hs
index a18b550d..127b2dac 100644
--- a/dht/src/Network/Tox/Crypto/Transport.hs
+++ b/dht/src/Network/Tox/Crypto/Transport.hs
@@ -91,21 +91,21 @@ import GHC.TypeNats
91showCryptoMsg :: Word32 -> CryptoMessage -> [Char] 91showCryptoMsg :: Word32 -> CryptoMessage -> [Char]
92showCryptoMsg _ msg = show msg 92showCryptoMsg _ msg = show msg
93 93
94parseCrypto :: (ByteString, SockAddr) -> Either (CryptoPacket Encrypted, SockAddr) (ByteString, SockAddr) 94parseCrypto :: (ByteString, addr ) -> Either (CryptoPacket Encrypted, addr) (ByteString, addr)
95parseCrypto (bbs,saddr) = case B.uncons bbs of 95parseCrypto (bbs,saddr) = case B.uncons bbs of
96 Just (0x1b,bs) -> case runGet get bs of 96 Just (0x1b,bs) -> case runGet get bs of
97 Right pkt -> Left (pkt, saddr) -- Successful parse, handle this packet. 97 Right pkt -> Left (pkt, saddr) -- Successful parse, handle this packet.
98 Left _ -> Right (bs,saddr) -- Failed parse, strip first byte and pass it on. 98 Left _ -> Right (bs,saddr) -- Failed parse, strip first byte and pass it on.
99 _ -> Right (bbs,saddr) -- Type-code mismatch, pass it on. 99 _ -> Right (bbs,saddr) -- Type-code mismatch, pass it on.
100 100
101encodeCrypto :: (CryptoPacket Encrypted, SockAddr) -> Maybe (ByteString, SockAddr) 101encodeCrypto :: (CryptoPacket Encrypted, addr) -> Maybe (ByteString, addr)
102encodeCrypto (x,saddr) = Just (B.cons 0x1b (runPut $ put x),saddr) 102encodeCrypto (x,saddr) = Just (B.cons 0x1b (runPut $ put x),saddr)
103 103
104parseHandshakes :: ByteString -> SockAddr -> Either String (Handshake Encrypted, SockAddr) 104parseHandshakes :: ByteString -> addr -> Either String (Handshake Encrypted, addr)
105parseHandshakes (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseHandshakes: "++) $ (,saddr) <$> runGet get pkt 105parseHandshakes (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseHandshakes: "++) $ (,saddr) <$> runGet get pkt
106parseHandshakes bs _ = Left $ "parseHandshakes_: " ++ show (B.unpack $ B.take 1 bs) 106parseHandshakes bs _ = Left $ "parseHandshakes_: " ++ show (B.unpack $ B.take 1 bs)
107 107
108encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr) 108encodeHandshakes :: Handshake Encrypted -> addr -> (ByteString, addr)
109encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr) 109encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr)
110 110
111{- 111{-
diff --git a/dht/src/Network/Tox/Transport.hs b/dht/src/Network/Tox/Transport.hs
index 0ca9b758..12886245 100644
--- a/dht/src/Network/Tox/Transport.hs
+++ b/dht/src/Network/Tox/Transport.hs
@@ -65,14 +65,15 @@ toxTransport crypto orouter closeLookup addr udp relaynet tcp2server tcp2client
65 (encodeOnionAddr crypto $ lookupRoute orouter) 65 (encodeOnionAddr crypto $ lookupRoute orouter)
66 udp1 66 udp1
67 (dta,onion) <- partitionTransportM (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1 67 (dta,onion) <- partitionTransportM (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1
68 (netcryptoTCP, relaynet1) <- partitionTransport parseCrypto encodeCrypto relaynet0
69 multi_netcrypto <- mergeTransports $ DMap.fromList
70 [ Multi.SessionUDP :=> ByAddress netcrypto
71 , Multi.SessionTCP :=> ByAddress netcryptoTCP ]
68 let handshakes = layerTransport parseHandshakes encodeHandshakes udp2 72 let handshakes = layerTransport parseHandshakes encodeHandshakes udp2
69 promoteUDP :: TransportA err SockAddr x y -> TransportA err Multi.SessionAddress x y 73 handshakesTCP = layerTransport parseHandshakes encodeHandshakes relaynet1
70 promoteUDP net = layerTransport (\msg saddr -> Right (msg,Multi.SessionUDP ==> saddr)) 74 multi_handshakes <- mergeTransports $ DMap.fromList
71 (\msg (Multi.SessionUDP :=> Identity saddr) -> (msg,saddr)) 75 [ Multi.SessionUDP :=> ByAddress handshakes
72 net 76 , Multi.SessionTCP :=> ByAddress handshakesTCP ]
73 -- TODO: Enable sessions over TCP
74 multi_netcrypto = promoteUDP netcrypto
75 multi_handshakes = promoteUDP handshakes
76 return ( multi_netcrypto 77 return ( multi_netcrypto
77 , forwardDHTRequests crypto (fmap (fmap (Multi.UDP ==>)) . closeLookup) dht 78 , forwardDHTRequests crypto (fmap (fmap (Multi.UDP ==>)) . closeLookup) dht
78 , onion 79 , onion