Unverified: data to route response packet sending.

1 files changed, 51 insertions, 11 deletions

diff --git a/Tox.hs b/Tox.hs
index d8bf11bc..de702f1f 100644
--- a/Tox.hs
+++ b/Tox.hs
@@ -459,6 +459,17 @@ decryptAssymetric sk typ assym
             . second (either (const (Tox.Nonce8 0)) id . S.decode)
             $ B.splitAt (B.length bs - 8) bs
 
+-- TODO: We should not be having to re-serialize this data... :/
+--       There should be a way to pass the Tox.Assymetric value up the layers.
+passThroughAssymetric :: Tox.PacketKind -> Tox.PubKey -> Tox.Assymetric -> Either String Msg
+passThroughAssymetric typ k assym
+    = Right $ Msg
+        { msgNonce = Tox.assymetricNonce . Tox.sent $ assym -- Not used.
+        , msgType = typ
+        , msgData = S.encode (k,assym)
+        , msgSendBack = Nonce8 0 -- Not used.
+        }
+
 {-
 decryptUnclm :: SecretKey -> Tox.PacketKind -> NodeId -> Tox.Nonce8 -> Tox.UnclaimedAssymetric -> Either String Msg
 decryptUnclm sk typ sender n8 unclm
@@ -559,8 +570,9 @@ msgLayer sk pk = layerTransport parse serialize
     parse :: (Tox.PacketKind,InterediateRep) -> ToxPath -> Either String (Msg,ToxPath)
     parse (typ,Assym  x)  addr = fmap (,addr) $ decryptAssymetric sk typ x
     parse (typ,Assym' x)  addr = fmap (,addr) $ decryptAssymetric sk typ x
+    parse (typ,ToRoute k x)  addr = fmap (,addr) $ passThroughAssymetric typ k x
     parse (typ,Unclm n x) addr = Right ( Msg typ (Tox.assymetricNonce x) (S.encode (Tox.assymetricData x)) n
-                                                   , addr)
+                                       , addr)
     serialize :: Msg -> ToxPath -> ((Tox.PacketKind,InterediateRep),ToxPath)
     serialize x addr@(ToxPath ni _) = case Tox.pktClass (msgType x) of
         Tox.AssymetricClass      {} -> ((msgType x, Assym  $ encryptAssymetric sk pk (nodeId ni) x), addr)
@@ -569,7 +581,9 @@ msgLayer sk pk = layerTransport parse serialize
 
 data InterediateRep = Assym Tox.Assymetric
                     | Assym' Tox.Assymetric
+                    | ToRoute Tox.PubKey Tox.Assymetric
                     | Unclm Tox.Nonce8 Tox.UnclaimedAssymetric
+                    | RouteResponse Tox.Packet
 
 asymLayer :: Transport String SockAddr Tox.Packet -> Transport String ToxPath (Tox.PacketKind,InterediateRep)
 asymLayer = layerTransport parse (\p@(typ,_) -> trace ("SERIALIZE "++show typ) $ serialize p)
@@ -577,10 +591,10 @@ asymLayer = layerTransport parse (\p@(typ,_) -> trace ("SERIALIZE "++show typ) $
     parse :: Tox.Packet -> SockAddr -> Either String ((Tox.PacketKind,InterediateRep),ToxPath)
     parse x addr = case Tox.pktClass (Tox.pktKind x) of
         Tox.AssymetricClass top fromp      -> go Tox.senderKey  fromp Assym
-        Tox.AliasedClass    top fromp      -> let (Tox.Aliased a,rpath) = fromp x
-                                              in fmap (\ni -> ( (Tox.pktKind x, Assym' a)
-                                                              , ToxPath ni rpath ))
-                                                      $ nodeInfo (Tox.senderKey a) addr
+        Tox.AliasedClass    top fromp      -> goalias $ fromp x
+        Tox.ToRouteClass    top fromp      -> do let (key,y) = fromp x
+                                                 ((typ,Assym' a),addr') <- goalias y
+                                                 return ((typ,ToRoute key a),addr')
         Tox.NoncedUnclaimedClass top fromp -> go (const zeroID) fromp (uncurry Unclm)
         -- OnionClass
       where go mkaddr fromp c = let y = fromp x
@@ -588,14 +602,19 @@ asymLayer = layerTransport parse (\p@(typ,_) -> trace ("SERIALIZE "++show typ) $
                                           . (\ni -> ToxPath ni Tox.emptyReturnPath)
                                         )
                                         $ nodeInfo (mkaddr y) addr
+            goalias (Tox.Aliased a,rpath) = fmap (\ni -> ( (Tox.pktKind x, Assym' a)
+                                                         , ToxPath ni rpath ))
+                                                 $ nodeInfo (Tox.senderKey a) addr
 
     serialize :: (Tox.PacketKind,InterediateRep) -> ToxPath -> (Tox.Packet,SockAddr)
     serialize (typ,Assym assym) (ToxPath addr rpath) = (x,nodeAddr addr)
         where x = case Tox.pktClass typ of Tox.AssymetricClass top _ -> top assym
     serialize (typ,Assym' assym) (ToxPath addr rpath) = (x,nodeAddr addr) -- TODO rpath
         where x = case Tox.pktClass typ of Tox.AliasedClass    top _ -> top (Tox.Aliased assym, error "todo: ReturnPath")
+    -- An unclm sent to a ToxPath is turned into an OnionResponse before being sent out.
     serialize (typ,Unclm nonce unclm) (ToxPath addr rpath) = (Tox.mkOnion rpath x,nodeAddr addr)
         where x = case Tox.pktClass typ of Tox.NoncedUnclaimedClass top _ -> top nonce unclm
+    serialize (_,RouteResponse x) (ToxPath addr rpath) = (Tox.mkOnion rpath x, nodeAddr addr)
     -- OnionClass
 
 toxLayer :: Transport String SockAddr ByteString -> Transport String SockAddr Tox.Packet
@@ -627,10 +646,12 @@ trimPackets addr bs = do
                         GetNodesType         -> Just id
                         AnnounceType         -> Just id
                         AnnounceResponseType -> Just id
+                        DataRequestType      -> Just id
+                        -- DataResponseType     -> Just id
                         OnionResponse3Type   -> Just id
                         _                    -> Nothing
 
-newClient :: SockAddr -> IO (ToxClient, Routing)
+newClient :: SockAddr -> IO (ToxClient, Routing, TVar AnnouncedKeys)
 newClient addr = do
     udp <- udpTransport addr
     secret <- generateSecretKey
@@ -691,7 +712,8 @@ newClient addr = do
               $ addVerbosity
               $ msgLayer secret pubkey
               $ onInbound (updateRouting client routing)
-              $ asymLayer
+              $ asymnet
+        asymnet = asymLayer
               -- $ addHandler (handleMessage aclient)
               $ toxLayer
               $ addVerbosity2
@@ -716,6 +738,7 @@ newClient addr = do
         handlers PingType       = handler PongType pingH
         handlers GetNodesType   = handler SendNodesType $ getNodesH routing
         handlers AnnounceType   = handler' AnnounceResponseType $ announceH routing toks keydb
+        handlers DataRequestType = Just $ NoReply (S.decode . msgData) $ dataToRouteH keydb asymnet
         {-
         handlers var OnionRequest0  = noreply OnionRequest0
                                       $ onionSend0H (symmetricCipher (return symkey)
@@ -764,7 +787,7 @@ newClient addr = do
             , clientResponseId    = genNonce24 var
             }
 
-    return (client, routing)
+    return (client, routing, keydb)
 
 toxKademlia :: ToxClient -> TriadCommittee NodeId SockAddr -> TVar (R.BucketList NodeInfo) -> TVar (Int.PSQ POSIXTime) -> Kademlia NodeId NodeInfo
 toxKademlia client committee var sched
@@ -862,6 +885,8 @@ classify (Msg { msgType     = typ
             OnionRequest1Type  -> IsQuery typ
             OnionRequest2Type  -> IsQuery typ
             AnnounceType       -> IsQuery typ
+            DataRequestType    -> IsQuery typ
+            DataResponseType   -> IsResponse
             _                  -> const $ IsUnknown ("Unknown message type: "++show typ)
 
 {-
@@ -1151,6 +1176,19 @@ getNodesH routing addr (GetNodes nid) = do
 
     k = 4
 
+
+dataToRouteH :: TVar AnnouncedKeys -> Transport err ToxPath (Tox.PacketKind,InterediateRep) -> addr -> (Tox.PubKey,Assymetric) -> IO ()
+dataToRouteH keydb udp _ (k,assym) = do
+    mb <- atomically $ do
+        ks <- readTVar keydb
+        forM (MinMaxPSQ.lookup' k (keyAssoc ks)) $ \(p,(cnt,rpath)) -> do
+            writeTVar keydb $ ks { keyAssoc = MinMaxPSQ.insert' k (cnt + 1, rpath) p (keyAssoc ks) }
+            return rpath
+    forM_ mb $ \rpath -> do
+        -- forward
+        sendMessage udp rpath (DataResponseType, RouteResponse $ DataToRouteResponse $ Aliased assym)
+        hPutStrLn stderr $ "Forwarding data-to-route -->"++show k
+
 -- Toxcore generates `ping_id`s by taking a 32 byte sha hash of the current time,
 -- some secret bytes generated when the instance is created, the current time
 -- divided by a 20 second timeout, the public key of the requester and the source
@@ -1187,7 +1225,7 @@ announceH routing toks keydb (ToxPath naddr retpath) req = do
                             (announceSeeking req)
                 modifyTVar' keydb (insertKey tm (announceSeeking req) toxpath d)
             ks <- readTVar keydb
-            return $ snd <$> MinMaxPSQ.lookup' (announceSeeking req) (keyAssoc ks)
+            return $ snd . snd <$> MinMaxPSQ.lookup' (announceSeeking req) (keyAssoc ks)
         newtok <- if storing
                     then Nonce32 . toPaddedByteString 32 <$> grantToken toks naddr
                     else return $ zeros32
@@ -1332,11 +1370,13 @@ type NodeDistance = Tox.PubKey
 
 data AnnouncedKeys = AnnouncedKeys
     { keyByAge :: PSQ NodeId (Down POSIXTime) -- timeout of 300 seconds
-    , keyAssoc :: MinMaxPSQ' Tox.PubKey NodeDistance ToxPath
+    , keyAssoc :: MinMaxPSQ' Tox.PubKey NodeDistance (Int,ToxPath)
     }
 
 insertKey :: POSIXTime -> Tox.PubKey -> ToxPath -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys
 insertKey tm pub toxpath d keydb = AnnouncedKeys
     { keyByAge = PSQ.insert pub (Down tm) (keyByAge keydb)
-    , keyAssoc = MinMaxPSQ.insert' pub toxpath d (keyAssoc keydb)
+    , keyAssoc = case MinMaxPSQ.lookup' pub (keyAssoc keydb) of
+                    Just (_,(cnt,_)) -> MinMaxPSQ.insert' pub (cnt,toxpath) d (keyAssoc keydb)
+                    Nothing          -> MinMaxPSQ.insert' pub (0  ,toxpath) d (keyAssoc keydb)
     }