diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2014-01-08 07:53:52 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2014-01-08 07:53:52 +0400 |
commit | 64f26fba49e7ae933a0ccdcd7cdbb56c5c6a7df7 (patch) | |
tree | 05aa86f2dd3ecff40b6fde9b40e02a0d4e404e91 /src/Network/BitTorrent | |
parent | 3ddfd24a0b158bdf06f654a373f82e0591cb9b8f (diff) |
Use newer krpc package
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/DHT/Message.hs | 4 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Session.hs | 15 |
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" | |||
108 | data Query a = Query | 108 | data 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 | ||
113 | instance BEncode a => BEncode (Query a) where | 113 | instance 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 | |||
128 | data Response a = Response | 128 | data 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 | ||
133 | instance BEncode a => BEncode (Response a) where | 133 | instance 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 ((<>)) | |||
76 | import Text.PrettyPrint.Class | 76 | import Text.PrettyPrint.Class |
77 | 77 | ||
78 | import Data.Torrent.InfoHash | 78 | import Data.Torrent.InfoHash |
79 | import Network.KRPC | 79 | import Network.KRPC hiding (Options, def) |
80 | import Network.KRPC.Method | 80 | import qualified Network.KRPC as KRPC (Options, def) |
81 | import Network.BitTorrent.Core | 81 | import Network.BitTorrent.Core |
82 | import Network.BitTorrent.Core.PeerAddr as P | 82 | import Network.BitTorrent.Core.PeerAddr as P |
83 | import Network.BitTorrent.DHT.Message | 83 | import Network.BitTorrent.DHT.Message |
@@ -196,7 +196,8 @@ runDHT :: forall ip a. Address ip | |||
196 | -> IO a -- ^ result. | 196 | -> IO a -- ^ result. |
197 | runDHT handlers opts naddr action = runResourceT $ do | 197 | runDHT 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. | ||
258 | checkToken :: Hashable a => NodeAddr a -> Token -> DHT ip () | 260 | checkToken :: Hashable a => NodeAddr a -> Token -> DHT ip () |
259 | checkToken addr questionableToken = do | 261 | checkToken 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 |
356 | nodeHandler action = handler $ \ sockAddr (Query remoteId q) -> do | 357 | nodeHandler 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 |