TCP Client, WIP.

2 files changed, 79 insertions, 3 deletions

diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 3d8a9e93..0cb03718 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -105,7 +105,7 @@ putOnionAsymm typ p a = put typ >> p >> putAliasedAsymm a
 
 data OnionMessage (f :: * -> *)
     = OnionAnnounce (Asymm (f (AnnounceRequest,Nonce8)))
-    | OnionAnnounceResponse Nonce8 Nonce24 (f AnnounceResponse)
+    | OnionAnnounceResponse Nonce8 Nonce24 (f AnnounceResponse) -- XXX: Why is Nonce8 transmitted in the clear?
     | OnionToRoute PublicKey (Asymm (Encrypted DataToRoute)) -- destination key, aliased Asymm
     | OnionToRouteResponse (Asymm (Encrypted DataToRoute))
 
diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs
index 28bcd244..608becc3 100644
--- a/src/Network/Tox/TCP.hs
+++ b/src/Network/Tox/TCP.hs
@@ -4,17 +4,29 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Network.Tox.TCP where
 
+import Control.Arrow
 import Control.Concurrent
 import Control.Concurrent.STM
+import Crypto.Random
+import Data.Functor.Contravariant
 import Data.Functor.Identity
+import Data.IP
 import Data.Serialize
+import Network.Socket (SockAddr(..))
 
 import Crypto.Tox
-import Data.ByteString (hPut,hGet)
+import Data.ByteString (hPut,hGet,ByteString)
 import Data.Tox.Relay
-import Network.Address (setPort,PortNumber,SockAddr)
+import qualified Data.Word64Map
+import DebugTag
+import DPut
+import Network.Address (setPort,PortNumber)
+import Network.Kademlia.Routing
+import Network.Kademlia.Search
 import Network.QueryResponse
 import Network.QueryResponse.TCP
+import Network.Tox.DHT.Handlers (toxSpace)
+import Network.Tox.Onion.Transport (OnionMessage(..),OnionResponse(..),N1)
 import qualified Network.Tox.NodeId as UDP
 
 
@@ -28,12 +40,18 @@ data NodeInfo = NodeInfo
 
 type NodeId = UDP.NodeId
 
+instance Show NodeInfo where
+    show (NodeInfo udp port) = show udp ++ "{tcp:"++show port++"}"
+
 nodeId :: NodeInfo -> NodeId
 nodeId ni = UDP.nodeId $ udpNodeInfo ni
 
 nodeAddr :: NodeInfo -> SockAddr
 nodeAddr ni = setPort (tcpPort ni) $ UDP.nodeAddr $ udpNodeInfo ni
 
+nodeIP :: NodeInfo -> IP
+nodeIP ni = UDP.nodeIP $ udpNodeInfo ni
+
 tcpStream :: (Serialize y, Sized y, Serialize x, Sized x) =>
                    TransportCrypto -> StreamHandshake NodeInfo x y
 tcpStream crypto = StreamHandshake
@@ -81,3 +99,61 @@ tcpStream crypto = StreamHandshake
 
 toxTCP :: TransportCrypto -> IO (Transport err NodeInfo RelayPacket)
 toxTCP crypto = tcpTransport 30 (tcpStream crypto)
+
+tcpSpace :: KademliaSpace NodeId NodeInfo
+tcpSpace = contramap udpNodeInfo toxSpace
+
+nodeSearch :: Client err meth tid NodeInfo RelayPacket -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo
+nodeSearch client = Search
+    { searchSpace       = tcpSpace
+    , searchNodeAddress = nodeIP &&& tcpPort
+    , searchQuery       = getNodes client
+    }
+
+getNodes :: Client err meth tid NodeInfo RelayPacket -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [NodeInfo], Maybe ()))
+getNodes client seeking dst = do
+    return Nothing -- TODO
+
+handleOOB :: PublicKey -> ByteString -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket))
+handleOOB k bs src dst = do
+    dput XMisc $ "TODO: handleOOB " ++ show src
+    return Nothing
+
+handle2route :: OnionResponse N1 -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket))
+handle2route o src dst = do
+    dput XMisc $ "TODO: handle2route " ++ show src
+    return Nothing
+
+
+tcpClient :: TransportCrypto -> IO (Client String () Nonce8 NodeInfo RelayPacket)
+tcpClient crypto = do
+    net <- toxTCP crypto
+    drg <- drgNew
+    map_var <- atomically $ newTVar (drg, Data.Word64Map.empty)
+    return Client
+        { clientNet = net
+        , clientDispatcher = DispatchMethods
+            { classifyInbound = \case
+                RelayPing n           -> IsQuery () n
+                RelayPong n           -> IsResponse n
+                OnionPacketResponse (OnionResponse _ (OnionAnnounceResponse n8 n24 ciphered)) -> IsResponse n8
+                OnionPacketResponse o@(OnionResponse _ (OnionToRouteResponse _)) -> IsUnsolicited $ handle2route o
+                OOBRecv k bs          -> IsUnsolicited $ handleOOB k bs
+            , lookupHandler   = \() -> Just MethodHandler
+                    { methodParse     = \(RelayPing n8) -> Right ()
+                    , methodSerialize = \n8 src dst () -> RelayPong n8
+                    , methodAction    = \src () -> return ()
+                    }
+            , tableMethods = transactionMethods (contramap (\(Nonce8 w64) -> w64) w64MapMethods)
+                                $ first (either error Nonce8 . decode) . randomBytesGenerate 8
+            }
+        , clientErrorReporter = logErrors
+        , clientPending = map_var
+        , clientAddress = \_ -> return $ NodeInfo
+            { udpNodeInfo = either error id $ UDP.nodeInfo (UDP.key2id $ transportPublic crypto) (SockAddrInet 0 0)
+            , tcpPort = 0
+            }
+        , clientResponseId = return
+        , clientEnterQuery = \_ -> return ()
+        , clientLeaveQuery = \_ _ -> return ()
+        }