summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2014-01-08 07:53:52 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2014-01-08 07:53:52 +0400
commit64f26fba49e7ae933a0ccdcd7cdbb56c5c6a7df7 (patch)
tree05aa86f2dd3ecff40b6fde9b40e02a0d4e404e91 /src/Network/BitTorrent
parent3ddfd24a0b158bdf06f654a373f82e0591cb9b8f (diff)
Use newer krpc package
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/DHT/Message.hs4
-rw-r--r--src/Network/BitTorrent/DHT/Session.hs15
2 files changed, 10 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
index 461c8f83..ac4889fe 100644
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ b/src/Network/BitTorrent/DHT/Message.hs
@@ -108,7 +108,7 @@ node_id_key = "id"
108data Query a = Query 108data Query a = Query
109 { thisNodeId :: NodeId -- ^ node id of /quering/ node; 109 { thisNodeId :: NodeId -- ^ node id of /quering/ node;
110 , queryParams :: a -- ^ query parameters. 110 , queryParams :: a -- ^ query parameters.
111 } deriving (Show, Eq) 111 } deriving (Show, Eq, Typeable)
112 112
113instance BEncode a => BEncode (Query a) where 113instance BEncode a => BEncode (Query a) where
114 toBEncode Query {..} = toDict $ 114 toBEncode Query {..} = toDict $
@@ -128,7 +128,7 @@ instance BEncode a => BEncode (Query a) where
128data Response a = Response 128data Response a = Response
129 { remoteNodeId :: NodeId -- ^ node id of /quered/ node; 129 { remoteNodeId :: NodeId -- ^ node id of /quered/ node;
130 , responseVals :: a -- ^ query result. 130 , responseVals :: a -- ^ query result.
131 } deriving (Show, Eq) 131 } deriving (Show, Eq, Typeable)
132 132
133instance BEncode a => BEncode (Response a) where 133instance BEncode a => BEncode (Response a) where
134 toBEncode = toBEncode . toQuery 134 toBEncode = toBEncode . toQuery
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index 4e6a6825..d7c6a7f7 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -76,8 +76,8 @@ import Text.PrettyPrint as PP hiding ((<>))
76import Text.PrettyPrint.Class 76import Text.PrettyPrint.Class
77 77
78import Data.Torrent.InfoHash 78import Data.Torrent.InfoHash
79import Network.KRPC 79import Network.KRPC hiding (Options, def)
80import Network.KRPC.Method 80import qualified Network.KRPC as KRPC (Options, def)
81import Network.BitTorrent.Core 81import Network.BitTorrent.Core
82import Network.BitTorrent.Core.PeerAddr as P 82import Network.BitTorrent.Core.PeerAddr as P
83import Network.BitTorrent.DHT.Message 83import Network.BitTorrent.DHT.Message
@@ -196,7 +196,8 @@ runDHT :: forall ip a. Address ip
196 -> IO a -- ^ result. 196 -> IO a -- ^ result.
197runDHT handlers opts naddr action = runResourceT $ do 197runDHT handlers opts naddr action = runResourceT $ do
198 runStderrLoggingT $ LoggingT $ \ logger -> do 198 runStderrLoggingT $ LoggingT $ \ logger -> do
199 (_, m) <- allocate (newManager (toSockAddr naddr) handlers) closeManager 199 let kopts = KRPC.def
200 (_, m) <- allocate (newManager kopts (toSockAddr naddr) handlers) closeManager
200 myId <- liftIO genNodeId 201 myId <- liftIO genNodeId
201 node <- liftIO $ Node opts m 202 node <- liftIO $ Node opts m
202 <$> newMVar (nullTable myId (optBucketCount opts)) 203 <$> newMVar (nullTable myId (optBucketCount opts))
@@ -254,14 +255,14 @@ grantToken addr = do
254 toks <- asks sessionTokens >>= liftIO . readTVarIO 255 toks <- asks sessionTokens >>= liftIO . readTVarIO
255 return $ T.lookup addr $ tokenMap toks 256 return $ T.lookup addr $ tokenMap toks
256 257
257-- | Throws 'ProtocolError' if token is invalid or already expired. 258-- | Throws 'HandlerError' if the token is invalid or already
259-- expired. See 'TokenMap' for details.
258checkToken :: Hashable a => NodeAddr a -> Token -> DHT ip () 260checkToken :: Hashable a => NodeAddr a -> Token -> DHT ip ()
259checkToken addr questionableToken = do 261checkToken addr questionableToken = do
260 tryUpdateSecret 262 tryUpdateSecret
261 toks <- asks sessionTokens >>= liftIO . readTVarIO 263 toks <- asks sessionTokens >>= liftIO . readTVarIO
262 unless (member addr questionableToken (tokenMap toks)) $ 264 unless (member addr questionableToken (tokenMap toks)) $
263 liftIO $ throwIO $ KError ProtocolError "bad token" "" 265 throw $ InvalidParameter "token"
264 -- todo reset transaction id in krpc
265 266
266{----------------------------------------------------------------------- 267{-----------------------------------------------------------------------
267-- Routing table 268-- Routing table
@@ -355,7 +356,7 @@ nodeHandler :: Address ip => KRPC (Query a) (Response b)
355 => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip 356 => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip
356nodeHandler action = handler $ \ sockAddr (Query remoteId q) -> do 357nodeHandler action = handler $ \ sockAddr (Query remoteId q) -> do
357 case fromSockAddr sockAddr of 358 case fromSockAddr sockAddr of
358 Nothing -> liftIO $ throwIO $ KError GenericError "bad address" "" 359 Nothing -> throwIO BadAddress
359 Just naddr -> do 360 Just naddr -> do
360 insertNode (NodeInfo remoteId naddr) 361 insertNode (NodeInfo remoteId naddr)
361 Response <$> getNodeId <*> action naddr q 362 Response <$> getNodeId <*> action naddr q