summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal1
-rw-r--r--src/Network/BitTorrent/DHT/Message.hs15
-rw-r--r--tests/Network/BitTorrent/DHT/MessageSpec.hs41
3 files changed, 50 insertions, 7 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index e987a4be..4cb9fce7 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -170,6 +170,7 @@ test-suite spec
170 Network.BitTorrent.Core.NodeSpec 170 Network.BitTorrent.Core.NodeSpec
171 Network.BitTorrent.Core.PeerAddrSpec 171 Network.BitTorrent.Core.PeerAddrSpec
172 Network.BitTorrent.Core.PeerIdSpec 172 Network.BitTorrent.Core.PeerIdSpec
173 Network.BitTorrent.DHT.MessageSpec
173 Network.BitTorrent.Tracker.MessageSpec 174 Network.BitTorrent.Tracker.MessageSpec
174 Network.BitTorrent.Tracker.RPCSpec 175 Network.BitTorrent.Tracker.RPCSpec
175 Network.BitTorrent.Tracker.RPC.HTTPSpec 176 Network.BitTorrent.Tracker.RPC.HTTPSpec
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
index 85abf019..9000a9be 100644
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ b/src/Network/BitTorrent/DHT/Message.hs
@@ -55,7 +55,7 @@ node_id_key = "id"
55data Query a = Query 55data Query a = Query
56 { thisNodeId :: NodeId 56 { thisNodeId :: NodeId
57 , queryParams :: a 57 , queryParams :: a
58 } 58 } deriving (Show, Eq)
59 59
60instance BEncode a => BEncode (Query a) where 60instance BEncode a => BEncode (Query a) where
61 toBEncode Query {..} = toDict $ 61 toBEncode Query {..} = toDict $
@@ -75,7 +75,7 @@ instance BEncode a => BEncode (Query a) where
75data Response a = Response 75data Response a = Response
76 { remoteNodeId :: NodeId 76 { remoteNodeId :: NodeId
77 , responseVals :: a 77 , responseVals :: a
78 } 78 } deriving (Show, Eq)
79 79
80instance BEncode a => BEncode (Response a) where 80instance BEncode a => BEncode (Response a) where
81 toBEncode = toBEncode . toQuery 81 toBEncode = toBEncode . toQuery
@@ -91,9 +91,10 @@ instance BEncode a => BEncode (Response a) where
91-- ping method 91-- ping method
92-----------------------------------------------------------------------} 92-----------------------------------------------------------------------}
93 93
94-- | The most basic query is a ping. 94-- | The most basic query is a ping. Ping query is used to check if a
95-- quered node is still alive.
95data Ping = Ping 96data Ping = Ping
96 deriving Typeable 97 deriving (Show, Eq, Typeable)
97 98
98instance BEncode Ping where 99instance BEncode Ping where
99 toBEncode Ping = toDict endDict 100 toBEncode Ping = toDict endDict
@@ -110,7 +111,7 @@ instance KRPC (Query Ping) [Ping] where
110-- | Find node is used to find the contact information for a node 111-- | Find node is used to find the contact information for a node
111-- given its ID. 112-- given its ID.
112newtype FindNode = FindNode NodeId 113newtype FindNode = FindNode NodeId
113 deriving Typeable 114 deriving (Show, Eq, Typeable)
114 115
115target_key :: BKey 116target_key :: BKey
116target_key = "target" 117target_key = "target"
@@ -119,12 +120,12 @@ instance BEncode FindNode where
119 toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict 120 toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict
120 fromBEncode = fromDict $ FindNode <$>! target_key 121 fromBEncode = fromDict $ FindNode <$>! target_key
121 122
122-- | When a node receives a find_node query, it should respond with a 123-- | When a node receives a 'FindNode' query, it should respond with a
123-- the compact node info for the target node or the K (8) closest good 124-- the compact node info for the target node or the K (8) closest good
124-- nodes in its own routing table. 125-- nodes in its own routing table.
125-- 126--
126newtype NodeFound ip = NodeFound [NodeInfo ip] 127newtype NodeFound ip = NodeFound [NodeInfo ip]
127 deriving Typeable 128 deriving (Show, Eq, Typeable)
128 129
129nodes_key :: BKey 130nodes_key :: BKey
130nodes_key = "nodes" 131nodes_key = "nodes"
diff --git a/tests/Network/BitTorrent/DHT/MessageSpec.hs b/tests/Network/BitTorrent/DHT/MessageSpec.hs
new file mode 100644
index 00000000..e8a76f14
--- /dev/null
+++ b/tests/Network/BitTorrent/DHT/MessageSpec.hs
@@ -0,0 +1,41 @@
1module Network.BitTorrent.DHT.MessageSpec (spec) where
2import Test.Hspec
3import Data.BEncode as BE
4import Network.BitTorrent.Core
5import Network.BitTorrent.DHT.Message
6
7
8spec :: Spec
9spec = do
10 describe "ping" $ do
11 it "properly bencoded" $ do
12 BE.decode "d2:id20:abcdefghij0123456789e"
13 `shouldBe` Right (Query "abcdefghij0123456789" Ping)
14
15 BE.encode (Query "abcdefghij0123456789" Ping)
16 `shouldBe` "d2:id20:abcdefghij0123456789e"
17
18 BE.decode "d2:id20:mnopqrstuvwxyz123456e"
19 `shouldBe` Right (Response "mnopqrstuvwxyz123456" Ping)
20
21 BE.encode (Response "mnopqrstuvwxyz123456" Ping)
22 `shouldBe` "d2:id20:mnopqrstuvwxyz123456e"
23
24 describe "find_node" $ do
25 it "properly bencoded" $ do
26 BE.decode "d2:id20:abcdefghij0123456789\
27 \6:target20:mnopqrstuvwxyz123456e"
28 `shouldBe` Right (Query "abcdefghij0123456789"
29 (FindNode "mnopqrstuvwxyz123456"))
30
31 BE.encode (Query "abcdefghij0123456789"
32 (FindNode "mnopqrstuvwxyz123456"))
33 `shouldBe`
34 "d2:id20:abcdefghij01234567896:target20:mnopqrstuvwxyz123456e"
35
36 let addr = "127.0.0.1:256" :: NodeAddr IPv4
37 let nid = "0123456789abcdefghij"
38 BE.decode "d2:id20:0123456789abcdefghij\
39 \5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\&56\
40 \e"
41 `shouldBe` Right (Response nid (NodeFound [NodeInfo nid addr])) \ No newline at end of file