Use newer krpc package

5 files changed, 29 insertions, 26 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 073329de..28c26baf 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -148,7 +148,7 @@ library
 
                        -- Network
                      , network      >= 2.4
-                     , krpc         >= 0.5
+                     , krpc         >= 0.6
                      , http-types   >= 0.8
                      , http-conduit >= 1.9 && < 2.0
                      , wai          >= 1.4 && < 2.0
@@ -202,6 +202,7 @@ test-suite spec
                      , convertible
                      , data-default
                      , monad-loops
+                     , monad-logger
                      , containers
                      , iproute
 
@@ -220,7 +221,7 @@ test-suite spec
                      , http-types
                      , bencoding
                      , process
-                     , krpc  >= 0.5.0.0
+                     , krpc  >= 0.6
                      , bittorrent
   ghc-options:         -Wall -fno-warn-orphans
 
@@ -250,11 +251,6 @@ executable mktorrent
   hs-source-dirs:      examples
   main-is:             MkTorrent.hs
   other-modules:       Paths_bittorrent
---                     , MkTorrent.Amend
---                     , MkTorrent.Check
---                     , MkTorrent.Create
---                     , MkTorrent.Magnet
---                     , MkTorrent.Show
   build-depends:       base == 4.6.*
                      , bytestring
                      , text
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
diff --git a/sub/krpc b/sub/krpc
-Subproject 9a9a7d5750e24ee0810006f3dd2a7e7879b521e
+Subproject 41ca2fc6ece3e24542703035c4249f409eca390
diff --git a/tests/Network/BitTorrent/DHT/MessageSpec.hs b/tests/Network/BitTorrent/DHT/MessageSpec.hs
index af694470..0d84c919 100644
--- a/tests/Network/BitTorrent/DHT/MessageSpec.hs
+++ b/tests/Network/BitTorrent/DHT/MessageSpec.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent.DHT.MessageSpec (spec) where
 import Control.Monad.Reader
+import Control.Monad.Logger
 import Control.Concurrent
 import Data.BEncode as BE
 import Data.ByteString.Lazy as BL
@@ -8,7 +9,8 @@ import Data.Default
 import Data.List as L
 import Network.BitTorrent.Core
 import Network.BitTorrent.DHT.Message
-import Network.KRPC
+import qualified Network.KRPC as KRPC (def)
+import Network.KRPC hiding (def)
 import Network.Socket (PortNumber)
 import Test.Hspec
 import Test.QuickCheck
@@ -18,6 +20,10 @@ import Network.BitTorrent.CoreSpec      ()
 import Network.BitTorrent.DHT.TokenSpec ()
 import Data.Torrent.InfoHashSpec        ()
 
+
+instance MonadLogger IO where
+  monadLoggerLog _ _ _ _ = return ()
+
 remoteAddr :: SockAddr
 remoteAddr = SockAddrInet 6881 (256 * 256 * 256 + 127)
 
@@ -29,12 +35,12 @@ thisPort = 60001
 
 rpc :: ReaderT (Manager IO) IO a -> IO a
 rpc action = do
-  withManager thisAddr [] $ runReaderT $ do
+  withManager KRPC.def thisAddr [] $ runReaderT $ do
     listen
     action
 
-isProtocolError :: KError -> Bool
-isProtocolError KError {..} = errorCode == ProtocolError
+isQueryError :: QueryFailure -> Bool
+isQueryError _ = True
 
 prop_bencode :: Eq a => Show a => BEncode a => a -> Expectation
 prop_bencode x = BE.decode (BL.toStrict (BE.encode x)) `shouldBe` Right x
@@ -196,5 +202,5 @@ spec = do
         let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
         let invalidToken = ""
         query remoteAddr (Query nid (Announce False def thisPort invalidToken)))
-          `shouldThrow` isProtocolError
+          `shouldThrow` isQueryError
       return ()