diff options
-rw-r--r-- | src/Network/BitTorrent/DHT.hs | 14 |
1 files changed, 5 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs index 6ce4c515..45cde70f 100644 --- a/src/Network/BitTorrent/DHT.hs +++ b/src/Network/BitTorrent/DHT.hs | |||
@@ -28,14 +28,12 @@ module Network.BitTorrent.DHT | |||
28 | ) where | 28 | ) where |
29 | 29 | ||
30 | import Control.Applicative | 30 | import Control.Applicative |
31 | import Control.Concurrent.Lifted hiding (yield) | ||
32 | import Control.Exception.Lifted | 31 | import Control.Exception.Lifted |
33 | import Control.Monad as M | 32 | import Control.Monad as M |
34 | import Control.Monad.Logger | 33 | import Control.Monad.Logger |
35 | import Control.Monad.Trans | 34 | import Control.Monad.Trans |
36 | import Data.Conduit as C | 35 | import Data.Conduit as C |
37 | import Data.Conduit.List as C | 36 | import Data.Conduit.List as C |
38 | import Data.List as L | ||
39 | import Data.Monoid | 37 | import Data.Monoid |
40 | import Data.Text as T | 38 | import Data.Text as T |
41 | import Network.Socket (PortNumber) | 39 | import Network.Socket (PortNumber) |
@@ -47,7 +45,6 @@ import Network.BitTorrent.Core | |||
47 | import Network.BitTorrent.DHT.Message | 45 | import Network.BitTorrent.DHT.Message |
48 | import Network.BitTorrent.DHT.Routing | 46 | import Network.BitTorrent.DHT.Routing |
49 | import Network.BitTorrent.DHT.Session | 47 | import Network.BitTorrent.DHT.Session |
50 | import Network.KRPC | ||
51 | 48 | ||
52 | 49 | ||
53 | {----------------------------------------------------------------------- | 50 | {----------------------------------------------------------------------- |
@@ -67,13 +64,12 @@ getPeersH = nodeHandler $ \ naddr (GetPeers ih) -> do | |||
67 | GotPeers <$> getPeerList ih <*> grantToken naddr | 64 | GotPeers <$> getPeerList ih <*> grantToken naddr |
68 | 65 | ||
69 | announceH :: Address ip => NodeHandler ip | 66 | announceH :: Address ip => NodeHandler ip |
70 | announceH = nodeHandler $ \ naddr (Announce {..}) -> do | 67 | announceH = nodeHandler $ \ naddr @ NodeAddr {..} (Announce {..}) -> do |
71 | checkToken naddr sessionToken | 68 | checkToken naddr sessionToken |
72 | case fromAddr naddr of | 69 | let annPort = if impliedPort then nodePort else port |
73 | Nothing -> throw $ KError ProtocolError "bad address" "" | 70 | let peerAddr = PeerAddr Nothing nodeHost annPort |
74 | Just paddr -> do | 71 | insertPeer topic peerAddr |
75 | insertPeer topic paddr | 72 | return Announced |
76 | return Announced | ||
77 | 73 | ||
78 | handlers :: Address ip => [NodeHandler ip] | 74 | handlers :: Address ip => [NodeHandler ip] |
79 | handlers = [pingH, findNodeH, getPeersH, announceH] | 75 | handlers = [pingH, findNodeH, getPeersH, announceH] |