TCP Client, WIP.

4 files changed, 97 insertions, 15 deletions

diff --git a/src/Data/Tox/Relay.hs b/src/Data/Tox/Relay.hs
index 72a05660..1437c9cd 100644
--- a/src/Data/Tox/Relay.hs
+++ b/src/Data/Tox/Relay.hs
@@ -41,8 +41,8 @@ data RelayPacket
     | RoutingResponse ConId PublicKey -- 0 for refusal, 16-255 for success.
     | ConnectNotification ConId
     | DisconnectNotification ConId
-    | RelayPing Word64
-    | RelayPong Word64
+    | RelayPing Nonce8
+    | RelayPong Nonce8
     | OOBSend PublicKey ByteString
     | OOBRecv PublicKey ByteString
     | OnionPacket (OnionRequest N0)
@@ -82,8 +82,8 @@ instance Serialize RelayPacket where
             1 -> RoutingResponse <$> get <*> getPublicKey
             2 -> ConnectNotification <$> get
             3 -> DisconnectNotification <$> get
-            4 -> RelayPing <$> getWord64be
-            5 -> RelayPong <$> getWord64be
+            4 -> RelayPing <$> get
+            5 -> RelayPong <$> get
             6 -> OOBSend <$> getPublicKey <*> (remaining >>= getBytes)
             7 -> OOBRecv <$> getPublicKey <*> (remaining >>= getBytes)
             8 -> OnionPacket <$> get
@@ -97,8 +97,8 @@ instance Serialize RelayPacket where
             RoutingResponse rpid k       -> put rpid >> putPublicKey k
             ConnectNotification conid    -> put conid
             DisconnectNotification conid -> put conid
-            RelayPing pingid             -> putWord64be pingid
-            RelayPong pingid             -> putWord64be pingid
+            RelayPing pingid             -> put pingid
+            RelayPong pingid             -> put pingid
             OOBSend k bs                 -> putPublicKey k >> putByteString bs
             OOBRecv k bs                 -> putPublicKey k >> putByteString bs
             OnionPacket query            -> put query
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 37762eb8..83a17037 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -116,11 +116,17 @@ myAddr routing4 routing6 maddr = atomically $ do
 
 newClient :: (DRG g, Show addr, Show meth) =>
               g -> Transport String addr x
-                -> (Client String meth DHT.TransactionId addr x -> x -> MessageClass String meth DHT.TransactionId addr x)
+                -> (Client String meth DHT.TransactionId addr x
+                    -> x
+                    -> MessageClass String meth DHT.TransactionId addr x)
                 -> (Maybe addr -> IO addr)
-                -> (Client String meth DHT.TransactionId addr x -> meth -> Maybe (MethodHandler String DHT.TransactionId addr x))
-                -> (forall d. TransactionMethods d DHT.TransactionId addr x -> TransactionMethods d DHT.TransactionId addr x)
-                -> (Client String meth DHT.TransactionId addr x -> Transport String addr x -> Transport String addr x)
+                -> (Client String meth DHT.TransactionId addr x
+                    -> meth
+                    -> Maybe (MethodHandler String DHT.TransactionId addr x))
+                -> (forall d. TransactionMethods d DHT.TransactionId addr x
+                    -> TransactionMethods d DHT.TransactionId addr x)
+                -> (Client String meth DHT.TransactionId addr x
+                    -> Transport String addr x -> Transport String addr x)
                 -> IO (Client String meth DHT.TransactionId addr x)
 newClient drg net classify selfAddr handlers modifytbl modifynet = do
     -- If we have 8-byte keys for IntMap, then use it for transaction lookups.
@@ -139,8 +145,8 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
             return $ Left (word64mapT,map_var)
     let dispatch tbl var handlers client = DispatchMethods
                 { classifyInbound = classify client
-                , lookupHandler = handlers -- var
-                , tableMethods = modifytbl tbl
+                , lookupHandler   = handlers -- var
+                , tableMethods    = modifytbl tbl
                 }
         eprinter = logErrors -- printErrors stderr
         mkclient (tbl,var) handlers =
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 ()
+        }