Implemented more stubs for DHT transport.

1 files changed, 32 insertions, 4 deletions

diff --git a/DHTHandlers.hs b/DHTHandlers.hs
index 41a4bc06..437b05f3 100644
--- a/DHTHandlers.hs
+++ b/DHTHandlers.hs
@@ -6,19 +6,24 @@ import DHTTransport
 import Network.QueryResponse as QR hiding (Client)
 import qualified Network.QueryResponse as QR (Client)
 import ToxCrypto
-import ToxMessage  as Tox (PacketKind(..), pattern PingType, pattern GetNodesType, pattern DHTRequestType)
+import ToxMessage  as Tox (PacketKind(..), pattern PingType, pattern PongType, pattern GetNodesType, pattern SendNodesType, pattern DHTRequestType)
+import Network.BitTorrent.DHT.Search
 
+import Control.Arrow
 import qualified Data.Wrapper.PSQInt as Int
 import Kademlia
-import Network.Address               (WantIP (..), ipFamily, testIdBit)
+import Network.Address               (WantIP (..), ipFamily, testIdBit,fromSockAddr, sockAddrPort)
 import qualified Network.DHT.Routing as R
 import TriadCommittee
+import Global6
 
 import Control.Monad
 import Control.Concurrent.STM
 import Data.Time.Clock.POSIX  (POSIXTime, getPOSIXTime)
 import Network.Socket
+import Data.Hashable
 import Data.IP
+import Data.Ord
 import Data.Maybe
 import Data.Bits
 
@@ -77,9 +82,11 @@ newRouting addr crypto update4 update6 = do
 
 
 -- TODO: This should cover more cases
+isLocal :: IP -> Bool
 isLocal (IPv6 ip6) = (ip6 == toEnum 0)
 isLocal (IPv4 ip4) = (ip4 == toEnum 0)
 
+isGlobal :: IP -> Bool
 isGlobal = not . isLocal
 
 prefer4or6 :: NodeInfo -> Maybe WantIP -> WantIP
@@ -210,6 +217,27 @@ transitionCommittee committee _ = return $ return ()
 
 type Handler = MethodHandler String TransactionId NodeInfo Message
 
+isPing :: (f Ping -> Ping) ->  DHTMessage f -> Either String Ping
+isPing unpack (DHTPing a) = Right $ unpack $ assymData a
+isPing _      _           = Left "Bad ping"
+
+mkPong :: TransactionId -> NodeInfo -> NodeInfo -> Pong -> DHTMessage ((,) Nonce8)
+mkPong tid src dst pong = DHTPong $ wrapAssym tid src dst (, pong)
+
+isGetNodes :: (f GetNodes -> GetNodes) ->  DHTMessage f -> Either String GetNodes
+isGetNodes unpack (DHTGetNodes a) = Right $ unpack $ assymData a
+isGetNodes _      _               = Left "Bad GetNodes"
+
+mkSendNodes :: TransactionId -> NodeInfo -> NodeInfo -> SendNodes -> DHTMessage ((,) Nonce8)
+mkSendNodes tid src dst sendnodes = DHTSendNodes $ wrapAssym tid src dst (, sendnodes)
+
 handlers :: Routing -> Tox.PacketKind -> Maybe Handler
-handlers routing PingType     = handler PongType pingH
-handlers routing GetNodesType = handler SendNodesType $ getNodesH routing
+handlers routing PingType     = Just $ MethodHandler (isPing snd) mkPong pingH
+handlers routing GetNodesType = Just $ MethodHandler (isGetNodes snd) mkSendNodes $ getNodesH routing
+
+nodeSearch :: Client -> Search NodeId (IP,PortNumber) () NodeInfo NodeInfo
+nodeSearch client  = Search
+    { searchSpace       = toxSpace
+    , searchNodeAddress = nodeIP &&& nodePort
+    , searchQuery       = getNodes client
+    }