summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/DHT/MessageSpec.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Network/BitTorrent/DHT/MessageSpec.hs')
-rw-r--r--tests/Network/BitTorrent/DHT/MessageSpec.hs90
1 files changed, 86 insertions, 4 deletions
diff --git a/tests/Network/BitTorrent/DHT/MessageSpec.hs b/tests/Network/BitTorrent/DHT/MessageSpec.hs
index e8a76f14..9f4c58b0 100644
--- a/tests/Network/BitTorrent/DHT/MessageSpec.hs
+++ b/tests/Network/BitTorrent/DHT/MessageSpec.hs
@@ -1,12 +1,37 @@
1{-# LANGUAGE RecordWildCards #-}
1module Network.BitTorrent.DHT.MessageSpec (spec) where 2module Network.BitTorrent.DHT.MessageSpec (spec) where
3import Control.Monad.Reader
2import Test.Hspec 4import Test.Hspec
3import Data.BEncode as BE 5import Data.BEncode as BE
6import Data.Default
7import Data.List as L
4import Network.BitTorrent.Core 8import Network.BitTorrent.Core
5import Network.BitTorrent.DHT.Message 9import Network.BitTorrent.DHT.Message
10import Network.KRPC
11import Network.Socket (PortNumber)
6 12
7 13
14remoteAddr :: SockAddr
15remoteAddr = SockAddrInet 6881 (256 * 256 * 256 + 127)
16
17thisAddr :: SockAddr
18thisAddr = SockAddrInet 60000 (256 * 256 * 256 + 127)
19
20thisPort :: PortNumber
21thisPort = 60001
22
23rpc :: ReaderT (Manager IO) IO a -> IO a
24rpc action = do
25 withManager thisAddr [] $ runReaderT $ do
26 listen
27 action
28
29isProtocolError :: KError -> Bool
30isProtocolError KError {..} = errorCode == ProtocolError
31
8spec :: Spec 32spec :: Spec
9spec = do 33spec = do
34 context ("you need running DHT node at " ++ show remoteAddr) $ do
10 describe "ping" $ do 35 describe "ping" $ do
11 it "properly bencoded" $ do 36 it "properly bencoded" $ do
12 BE.decode "d2:id20:abcdefghij0123456789e" 37 BE.decode "d2:id20:abcdefghij0123456789e"
@@ -21,6 +46,14 @@ spec = do
21 BE.encode (Response "mnopqrstuvwxyz123456" Ping) 46 BE.encode (Response "mnopqrstuvwxyz123456" Ping)
22 `shouldBe` "d2:id20:mnopqrstuvwxyz123456e" 47 `shouldBe` "d2:id20:mnopqrstuvwxyz123456e"
23 48
49 it "properly bencoded (iso)" $ do
50 pending
51
52 it "does compatible with existing DHT" $ do
53 nid <- genNodeId
54 Response _remoteAddr Ping <- rpc (query remoteAddr (Query nid Ping))
55 return ()
56
24 describe "find_node" $ do 57 describe "find_node" $ do
25 it "properly bencoded" $ do 58 it "properly bencoded" $ do
26 BE.decode "d2:id20:abcdefghij0123456789\ 59 BE.decode "d2:id20:abcdefghij0123456789\
@@ -33,9 +66,58 @@ spec = do
33 `shouldBe` 66 `shouldBe`
34 "d2:id20:abcdefghij01234567896:target20:mnopqrstuvwxyz123456e" 67 "d2:id20:abcdefghij01234567896:target20:mnopqrstuvwxyz123456e"
35 68
36 let addr = "127.0.0.1:256" :: NodeAddr IPv4 69 let naddr = "127.0.0.1:258" :: NodeAddr IPv4
37 let nid = "0123456789abcdefghij" 70 let nid = "0123456789abcdefghij"
71 let nid' = "mnopqrstuvwxyz123456"
38 BE.decode "d2:id20:0123456789abcdefghij\ 72 BE.decode "d2:id20:0123456789abcdefghij\
39 \5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\&56\ 73 \5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\1\2\
40 \e" 74 \e"
41 `shouldBe` Right (Response nid (NodeFound [NodeInfo nid addr])) \ No newline at end of file 75 `shouldBe` Right (Response nid (NodeFound [NodeInfo nid' naddr]))
76
77 it "properly bencoded (iso)" $ do
78 pending
79
80 it "does compatible with existing DHT" $ do
81 nid <- genNodeId
82 Response _remoteAddr (NodeFound xs) <- rpc $ do
83 query remoteAddr (Query nid (FindNode nid))
84 L.length (xs :: [NodeInfo IPv4]) `shouldSatisfy` (> 0)
85
86 describe "get_peers" $ do
87 it "properly bencoded" $ do
88 pending
89
90 it "properly bencoded (iso)" $ do
91 pending
92
93 it "does compatible with existing DHT" $ do
94 nid <- genNodeId
95 Response _remoteId (GotPeers {..})
96 <- rpc $ query remoteAddr (Query nid (GetPeers def))
97 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
98 either L.length L.length peers `shouldSatisfy` (> 0)
99
100 describe "announce" $ do
101 it "properly bencoded" $ do
102 pending
103
104 it "properly bencoded (iso)" $ do
105 pending
106
107 it "does compatible with existing DHT" $ do
108 nid <- genNodeId
109 Response _remoteId Announced <- rpc $ do
110 Response _ GotPeers {..} <- query remoteAddr (Query nid (GetPeers def))
111 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
112 query remoteAddr (Query nid (Announce def thisPort grantedToken))
113 return ()
114
115 it "does fail on invalid token" $ do
116 nid <- genNodeId
117 (rpc $ do
118 Response _ GotPeers {..} <- query remoteAddr (Query nid (GetPeers def))
119 let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4]
120 let invalidToken = ""
121 query remoteAddr (Query nid (Announce def thisPort invalidToken)))
122 `shouldThrow` isProtocolError
123 return ()