From 64f26fba49e7ae933a0ccdcd7cdbb56c5c6a7df7 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Wed, 8 Jan 2014 07:53:52 +0400
Subject: Use newer krpc package

---
 src/Network/BitTorrent/DHT/Message.hs |  4 ++--
 src/Network/BitTorrent/DHT/Session.hs | 15 ++++++++-------
 2 files changed, 10 insertions(+), 9 deletions(-)

(limited to 'src/Network')

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"
 data Query a = Query
   { thisNodeId  :: NodeId -- ^ node id of /quering/ node;
   , queryParams :: a      -- ^ query parameters.
-  } deriving (Show, Eq)
+  } deriving (Show, Eq, Typeable)
 
 instance BEncode a => BEncode (Query a) where
   toBEncode Query {..} = toDict $
@@ -128,7 +128,7 @@ instance BEncode a => BEncode (Query a) where
 data Response a = Response
   { remoteNodeId :: NodeId -- ^ node id of /quered/ node;
   , responseVals :: a      -- ^ query result.
-  } deriving (Show, Eq)
+  } deriving (Show, Eq, Typeable)
 
 instance BEncode a => BEncode (Response a) where
   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 ((<>))
 import Text.PrettyPrint.Class
 
 import Data.Torrent.InfoHash
-import Network.KRPC
-import Network.KRPC.Method
+import Network.KRPC hiding (Options, def)
+import qualified Network.KRPC as KRPC (Options, def)
 import Network.BitTorrent.Core
 import Network.BitTorrent.Core.PeerAddr as P
 import Network.BitTorrent.DHT.Message
@@ -196,7 +196,8 @@ runDHT :: forall ip a. Address ip
        -> IO a               -- ^ result.
 runDHT handlers opts naddr action = runResourceT $ do
   runStderrLoggingT $ LoggingT $  \ logger -> do
-    (_, m) <- allocate (newManager (toSockAddr naddr) handlers) closeManager
+    let kopts = KRPC.def
+    (_, m) <- allocate (newManager kopts (toSockAddr naddr) handlers) closeManager
     myId   <- liftIO genNodeId
     node   <- liftIO $ Node opts m
              <$> newMVar (nullTable myId (optBucketCount opts))
@@ -254,14 +255,14 @@ grantToken addr = do
   toks <- asks sessionTokens >>= liftIO . readTVarIO
   return $ T.lookup addr $ tokenMap toks
 
--- | Throws 'ProtocolError' if token is invalid or already expired.
+-- | Throws 'HandlerError' if the token is invalid or already
+-- expired. See 'TokenMap' for details.
 checkToken :: Hashable a => NodeAddr a -> Token -> DHT ip ()
 checkToken addr questionableToken = do
   tryUpdateSecret
   toks <- asks sessionTokens >>= liftIO . readTVarIO
   unless (member addr questionableToken (tokenMap toks)) $
-    liftIO $ throwIO $ KError ProtocolError "bad token" ""
-     -- todo reset transaction id in krpc
+    throw $ InvalidParameter "token"
 
 {-----------------------------------------------------------------------
 -- Routing table
@@ -355,7 +356,7 @@ nodeHandler :: Address ip => KRPC (Query a) (Response b)
            => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip
 nodeHandler action = handler $ \ sockAddr (Query remoteId q) -> do
   case fromSockAddr sockAddr of
-    Nothing    -> liftIO $ throwIO $ KError GenericError "bad address" ""
+    Nothing    -> throwIO BadAddress
     Just naddr -> do
       insertNode (NodeInfo remoteId naddr)
       Response <$> getNodeId <*> action naddr q
-- 
cgit v1.2.3