diff options
Diffstat (limited to 'DHTHandlers.hs')
-rw-r--r-- | DHTHandlers.hs | 36 |
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 | |||
6 | import Network.QueryResponse as QR hiding (Client) | 6 | import Network.QueryResponse as QR hiding (Client) |
7 | import qualified Network.QueryResponse as QR (Client) | 7 | import qualified Network.QueryResponse as QR (Client) |
8 | import ToxCrypto | 8 | import ToxCrypto |
9 | import ToxMessage as Tox (PacketKind(..), pattern PingType, pattern GetNodesType, pattern DHTRequestType) | 9 | import ToxMessage as Tox (PacketKind(..), pattern PingType, pattern PongType, pattern GetNodesType, pattern SendNodesType, pattern DHTRequestType) |
10 | import Network.BitTorrent.DHT.Search | ||
10 | 11 | ||
12 | import Control.Arrow | ||
11 | import qualified Data.Wrapper.PSQInt as Int | 13 | import qualified Data.Wrapper.PSQInt as Int |
12 | import Kademlia | 14 | import Kademlia |
13 | import Network.Address (WantIP (..), ipFamily, testIdBit) | 15 | import Network.Address (WantIP (..), ipFamily, testIdBit,fromSockAddr, sockAddrPort) |
14 | import qualified Network.DHT.Routing as R | 16 | import qualified Network.DHT.Routing as R |
15 | import TriadCommittee | 17 | import TriadCommittee |
18 | import Global6 | ||
16 | 19 | ||
17 | import Control.Monad | 20 | import Control.Monad |
18 | import Control.Concurrent.STM | 21 | import Control.Concurrent.STM |
19 | import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) | 22 | import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) |
20 | import Network.Socket | 23 | import Network.Socket |
24 | import Data.Hashable | ||
21 | import Data.IP | 25 | import Data.IP |
26 | import Data.Ord | ||
22 | import Data.Maybe | 27 | import Data.Maybe |
23 | import Data.Bits | 28 | import Data.Bits |
24 | 29 | ||
@@ -77,9 +82,11 @@ newRouting addr crypto update4 update6 = do | |||
77 | 82 | ||
78 | 83 | ||
79 | -- TODO: This should cover more cases | 84 | -- TODO: This should cover more cases |
85 | isLocal :: IP -> Bool | ||
80 | isLocal (IPv6 ip6) = (ip6 == toEnum 0) | 86 | isLocal (IPv6 ip6) = (ip6 == toEnum 0) |
81 | isLocal (IPv4 ip4) = (ip4 == toEnum 0) | 87 | isLocal (IPv4 ip4) = (ip4 == toEnum 0) |
82 | 88 | ||
89 | isGlobal :: IP -> Bool | ||
83 | isGlobal = not . isLocal | 90 | isGlobal = not . isLocal |
84 | 91 | ||
85 | prefer4or6 :: NodeInfo -> Maybe WantIP -> WantIP | 92 | prefer4or6 :: NodeInfo -> Maybe WantIP -> WantIP |
@@ -210,6 +217,27 @@ transitionCommittee committee _ = return $ return () | |||
210 | 217 | ||
211 | type Handler = MethodHandler String TransactionId NodeInfo Message | 218 | type Handler = MethodHandler String TransactionId NodeInfo Message |
212 | 219 | ||
220 | isPing :: (f Ping -> Ping) -> DHTMessage f -> Either String Ping | ||
221 | isPing unpack (DHTPing a) = Right $ unpack $ assymData a | ||
222 | isPing _ _ = Left "Bad ping" | ||
223 | |||
224 | mkPong :: TransactionId -> NodeInfo -> NodeInfo -> Pong -> DHTMessage ((,) Nonce8) | ||
225 | mkPong tid src dst pong = DHTPong $ wrapAssym tid src dst (, pong) | ||
226 | |||
227 | isGetNodes :: (f GetNodes -> GetNodes) -> DHTMessage f -> Either String GetNodes | ||
228 | isGetNodes unpack (DHTGetNodes a) = Right $ unpack $ assymData a | ||
229 | isGetNodes _ _ = Left "Bad GetNodes" | ||
230 | |||
231 | mkSendNodes :: TransactionId -> NodeInfo -> NodeInfo -> SendNodes -> DHTMessage ((,) Nonce8) | ||
232 | mkSendNodes tid src dst sendnodes = DHTSendNodes $ wrapAssym tid src dst (, sendnodes) | ||
233 | |||
213 | handlers :: Routing -> Tox.PacketKind -> Maybe Handler | 234 | handlers :: Routing -> Tox.PacketKind -> Maybe Handler |
214 | handlers routing PingType = handler PongType pingH | 235 | handlers routing PingType = Just $ MethodHandler (isPing snd) mkPong pingH |
215 | handlers routing GetNodesType = handler SendNodesType $ getNodesH routing | 236 | handlers routing GetNodesType = Just $ MethodHandler (isGetNodes snd) mkSendNodes $ getNodesH routing |
237 | |||
238 | nodeSearch :: Client -> Search NodeId (IP,PortNumber) () NodeInfo NodeInfo | ||
239 | nodeSearch client = Search | ||
240 | { searchSpace = toxSpace | ||
241 | , searchNodeAddress = nodeIP &&& nodePort | ||
242 | , searchQuery = getNodes client | ||
243 | } | ||