diff options
Diffstat (limited to 'src/Network/Tox/Onion/Transport.hs')
-rw-r--r-- | src/Network/Tox/Onion/Transport.hs | 73 |
1 files changed, 63 insertions, 10 deletions
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs index 0cb03718..8918f913 100644 --- a/src/Network/Tox/Onion/Transport.hs +++ b/src/Network/Tox/Onion/Transport.hs | |||
@@ -44,14 +44,18 @@ module Network.Tox.Onion.Transport | |||
44 | , OnionRoute(..) | 44 | , OnionRoute(..) |
45 | , N0 | 45 | , N0 |
46 | , N1 | 46 | , N1 |
47 | , N2 | ||
47 | , N3 | 48 | , N3 |
48 | , onionKey | 49 | , onionKey |
49 | , onionAliasSelector | 50 | , onionAliasSelector |
50 | , selectAlias | 51 | , selectAlias |
51 | , RouteId(..) | 52 | , RouteId(..) |
52 | , routeId | 53 | , routeId |
53 | , rewrap | ||
54 | , putRequest | 54 | , putRequest |
55 | , wrapForRoute | ||
56 | , wrapSymmetric | ||
57 | , wrapOnion | ||
58 | , wrapOnionPure | ||
55 | ) where | 59 | ) where |
56 | 60 | ||
57 | import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) | 61 | import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) |
@@ -91,6 +95,7 @@ import DPut | |||
91 | import DebugTag | 95 | import DebugTag |
92 | import Data.Word64Map (fitsInInt) | 96 | import Data.Word64Map (fitsInInt) |
93 | import Data.Bits (shiftR,shiftL) | 97 | import Data.Bits (shiftR,shiftL) |
98 | import qualified Rank2 | ||
94 | 99 | ||
95 | type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a | 100 | type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a |
96 | 101 | ||
@@ -124,6 +129,26 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8)) | |||
124 | , Show (f DataToRoute) | 129 | , Show (f DataToRoute) |
125 | ) => Show (OnionMessage f) | 130 | ) => Show (OnionMessage f) |
126 | 131 | ||
132 | instance Data (OnionMessage Encrypted) where | ||
133 | gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt | ||
134 | toConstr _ = error "OnionMessage.toConstr" | ||
135 | gunfold _ _ = error "OnionMessage.gunfold" | ||
136 | #if MIN_VERSION_base(4,2,0) | ||
137 | dataTypeOf _ = mkNoRepType "Network.Tox.Onion.Transport.OnionMessage" | ||
138 | #else | ||
139 | dataTypeOf _ = mkNorepType "Network.Tox.Onion.Transport.OnionMessage" | ||
140 | #endif | ||
141 | |||
142 | instance Rank2.Functor OnionMessage where | ||
143 | f <$> m = mapPayload (Proxy :: Proxy Serialize) f m | ||
144 | |||
145 | instance Payload Serialize OnionMessage where | ||
146 | mapPayload _ f (OnionAnnounce a) = OnionAnnounce (fmap f a) | ||
147 | mapPayload _ f (OnionAnnounceResponse n8 n24 a) = OnionAnnounceResponse n8 n24 (f a) | ||
148 | mapPayload _ f (OnionToRoute k a) = OnionToRoute k a | ||
149 | mapPayload _ f (OnionToRouteResponse a) = OnionToRouteResponse a | ||
150 | |||
151 | |||
127 | msgNonce :: OnionMessage f -> Nonce24 | 152 | msgNonce :: OnionMessage f -> Nonce24 |
128 | msgNonce (OnionAnnounce a) = asymmNonce a | 153 | msgNonce (OnionAnnounce a) = asymmNonce a |
129 | msgNonce (OnionAnnounceResponse _ n24 _) = n24 | 154 | msgNonce (OnionAnnounceResponse _ n24 _) = n24 |
@@ -274,10 +299,10 @@ encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do | |||
274 | return x | 299 | return x |
275 | 300 | ||
276 | 301 | ||
277 | forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> UDPTransport | 302 | forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport |
278 | forwardOnions crypto udp sendTCP = udp { awaitMessage = forwardAwait crypto udp sendTCP } | 303 | forwardOnions crypto udp sendTCP = udp { awaitMessage = forwardAwait crypto udp sendTCP } |
279 | 304 | ||
280 | forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a | 305 | forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a |
281 | forwardAwait crypto udp sendTCP kont = do | 306 | forwardAwait crypto udp sendTCP kont = do |
282 | fix $ \another -> do | 307 | fix $ \another -> do |
283 | awaitMessage udp $ \case | 308 | awaitMessage udp $ \case |
@@ -325,6 +350,7 @@ data OnionRequest n = OnionRequest | |||
325 | deriving (Eq,Ord) | 350 | deriving (Eq,Ord) |
326 | 351 | ||
327 | 352 | ||
353 | {- | ||
328 | instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n) | 354 | instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n) |
329 | , Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted)) | 355 | , Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted)) |
330 | ) => Data (OnionRequest n) where | 356 | ) => Data (OnionRequest n) where |
@@ -336,6 +362,8 @@ instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n) | |||
336 | #else | 362 | #else |
337 | dataTypeOf _ = mkNorepType "Network.Tox.Onion.Transport.OnionRequest" | 363 | dataTypeOf _ = mkNorepType "Network.Tox.Onion.Transport.OnionRequest" |
338 | #endif | 364 | #endif |
365 | -} | ||
366 | |||
339 | 367 | ||
340 | instance (Typeable n, Serialize (ReturnPath n)) => Data (OnionResponse n) where | 368 | instance (Typeable n, Serialize (ReturnPath n)) => Data (OnionResponse n) where |
341 | gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt | 369 | gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt |
@@ -397,7 +425,17 @@ instance (Sized (ReturnPath n)) => Sized (OnionResponse (S n)) where | |||
397 | 425 | ||
398 | data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a } | 426 | data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a } |
399 | | TCPIndex { tcpIndex :: Int, unaddressed :: a } | 427 | | TCPIndex { tcpIndex :: Int, unaddressed :: a } |
400 | deriving (Eq,Show) | 428 | deriving (Eq,Ord,Show) |
429 | |||
430 | instance (Typeable a, Serialize a) => Data (Addressed a) where | ||
431 | gfoldl f z a = z (either error id . S.decode) `f` S.encode a | ||
432 | toConstr _ = error "Addressed.toConstr" | ||
433 | gunfold _ _ = error "Addressed.gunfold" | ||
434 | #if MIN_VERSION_base(4,2,0) | ||
435 | dataTypeOf _ = mkNoRepType "Network.Tox.Onion.Transport.Addressed" | ||
436 | #else | ||
437 | dataTypeOf _ = mkNorepType "Network.Tox.Onion.Transport.Addressed" | ||
438 | #endif | ||
401 | 439 | ||
402 | instance Sized a => Sized (Addressed a) where | 440 | instance Sized a => Sized (Addressed a) where |
403 | size = case size :: Size a of | 441 | size = case size :: Size a of |
@@ -434,6 +472,10 @@ addrToIndex _ = 0 | |||
434 | indexToAddr :: Int -> SockAddr | 472 | indexToAddr :: Int -> SockAddr |
435 | indexToAddr x = SockAddrInet6 0 0 (fromIntegral x, fromIntegral (x `shiftR` 32),0,0) 0 | 473 | indexToAddr x = SockAddrInet6 0 0 (fromIntegral x, fromIntegral (x `shiftR` 32),0,0) 0 |
436 | 474 | ||
475 | -- Note, toxcore would check an address family byte here to detect a TCP-bound | ||
476 | -- packet, but we instead use the IPv6 id and rely on the port number being | ||
477 | -- zero. Since it will be symmetrically encrypted for our eyes only, it's not | ||
478 | -- important to conform on this point. | ||
437 | instance Serialize a => Serialize (Addressed a) where | 479 | instance Serialize a => Serialize (Addressed a) where |
438 | get = do saddr <- getForwardAddr | 480 | get = do saddr <- getForwardAddr |
439 | a <- get | 481 | a <- get |
@@ -549,6 +591,7 @@ instance (Serialize (Encrypted (Addressed (Forwarding n msg)))) => Serialize (Fo | |||
549 | get = Forwarding <$> getPublicKey <*> get | 591 | get = Forwarding <$> getPublicKey <*> get |
550 | put (Forwarding k x) = putPublicKey k >> put x | 592 | put (Forwarding k x) = putPublicKey k >> put x |
551 | 593 | ||
594 | {- | ||
552 | rewrap :: (ThreeMinus n ~ S (ThreeMinus (S n)), | 595 | rewrap :: (ThreeMinus n ~ S (ThreeMinus (S n)), |
553 | Serialize (ReturnPath n), | 596 | Serialize (ReturnPath n), |
554 | Serialize | 597 | Serialize |
@@ -565,6 +608,7 @@ rewrap crypto saddr (OnionRequest nonce msg rpath) = do | |||
565 | Addressed dst msg' | 608 | Addressed dst msg' |
566 | -> Right (OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath, dst) | 609 | -> Right (OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath, dst) |
567 | _ -> Left "Onion forward to TCP client?" | 610 | _ -> Left "Onion forward to TCP client?" |
611 | -} | ||
568 | 612 | ||
569 | handleOnionRequest :: forall a proxy n. | 613 | handleOnionRequest :: forall a proxy n. |
570 | ( LessThanThree n | 614 | ( LessThanThree n |
@@ -584,7 +628,6 @@ handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = | |||
584 | 628 | ||
585 | case peeled of | 629 | case peeled of |
586 | Left e -> do | 630 | Left e -> do |
587 | -- todo report encryption error | ||
588 | dput XOnion $ unwords [ "peelOnion:", show n, showDestination, e] | 631 | dput XOnion $ unwords [ "peelOnion:", show n, showDestination, e] |
589 | kont | 632 | kont |
590 | Right (Addressed dst msg') -> do | 633 | Right (Addressed dst msg') -> do |
@@ -617,7 +660,7 @@ handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (Return | |||
617 | -> TransportCrypto | 660 | -> TransportCrypto |
618 | -> SockAddr | 661 | -> SockAddr |
619 | -> UDPTransport | 662 | -> UDPTransport |
620 | -> (Int -> OnionResponse N1 -> IO ()) -- ^ TCP-relay onion send. | 663 | -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP-relay onion send. |
621 | -> IO a | 664 | -> IO a |
622 | -> OnionResponse (S n) | 665 | -> OnionResponse (S n) |
623 | -> IO a | 666 | -> IO a |
@@ -633,10 +676,9 @@ handleOnionResponse proxy crypto saddr udp sendTCP kont (OnionResponse path msg) | |||
633 | sendMessage udp dst (runPut $ putResponse $ OnionResponse path' msg) | 676 | sendMessage udp dst (runPut $ putResponse $ OnionResponse path' msg) |
634 | kont | 677 | kont |
635 | Right (TCPIndex dst path') -> do | 678 | Right (TCPIndex dst path') -> do |
636 | -- This should only occur for OnionResponse N1 | 679 | case peanoVal path' of |
637 | case gcast (OnionResponse path' msg) of | 680 | 0 -> sendTCP dst msg |
638 | Just supported -> sendTCP dst supported | 681 | n -> dput XUnexpected $ "handleOnionResponse: TCP-bound OnionResponse" ++ show n ++ " not supported." |
639 | Nothing -> dput XUnexpected "handleOnionResponse: TCP-bound message not supported." | ||
640 | kont | 682 | kont |
641 | 683 | ||
642 | 684 | ||
@@ -900,6 +942,17 @@ wrapOnion crypto skey nonce destkey saddr fwd = do | |||
900 | secret <- lookupSharedSecret crypto skey destkey nonce | 942 | secret <- lookupSharedSecret crypto skey destkey nonce |
901 | return $ Forwarding (toPublic skey) $ ToxCrypto.encrypt secret plain | 943 | return $ Forwarding (toPublic skey) $ ToxCrypto.encrypt secret plain |
902 | 944 | ||
945 | wrapOnionPure :: Serialize (Forwarding n msg) => | ||
946 | SecretKey | ||
947 | -> ToxCrypto.State | ||
948 | -> SockAddr | ||
949 | -> Forwarding n msg | ||
950 | -> Forwarding (S n) msg | ||
951 | wrapOnionPure skey st saddr fwd = Forwarding (toPublic skey) (ToxCrypto.encrypt st plain) | ||
952 | where | ||
953 | plain = encodePlain $ Addressed saddr fwd | ||
954 | |||
955 | |||
903 | 956 | ||
904 | -- TODO | 957 | -- TODO |
905 | -- Two types of packets may be sent to Rendezvous via OnionToRoute requests. | 958 | -- Two types of packets may be sent to Rendezvous via OnionToRoute requests. |