WIP Onion routing.

1 files changed, 47 insertions, 14 deletions

diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index a3c1950f..b5ac748a 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -35,6 +35,8 @@ module Network.Tox.Onion.Transport
     , peelSymmetric
     , OnionRoute(..)
     , N3
+    , onionKey
+    , onionNodeInfo
     ) where
 
 import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
@@ -42,10 +44,11 @@ import Network.QueryResponse
 import Crypto.Tox hiding (encrypt,decrypt)
 import Network.Tox.NodeId
 import qualified Crypto.Tox as ToxCrypto
-import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo,DHTPublicKey,asymNodeInfo)
+import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,asymNodeInfo)
 
 import Debug.Trace
 import Control.Arrow
+import Control.Applicative
 import Control.Concurrent.STM
 import Control.Monad
 import qualified Data.ByteString  as B
@@ -88,14 +91,23 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8))
                   , Show (f DataToRoute)
                   ) => Show (OnionMessage f)
 
+msgNonce :: OnionMessage f -> Nonce24
+msgNonce (OnionAnnounce a)               = assymNonce a
+msgNonce (OnionAnnounceResponse _ n24 _) = n24
+msgNonce (OnionToRoute _ a)              = assymNonce a
+msgNonce (OnionToRouteResponse a)        = assymNonce a
+
 data OnionDestination r
     = OnionToOwner     NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us.
     | OnionDestination NodeInfo (Maybe r)       -- ^ Our own onion-path.
     deriving Show
 
+onionNodeInfo :: OnionDestination r -> NodeInfo
+onionNodeInfo (OnionToOwner     ni _) = ni
+onionNodeInfo (OnionDestination ni _) = ni
+
 onionKey :: OnionDestination r -> Maybe PublicKey
-onionKey (OnionToOwner     ni _) = Just $ id2key (nodeId ni)
-onionKey (OnionDestination ni _) = Just $ id2key (nodeId ni)
+onionKey od = Just $ id2key . nodeId $ onionNodeInfo od
 
 instance Sized (OnionMessage Encrypted) where
     size = VarSize $ \case
@@ -176,11 +188,19 @@ encodeOnionAddr :: (NodeInfo -> r -> IO (Maybe OnionRoute))
 encodeOnionAddr _ (msg,OnionToOwner ni p) =
     return $ Just ( runPut $ putResponse (OnionResponse p msg)
                   , nodeAddr ni )
-encodeOnionAddr _        (msg,OnionDestination _  Nothing   ) = return Nothing
+encodeOnionAddr _        (msg,OnionDestination _  Nothing   ) = do
+    hPutStrLn stderr $ "ONION encode missing routeid"
+    return Nothing
 encodeOnionAddr getRoute (msg,OnionDestination ni (Just rid)) = do
-    let go route = do
-            return (runPut $ putRequest $ wrapForRoute msg ni route, nodeAddr ni)
-    getRoute ni rid >>= mapM go
+    let go route0 = do
+            let route = route0 { routeNonce = msgNonce msg } -- TODO: This necessary?
+            return ( runPut $ putRequest $ wrapForRoute msg ni route
+                   , nodeAddr $ routeNodeA route)
+        mapM' f x = do
+            hPutStrLn stderr $ "ONION encode sending to  " ++ show ni
+            hPutStrLn stderr $ "ONION encode getRoute -> " ++ show (mapM (\y -> map ($ y) [routeNodeA,routeNodeB,routeNodeC]) x)
+            mapM f x
+    getRoute ni rid >>= mapM' go
 
 
 forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport
@@ -239,16 +259,19 @@ deriving instance ( Show (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
 instance ( Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted))
          , Sized (ReturnPath n)
          , Serialize (ReturnPath n)
+         , Typeable n
          ) => Serialize (OnionRequest n) where
     get = do
         -- TODO share code with 'getOnionRequest'
-        n24 <- get
+        n24 <- case eqT :: Maybe (n :~: N3) of
+                Just Refl -> return $ Nonce24 zeros24
+                Nothing   -> get
         cnt <- remaining
         let fwdsize = case size :: Size (ReturnPath n) of ConstSize n -> cnt - n
         fwd <- isolate fwdsize get
         rpath <- get
         return $ OnionRequest n24 fwd rpath
-    put (OnionRequest n f p) = put n >> put f >> put p
+    put (OnionRequest n f p) = maybe (put n) (\Refl -> return ()) (eqT :: Maybe (n :~: N3)) >> put f >> put p
 
 -- getRequest :: _
 -- getRequest = OnionRequest <$> get <*> get <*> get
@@ -402,6 +425,7 @@ handleOnionRequest :: forall a proxy n.
                       ( LessThanThree n
                       , KnownPeanoNat n
                       , Sized (ReturnPath n)
+                      , Typeable n
                       ) => proxy n -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionRequest n -> IO a
 handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = do
     let n = peanoVal rpath
@@ -414,7 +438,7 @@ handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) =
             hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), e]
             kont
         Right (Addressed dst msg') -> do
-            hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), "SUCCESS"]
+            hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), "-->", either show show (either4or6 dst), "SUCCESS"]
             sendMessage udp dst (runPut $ putRequest $ OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath)
             kont
 
@@ -472,9 +496,13 @@ getOnionRequest = do
     path <- get
     return (a,path)
 
-putRequest :: (KnownPeanoNat n, Serialize (OnionRequest n)) => OnionRequest n -> Put
+putRequest :: ( KnownPeanoNat n
+              , Serialize (OnionRequest n)
+              , Typeable n
+              ) => OnionRequest n -> Put
 putRequest req = do
-    putWord8 $ 0x80 + fromIntegral (peanoVal req)
+    let tag = 0x80 + fromIntegral (peanoVal req)
+    when (tag <= 0x82) (putWord8 tag)
     put req
 
 putResponse :: (KnownPeanoNat n, Serialize (OnionResponse n)) => OnionResponse n -> Put
@@ -513,9 +541,14 @@ data AnnounceResponse = AnnounceResponse
 instance Sized AnnounceResponse where
     size = contramap is_stored size <> contramap announceNodes size
 
+getNodeList :: S.Get [NodeInfo]
+getNodeList = do
+    n <- S.get
+    (:) n <$> (getNodeList <|> pure [])
+
 instance S.Serialize AnnounceResponse where
-    get = AnnounceResponse <$> S.get <*> S.get
-    put (AnnounceResponse st ns) = S.put st >> S.put ns
+    get = AnnounceResponse <$> S.get <*> (SendNodes <$> getNodeList)
+    put (AnnounceResponse st (SendNodes ns)) = S.put st >> mapM_ S.put ns
 
 data DataToRoute = DataToRoute
     { dataFromKey :: PublicKey -- Real public key of sender