diff options
Diffstat (limited to 'dht')
-rw-r--r-- | dht/src/Network/Tox/Crypto/Transport.hs | 8 | ||||
-rw-r--r-- | dht/src/Network/Tox/Transport.hs | 15 |
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 | |||
91 | showCryptoMsg :: Word32 -> CryptoMessage -> [Char] | 91 | showCryptoMsg :: Word32 -> CryptoMessage -> [Char] |
92 | showCryptoMsg _ msg = show msg | 92 | showCryptoMsg _ msg = show msg |
93 | 93 | ||
94 | parseCrypto :: (ByteString, SockAddr) -> Either (CryptoPacket Encrypted, SockAddr) (ByteString, SockAddr) | 94 | parseCrypto :: (ByteString, addr ) -> Either (CryptoPacket Encrypted, addr) (ByteString, addr) |
95 | parseCrypto (bbs,saddr) = case B.uncons bbs of | 95 | parseCrypto (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 | ||
101 | encodeCrypto :: (CryptoPacket Encrypted, SockAddr) -> Maybe (ByteString, SockAddr) | 101 | encodeCrypto :: (CryptoPacket Encrypted, addr) -> Maybe (ByteString, addr) |
102 | encodeCrypto (x,saddr) = Just (B.cons 0x1b (runPut $ put x),saddr) | 102 | encodeCrypto (x,saddr) = Just (B.cons 0x1b (runPut $ put x),saddr) |
103 | 103 | ||
104 | parseHandshakes :: ByteString -> SockAddr -> Either String (Handshake Encrypted, SockAddr) | 104 | parseHandshakes :: ByteString -> addr -> Either String (Handshake Encrypted, addr) |
105 | parseHandshakes (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseHandshakes: "++) $ (,saddr) <$> runGet get pkt | 105 | parseHandshakes (B.uncons -> Just (0x1a,pkt)) saddr = left ("parseHandshakes: "++) $ (,saddr) <$> runGet get pkt |
106 | parseHandshakes bs _ = Left $ "parseHandshakes_: " ++ show (B.unpack $ B.take 1 bs) | 106 | parseHandshakes bs _ = Left $ "parseHandshakes_: " ++ show (B.unpack $ B.take 1 bs) |
107 | 107 | ||
108 | encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr) | 108 | encodeHandshakes :: Handshake Encrypted -> addr -> (ByteString, addr) |
109 | encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr) | 109 | encodeHandshakes 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 |