diff options
Diffstat (limited to 'dht/src/Data/Tox/Onion.hs')
-rw-r--r-- | dht/src/Data/Tox/Onion.hs | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs index d3c8086d..e0d7c744 100644 --- a/dht/src/Data/Tox/Onion.hs +++ b/dht/src/Data/Tox/Onion.hs | |||
@@ -60,7 +60,7 @@ import Data.Bits (shiftR,shiftL) | |||
60 | import qualified Rank2 | 60 | import qualified Rank2 |
61 | import Util (sameAddress) | 61 | import Util (sameAddress) |
62 | 62 | ||
63 | type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a | 63 | type HandleLo a = Arrival String SockAddr ByteString -> IO a |
64 | 64 | ||
65 | type UDPTransport = Transport String SockAddr ByteString | 65 | type UDPTransport = Transport String SockAddr ByteString |
66 | 66 | ||
@@ -264,11 +264,12 @@ forwardOnions crypto baddr udp sendTCP = udp { awaitMessage = forwardAwait crypt | |||
264 | 264 | ||
265 | forwardAwait :: TransportCrypto | 265 | forwardAwait :: TransportCrypto |
266 | -> UDPTransport | 266 | -> UDPTransport |
267 | -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a | 267 | -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> STM (IO a) |
268 | forwardAwait crypto udp sendTCP kont = do | 268 | forwardAwait crypto udp sendTCP kont = do |
269 | fix $ \another -> do | 269 | fix $ \another0 -> do |
270 | let another = join $ atomically another0 | ||
270 | awaitMessage udp $ \case | 271 | awaitMessage udp $ \case |
271 | m@(Just (Right (bs,saddr))) -> case B.head bs of | 272 | m@(Arrival saddr bs) -> case B.head bs of |
272 | 0x80 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy N0) crypto (Addressed saddr) udp another | 273 | 0x80 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy N0) crypto (Addressed saddr) udp another |
273 | 0x81 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy N1) crypto (Addressed saddr) udp another | 274 | 0x81 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy N1) crypto (Addressed saddr) udp another |
274 | 0x82 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy N2) crypto (Addressed saddr) udp another | 275 | 0x82 -> forward kont bs $ handleOnionRequest (Proxy :: Proxy N2) crypto (Addressed saddr) udp another |
@@ -278,9 +279,9 @@ forwardAwait crypto udp sendTCP kont = do | |||
278 | _ -> kont m | 279 | _ -> kont m |
279 | m -> kont m | 280 | m -> kont m |
280 | 281 | ||
281 | forward :: forall c b b1. (Serialize b, Show b) => | 282 | forward :: (Serialize b, Show b) => |
282 | (Maybe (Either String b1) -> c) -> ByteString -> (b -> c) -> c | 283 | HandleLo a -> ByteString -> (b -> IO a) -> IO a |
283 | forward kont bs f = either (kont . Just . Left) f $ decode $ B.tail bs | 284 | forward kont bs f = either (kont . ParseError) f $ decode $ B.tail bs |
284 | 285 | ||
285 | class SumToThree a b | 286 | class SumToThree a b |
286 | 287 | ||