diff options
author | joe <joe@jerkface.net> | 2017-09-15 06:22:10 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-09-15 06:22:10 -0400 |
commit | 12cbb3af2413dc28838ed271351dda16df8f7bdb (patch) | |
tree | 2db77a787e18a81a8369a8d73fee369d8826f064 /bittorrent/tests/Network/BitTorrent/DHT/MessageSpec.hs | |
parent | 362357c6d08cbd8dffa627a1e80199dcb9ba231f (diff) |
Separating dht-client library from bittorrent package.
Diffstat (limited to 'bittorrent/tests/Network/BitTorrent/DHT/MessageSpec.hs')
-rw-r--r-- | bittorrent/tests/Network/BitTorrent/DHT/MessageSpec.hs | 221 |
1 files changed, 221 insertions, 0 deletions
diff --git a/bittorrent/tests/Network/BitTorrent/DHT/MessageSpec.hs b/bittorrent/tests/Network/BitTorrent/DHT/MessageSpec.hs new file mode 100644 index 00000000..6f3c7489 --- /dev/null +++ b/bittorrent/tests/Network/BitTorrent/DHT/MessageSpec.hs | |||
@@ -0,0 +1,221 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
2 | module Network.BitTorrent.DHT.MessageSpec (spec) where | ||
3 | import Control.Monad.Reader | ||
4 | import Control.Monad.Logger | ||
5 | import Control.Concurrent | ||
6 | import Data.BEncode as BE | ||
7 | import Data.ByteString.Lazy as BL | ||
8 | import Data.Default | ||
9 | import Data.List as L | ||
10 | import Data.Maybe | ||
11 | import Network.BitTorrent.Address | ||
12 | import Network.BitTorrent.DHT.Message | ||
13 | import qualified Network.KRPC as KRPC (def) | ||
14 | import Network.KRPC hiding (def) | ||
15 | import Network.Socket (PortNumber) | ||
16 | import Test.Hspec | ||
17 | import Test.QuickCheck | ||
18 | import System.Timeout | ||
19 | |||
20 | import Data.TorrentSpec () | ||
21 | import Network.BitTorrent.CoreSpec () | ||
22 | import Network.BitTorrent.DHT.TokenSpec () | ||
23 | |||
24 | -- Arbitrary queries and responses. | ||
25 | instance Arbitrary Ping where arbitrary = pure Ping | ||
26 | instance Arbitrary FindNode where arbitrary = FindNode <$> arbitrary | ||
27 | instance Arbitrary ip => Arbitrary (NodeFound ip) where arbitrary = NodeFound <$> arbitrary | ||
28 | instance Arbitrary GetPeers where arbitrary = GetPeers <$> arbitrary | ||
29 | instance Arbitrary ip => Arbitrary (GotPeers ip) where arbitrary = GotPeers <$> arbitrary <*> arbitrary | ||
30 | instance Arbitrary Announce where arbitrary = Announce <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary | ||
31 | instance Arbitrary Announced where arbitrary = pure Announced | ||
32 | instance Arbitrary x => Arbitrary (Query x) where arbitrary = Query <$> arbitrary <*> arbitrary <*> arbitrary | ||
33 | instance Arbitrary x => Arbitrary (Response x) where arbitrary = Response <$> arbitrary <*> arbitrary | ||
34 | |||
35 | instance MonadLogger IO where | ||
36 | monadLoggerLog _ _ _ _ = return () | ||
37 | |||
38 | remoteAddr :: SockAddr | ||
39 | remoteAddr = SockAddrInet 6881 (256 * 256 * 256 + 127) | ||
40 | |||
41 | thisAddr :: SockAddr | ||
42 | thisAddr = SockAddrInet 60000 (256 * 256 * 256 + 127) | ||
43 | |||
44 | thisPort :: PortNumber | ||
45 | thisPort = 60001 | ||
46 | |||
47 | rpc :: ReaderT (Manager IO) IO a -> IO a | ||
48 | rpc action = do | ||
49 | withManager KRPC.def thisAddr [] $ runReaderT $ do | ||
50 | listen | ||
51 | action | ||
52 | |||
53 | isQueryError :: QueryFailure -> Bool | ||
54 | isQueryError _ = True | ||
55 | |||
56 | prop_bencode :: Eq a => Show a => BEncode a => a -> Expectation | ||
57 | prop_bencode x = BE.decode (BL.toStrict (BE.encode x)) `shouldBe` Right x | ||
58 | |||
59 | retry :: Int -> IO (Maybe a) -> IO (Maybe a) | ||
60 | retry 0 _ = return Nothing | ||
61 | retry n a = do | ||
62 | res <- a | ||
63 | case res of | ||
64 | Just _ -> return res | ||
65 | Nothing -> threadDelay (100 * 1000) >> retry (n-1) a | ||
66 | |||
67 | spec :: Spec | ||
68 | spec = do | ||
69 | context ("you need running DHT node at " ++ show remoteAddr) $ do | ||
70 | it "is running" $ do | ||
71 | running <- retry 5 $ timeout (100 * 1000) $ do | ||
72 | nid <- genNodeId | ||
73 | Response _remoteAddr Ping <- | ||
74 | rpc (query remoteAddr (Query nid False Ping)) | ||
75 | return () | ||
76 | running `shouldSatisfy` isJust | ||
77 | |||
78 | describe "ping" $ do | ||
79 | it "properly bencoded" $ do | ||
80 | BE.decode "d2:id20:abcdefghij0123456789e" | ||
81 | `shouldBe` Right (Query "abcdefghij0123456789" False Ping) | ||
82 | |||
83 | BE.encode (Query "abcdefghij0123456789" False Ping) | ||
84 | `shouldBe` "d2:id20:abcdefghij0123456789e" | ||
85 | |||
86 | BE.decode "d2:id20:mnopqrstuvwxyz123456e" | ||
87 | `shouldBe` Right (Response "mnopqrstuvwxyz123456" Ping) | ||
88 | |||
89 | BE.encode (Response "mnopqrstuvwxyz123456" Ping) | ||
90 | `shouldBe` "d2:id20:mnopqrstuvwxyz123456e" | ||
91 | |||
92 | it "properly bencoded (iso)" $ property $ \ nid -> do | ||
93 | prop_bencode (Query nid False Ping) | ||
94 | prop_bencode (Response nid Ping) | ||
95 | |||
96 | it "does compatible with existing DHT" $ do | ||
97 | nid <- genNodeId | ||
98 | Response _remoteAddr Ping <- rpc (query remoteAddr (Query nid False Ping)) | ||
99 | return () | ||
100 | |||
101 | describe "find_node" $ do | ||
102 | it "properly bencoded" $ do | ||
103 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
104 | \6:target20:mnopqrstuvwxyz123456e" | ||
105 | `shouldBe` Right (Query "abcdefghij0123456789" False | ||
106 | (FindNode "mnopqrstuvwxyz123456")) | ||
107 | |||
108 | BE.encode (Query "abcdefghij0123456789" False | ||
109 | (FindNode "mnopqrstuvwxyz123456")) | ||
110 | `shouldBe` | ||
111 | "d2:id20:abcdefghij01234567896:target20:mnopqrstuvwxyz123456e" | ||
112 | |||
113 | let naddr = "127.0.0.1:258" :: NodeAddr IPv4 | ||
114 | let nid = "0123456789abcdefghij" | ||
115 | let nid' = "mnopqrstuvwxyz123456" | ||
116 | BE.decode "d2:id20:0123456789abcdefghij\ | ||
117 | \5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\1\2\ | ||
118 | \e" | ||
119 | `shouldBe` Right (Response nid (NodeFound [NodeInfo nid' naddr])) | ||
120 | |||
121 | it "properly bencoded (iso)" $ property $ \ nid x xs -> do | ||
122 | prop_bencode (Query nid False (FindNode x)) | ||
123 | prop_bencode (Response nid (NodeFound (xs :: [NodeInfo IPv4] ))) | ||
124 | |||
125 | it "does compatible with existing DHT" $ do | ||
126 | nid <- genNodeId | ||
127 | Response _remoteAddr (NodeFound xs) <- rpc $ do | ||
128 | query remoteAddr (Query nid False (FindNode nid)) | ||
129 | L.length (xs :: [NodeInfo IPv4]) `shouldSatisfy` (> 0) | ||
130 | |||
131 | describe "get_peers" $ do | ||
132 | it "properly bencoded" $ do | ||
133 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
134 | \9:info_hash20:mnopqrstuvwxyz123456\ | ||
135 | \e" | ||
136 | `shouldBe` Right (Query "abcdefghij0123456789" False | ||
137 | (GetPeers "mnopqrstuvwxyz123456")) | ||
138 | |||
139 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
140 | \5:token8:aoeusnth\ | ||
141 | \6:valuesl6:\127\0\0\1\1\2\&6:\192\168\1\100\1\2e\ | ||
142 | \e" | ||
143 | `shouldBe` Right (Response "abcdefghij0123456789" | ||
144 | (GotPeers (Right [ "127.0.0.1:258" :: PeerAddr IPv4 | ||
145 | , "192.168.1.100:258" | ||
146 | ]) "aoeusnth")) | ||
147 | |||
148 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
149 | \5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\1\2\ | ||
150 | \5:token8:aoeusnth\ | ||
151 | \e" | ||
152 | `shouldBe` Right (Response "abcdefghij0123456789" | ||
153 | (GotPeers | ||
154 | { peers = Left [NodeInfo "mnopqrstuvwxyz123456" "127.0.0.1:258" | ||
155 | :: NodeInfo IPv4] | ||
156 | , grantedToken = "aoeusnth" | ||
157 | })) | ||
158 | |||
159 | it "properly bencoded (iso)" $ property $ \ nid topic exs token -> do | ||
160 | prop_bencode (Query nid False (GetPeers topic)) | ||
161 | let _ = exs :: Either [NodeInfo IPv4] [PeerAddr IPv4] | ||
162 | let nullPeerId paddr = paddr {peerId = Nothing} | ||
163 | let nullPeerIds = either Left (Right . L.map nullPeerId) | ||
164 | prop_bencode (Response nid (GotPeers (nullPeerIds exs) token)) | ||
165 | |||
166 | it "does compatible with existing DHT" $ do | ||
167 | nid <- genNodeId | ||
168 | Response _remoteId (GotPeers {..}) | ||
169 | <- rpc $ query remoteAddr (Query nid False (GetPeers def)) | ||
170 | let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4] | ||
171 | either L.length L.length peers `shouldSatisfy` (> 0) | ||
172 | |||
173 | describe "announce" $ do | ||
174 | it "properly bencoded" $ do | ||
175 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
176 | \9:info_hash20:mnopqrstuvwxyz123456\ | ||
177 | \4:porti6881e\ | ||
178 | \5:token8:aoeusnth\ | ||
179 | \e" `shouldBe` Right | ||
180 | (Query "abcdefghij0123456789" False | ||
181 | (Announce False "mnopqrstuvwxyz123456" Nothing 6881 "aoeusnth")) | ||
182 | |||
183 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
184 | \12:implied_porti1e\ | ||
185 | \9:info_hash20:mnopqrstuvwxyz123456\ | ||
186 | \4:porti6881e\ | ||
187 | \5:token8:aoeusnth\ | ||
188 | \e" `shouldBe` Right | ||
189 | (Query "abcdefghij0123456789" False | ||
190 | (Announce True "mnopqrstuvwxyz123456" Nothing 6881 "aoeusnth")) | ||
191 | |||
192 | |||
193 | BE.decode "d2:id20:mnopqrstuvwxyz123456e" | ||
194 | `shouldBe` Right | ||
195 | (Response "mnopqrstuvwxyz123456" Announced) | ||
196 | |||
197 | it "properly bencoded (iso)" $ property $ \ nid flag topic port token -> do | ||
198 | prop_bencode (Query nid False (Announce flag topic Nothing port token)) | ||
199 | prop_bencode (Response nid (Announced)) | ||
200 | |||
201 | |||
202 | it "does compatible with existing DHT" $ do | ||
203 | nid <- genNodeId | ||
204 | Response _remoteId Announced <- rpc $ do | ||
205 | Response _ GotPeers {..} <- query remoteAddr (Query nid False (GetPeers def)) | ||
206 | let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4] | ||
207 | query remoteAddr (Query nid False (Announce False def Nothing thisPort grantedToken)) | ||
208 | return () | ||
209 | |||
210 | it "does fail on invalid token" $ do | ||
211 | nid <- genNodeId | ||
212 | (rpc $ do | ||
213 | Response _ GotPeers {..} <- query remoteAddr (Query nid False (GetPeers def)) | ||
214 | let _ = peers :: Either [NodeInfo IPv4] [PeerAddr IPv4] | ||
215 | let invalidToken = "" | ||
216 | let q :: MonadKRPC h m => SockAddr -> Query Announce | ||
217 | -> m (Response Announced) | ||
218 | q = query | ||
219 | q remoteAddr (Query nid False (Announce False def Nothing thisPort invalidToken))) | ||
220 | `shouldThrow` isQueryError | ||
221 | return () | ||