From 7fe3c9e04ecd7aec962bcc83bc4cf5139cf732f0 Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 31 Oct 2017 15:28:59 -0400 Subject: Added missing signatures for MainlineDHT. --- src/Network/BitTorrent/MainlineDHT.hs | 52 ++++++++++++++--------------------- 1 file changed, 21 insertions(+), 31 deletions(-) (limited to 'src/Network/BitTorrent/MainlineDHT.hs') diff --git a/src/Network/BitTorrent/MainlineDHT.hs b/src/Network/BitTorrent/MainlineDHT.hs index c9abf003..f4a5ade1 100644 --- a/src/Network/BitTorrent/MainlineDHT.hs +++ b/src/Network/BitTorrent/MainlineDHT.hs @@ -52,6 +52,7 @@ import Data.Typeable import Data.Word import qualified Data.Wrapper.PSQInt as Int import Debug.Trace +import Network.BitTorrent.MainlineDHT.Symbols import Network.Kademlia import Network.Address (Address, fromAddr, fromSockAddr, setPort, sockAddrPort, testIdBit, @@ -303,6 +304,7 @@ data Message a = Q { msgOrigin :: NodeId , rspPayload :: Either Error a , rspReflectedIP :: Maybe SockAddr } +showBE :: BValue -> String showBE bval = L8.unpack (showBEncode bval) instance BE.BEncode (Message BValue) where @@ -409,6 +411,7 @@ encodeAny tid key val aux = toDict $ .: endDict +showPacket :: ([L8.ByteString] -> [L8.ByteString]) -> SockAddr -> L8.ByteString -> ByteString -> String showPacket f addr flow bs = L8.unpack $ L8.unlines es where es = map (L8.append prefix) (f $ L8.lines pp) @@ -418,6 +421,7 @@ showPacket f addr flow bs = L8.unpack $ L8.unlines es pp = either L8.pack showBEncode $ BE.decode bs -- Add detailed printouts for every packet. +addVerbosity :: Transport err SockAddr ByteString -> Transport err SockAddr ByteString addVerbosity tr = tr { awaitMessage = \kont -> awaitMessage tr $ \m -> do forM_ m $ mapM_ $ \(msg,addr) -> do @@ -429,7 +433,7 @@ addVerbosity tr = } - +showParseError :: ByteString -> SockAddr -> String -> String showParseError bs addr err = showPacket (L8.pack err :) addr " --> " bs parsePacket :: ByteString -> SockAddr -> Either String (Message BValue, NodeInfo) @@ -918,36 +922,6 @@ mkAnnounce portnum info token = Announce , impliedPort = False } -peer_ip_key = "ip" -peer_id_key = "peer id" -peer_port_key = "port" -msg_type_key = "msg_type" -piece_key = "piece" -total_size_key = "total_size" -node_id_key :: BKey -node_id_key = "id" -read_only_key :: BKey -read_only_key = "ro" -want_key :: BKey -want_key = "want" -target_key :: BKey -target_key = "target" -nodes_key :: BKey -nodes_key = "nodes" -nodes6_key :: BKey -nodes6_key = "nodes6" -info_hash_key :: BKey -info_hash_key = "info_hash" -peers_key :: BKey -peers_key = "values" -token_key :: BKey -token_key = "token" -name_key :: BKey -name_key = "name" -port_key :: BKey -port_key = "port" -implied_port_key :: BKey -implied_port_key = "implied_port" instance BEncode Announce where toBEncode Announce {..} = toDict $ @@ -1004,8 +978,18 @@ announceH (SwarmsDatabase peers toks _) naddr announcement = do } return Announced +isReadonlyClient :: MainlineClient -> Bool isReadonlyClient client = False -- TODO +mainlineSend :: ( BEncode a + , BEncode a2 + ) => Method + -> (a2 -> b) + -> (t -> a) + -> MainlineClient + -> t + -> NodeInfo + -> IO (Maybe b) mainlineSend meth unwrap msg client nid addr = do reply <- sendQuery client serializer (msg nid) addr -- sendQuery will return (Just (Left _)) on a parse error. We're going to @@ -1032,21 +1016,27 @@ ping client addr = getNodes :: MainlineClient -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],())) getNodes = mainlineSend (Method "find_node") unwrapNodes $ flip FindNode (Just Want_Both) +unwrapNodes :: NodeFound -> ([NodeInfo], [NodeInfo], ()) unwrapNodes (NodeFound ns4 ns6) = (ns4++ns6, ns4++ns6,()) getPeers :: MainlineClient -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[PeerAddr],Token)) getPeers = mainlineSend (Method "get_peers") unwrapPeers $ flip GetPeers (Just Want_Both) . coerce +unwrapPeers :: GotPeers -> ([NodeInfo], [PeerAddr], Token) unwrapPeers (GotPeers ps (NodeFound ns4 ns6) tok) = (ns4++ns6, ps, tok) +mainlineSearch :: (NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [r], tok))) + -> Search NodeId (IP, PortNumber) tok NodeInfo r mainlineSearch qry = Search { searchSpace = mainlineSpace , searchNodeAddress = nodeIP &&& nodePort , searchQuery = qry } +nodeSearch :: MainlineClient -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo nodeSearch client = mainlineSearch (getNodes client) +peerSearch :: MainlineClient -> Search NodeId (IP, PortNumber) Token NodeInfo PeerAddr peerSearch client = mainlineSearch (getPeers client) -- | List of bootstrap nodes maintained by different bittorrent -- cgit v1.2.3