Completed TCP getNodes query.

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
     , OnionRoute(..)
     , N0
     , N1
+    , N2
     , N3
     , onionKey
     , onionAliasSelector
     , selectAlias
     , RouteId(..)
     , routeId
-    , rewrap
     , putRequest
+    , wrapForRoute
+    , wrapSymmetric
+    , wrapOnion
+    , wrapOnionPure
     ) where
 
 import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
@@ -91,6 +95,7 @@ import DPut
 import DebugTag
 import Data.Word64Map (fitsInInt)
 import Data.Bits (shiftR,shiftL)
+import qualified Rank2
 
 type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
 
@@ -124,6 +129,26 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8))
                   , Show (f DataToRoute)
                   ) => Show (OnionMessage f)
 
+instance Data (OnionMessage Encrypted) where
+  gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt
+  toConstr _     = error "OnionMessage.toConstr"
+  gunfold _ _    = error "OnionMessage.gunfold"
+#if MIN_VERSION_base(4,2,0)
+  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.OnionMessage"
+#else
+  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.OnionMessage"
+#endif
+
+instance Rank2.Functor OnionMessage where
+    f <$> m = mapPayload (Proxy :: Proxy Serialize) f m
+
+instance Payload Serialize OnionMessage where
+    mapPayload _ f (OnionAnnounce a)                = OnionAnnounce (fmap f a)
+    mapPayload _ f (OnionAnnounceResponse n8 n24 a) = OnionAnnounceResponse n8 n24 (f a)
+    mapPayload _ f (OnionToRoute k a)               = OnionToRoute k a
+    mapPayload _ f (OnionToRouteResponse a)         = OnionToRouteResponse a
+
+
 msgNonce :: OnionMessage f -> Nonce24
 msgNonce (OnionAnnounce a)               = asymmNonce a
 msgNonce (OnionAnnounceResponse _ n24 _) = n24
@@ -274,10 +299,10 @@ encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
     return x
 
 
-forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> UDPTransport
+forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport
 forwardOnions crypto udp sendTCP = udp { awaitMessage = forwardAwait crypto udp sendTCP }
 
-forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a
+forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a
 forwardAwait crypto udp sendTCP kont = do
     fix $ \another -> do
       awaitMessage udp $ \case
@@ -325,6 +350,7 @@ data OnionRequest n = OnionRequest
  deriving (Eq,Ord)
 
 
+{-
 instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n)
          , Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
          ) => Data (OnionRequest n) where
@@ -336,6 +362,8 @@ instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n)
 #else
   dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.OnionRequest"
 #endif
+-}
+
 
 instance (Typeable n, Serialize (ReturnPath n)) => Data (OnionResponse n) where
   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
 
 data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a }
                  | TCPIndex { tcpIndex :: Int, unaddressed :: a }
- deriving (Eq,Show)
+ deriving (Eq,Ord,Show)
+
+instance (Typeable a, Serialize a) => Data (Addressed a) where
+  gfoldl f z a   = z (either error id . S.decode) `f` S.encode a
+  toConstr _     = error "Addressed.toConstr"
+  gunfold _ _    = error "Addressed.gunfold"
+#if MIN_VERSION_base(4,2,0)
+  dataTypeOf _   = mkNoRepType "Network.Tox.Onion.Transport.Addressed"
+#else
+  dataTypeOf _   = mkNorepType "Network.Tox.Onion.Transport.Addressed"
+#endif
 
 instance Sized a => Sized (Addressed a) where
     size = case size :: Size a of
@@ -434,6 +472,10 @@ addrToIndex _ = 0
 indexToAddr :: Int -> SockAddr
 indexToAddr x = SockAddrInet6 0 0 (fromIntegral x, fromIntegral (x `shiftR` 32),0,0) 0
 
+-- Note, toxcore would check an address family byte here to detect a TCP-bound
+-- packet, but we instead use the IPv6 id and rely on the port number being
+-- zero.  Since it will be symmetrically encrypted for our eyes only, it's not
+-- important to conform on this point.
 instance Serialize a => Serialize (Addressed a) where
     get = do saddr <- getForwardAddr
              a <- get
@@ -549,6 +591,7 @@ instance (Serialize (Encrypted (Addressed (Forwarding n msg)))) => Serialize (Fo
     get = Forwarding <$> getPublicKey <*> get
     put (Forwarding k x) = putPublicKey k >> put x
 
+{-
 rewrap :: (ThreeMinus n ~ S (ThreeMinus (S n)),
                  Serialize (ReturnPath n),
                  Serialize
@@ -565,6 +608,7 @@ rewrap crypto saddr (OnionRequest nonce msg rpath) = do
         Addressed dst msg'
           -> Right (OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath, dst)
         _ -> Left "Onion forward to TCP client?"
+-}
 
 handleOnionRequest :: forall a proxy n.
                       ( LessThanThree n
@@ -584,7 +628,6 @@ handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) =
 
     case peeled of
         Left e -> do
-            -- todo report encryption error
             dput XOnion $ unwords [ "peelOnion:", show n, showDestination, e]
             kont
         Right (Addressed dst msg') -> do
@@ -617,7 +660,7 @@ handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (Return
                         -> TransportCrypto
                         -> SockAddr
                         -> UDPTransport
-                        -> (Int -> OnionResponse N1 -> IO ()) -- ^ TCP-relay onion send.
+                        -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP-relay onion send.
                         -> IO a
                         -> OnionResponse (S n)
                         -> IO a
@@ -633,10 +676,9 @@ handleOnionResponse proxy crypto saddr udp sendTCP kont (OnionResponse path msg)
             sendMessage udp dst (runPut $ putResponse $ OnionResponse path' msg)
             kont
         Right (TCPIndex dst path') -> do
-            -- This should only occur for OnionResponse N1
-            case gcast (OnionResponse path' msg) of
-                Just supported -> sendTCP dst supported
-                Nothing        -> dput XUnexpected "handleOnionResponse: TCP-bound message not supported."
+            case peanoVal path' of
+                0 -> sendTCP dst msg
+                n -> dput XUnexpected $ "handleOnionResponse: TCP-bound OnionResponse" ++ show n ++ " not supported."
             kont
 
 
@@ -900,6 +942,17 @@ wrapOnion crypto skey nonce destkey saddr fwd = do
     secret <- lookupSharedSecret crypto skey destkey nonce
     return $ Forwarding (toPublic skey) $ ToxCrypto.encrypt secret plain
 
+wrapOnionPure :: Serialize (Forwarding n msg) =>
+           SecretKey
+           -> ToxCrypto.State
+           -> SockAddr
+           -> Forwarding n msg
+           -> Forwarding (S n) msg
+wrapOnionPure skey st saddr fwd = Forwarding (toPublic skey) (ToxCrypto.encrypt st plain)
+ where
+    plain = encodePlain $ Addressed saddr fwd
+
+
 
 -- TODO
 -- Two types of packets may be sent to Rendezvous via OnionToRoute requests.