diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/Network/BitTorrent/CoreSpec.hs | 3 | ||||
-rw-r--r-- | tests/Network/BitTorrent/DHT/MessageSpec.hs | 75 |
2 files changed, 66 insertions, 12 deletions
diff --git a/tests/Network/BitTorrent/CoreSpec.hs b/tests/Network/BitTorrent/CoreSpec.hs index 917ed5f5..9f9eb0eb 100644 --- a/tests/Network/BitTorrent/CoreSpec.hs +++ b/tests/Network/BitTorrent/CoreSpec.hs | |||
@@ -1,6 +1,9 @@ | |||
1 | -- | Re-export modules. | 1 | -- | Re-export modules. |
2 | module Network.BitTorrent.CoreSpec (spec) where | 2 | module Network.BitTorrent.CoreSpec (spec) where |
3 | import Network.BitTorrent.Core.FingerprintSpec as CoreSpec () | ||
4 | import Network.BitTorrent.Core.NodeSpec as CoreSpec () | ||
3 | import Network.BitTorrent.Core.PeerIdSpec as CoreSpec () | 5 | import Network.BitTorrent.Core.PeerIdSpec as CoreSpec () |
6 | import Network.BitTorrent.Core.PeerAddrSpec as CoreSpec () | ||
4 | 7 | ||
5 | import Test.Hspec (Spec) | 8 | import Test.Hspec (Spec) |
6 | 9 | ||
diff --git a/tests/Network/BitTorrent/DHT/MessageSpec.hs b/tests/Network/BitTorrent/DHT/MessageSpec.hs index 9f4c58b0..52bda932 100644 --- a/tests/Network/BitTorrent/DHT/MessageSpec.hs +++ b/tests/Network/BitTorrent/DHT/MessageSpec.hs | |||
@@ -1,14 +1,19 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | module Network.BitTorrent.DHT.MessageSpec (spec) where | 2 | module Network.BitTorrent.DHT.MessageSpec (spec) where |
3 | import Control.Monad.Reader | 3 | import Control.Monad.Reader |
4 | import Test.Hspec | ||
5 | import Data.BEncode as BE | 4 | import Data.BEncode as BE |
5 | import Data.ByteString.Lazy as BL | ||
6 | import Data.Default | 6 | import Data.Default |
7 | import Data.List as L | 7 | import Data.List as L |
8 | import Network.BitTorrent.Core | 8 | import Network.BitTorrent.Core |
9 | import Network.BitTorrent.DHT.Message | 9 | import Network.BitTorrent.DHT.Message |
10 | import Network.KRPC | 10 | import Network.KRPC |
11 | import Network.Socket (PortNumber) | 11 | import Network.Socket (PortNumber) |
12 | import Test.Hspec | ||
13 | import Test.QuickCheck | ||
14 | |||
15 | import Network.BitTorrent.CoreSpec () | ||
16 | import Data.Torrent.InfoHashSpec () | ||
12 | 17 | ||
13 | 18 | ||
14 | remoteAddr :: SockAddr | 19 | remoteAddr :: SockAddr |
@@ -29,6 +34,9 @@ rpc action = do | |||
29 | isProtocolError :: KError -> Bool | 34 | isProtocolError :: KError -> Bool |
30 | isProtocolError KError {..} = errorCode == ProtocolError | 35 | isProtocolError KError {..} = errorCode == ProtocolError |
31 | 36 | ||
37 | prop_bencode :: Eq a => Show a => BEncode a => a -> Expectation | ||
38 | prop_bencode x = BE.decode (BL.toStrict (BE.encode x)) `shouldBe` Right x | ||
39 | |||
32 | spec :: Spec | 40 | spec :: Spec |
33 | spec = do | 41 | spec = do |
34 | context ("you need running DHT node at " ++ show remoteAddr) $ do | 42 | context ("you need running DHT node at " ++ show remoteAddr) $ do |
@@ -46,8 +54,9 @@ spec = do | |||
46 | BE.encode (Response "mnopqrstuvwxyz123456" Ping) | 54 | BE.encode (Response "mnopqrstuvwxyz123456" Ping) |
47 | `shouldBe` "d2:id20:mnopqrstuvwxyz123456e" | 55 | `shouldBe` "d2:id20:mnopqrstuvwxyz123456e" |
48 | 56 | ||
49 | it "properly bencoded (iso)" $ do | 57 | it "properly bencoded (iso)" $ property $ \ nid -> do |
50 | pending | 58 | prop_bencode (Query nid Ping) |
59 | prop_bencode (Response nid Ping) | ||
51 | 60 | ||
52 | it "does compatible with existing DHT" $ do | 61 | it "does compatible with existing DHT" $ do |
53 | nid <- genNodeId | 62 | nid <- genNodeId |
@@ -74,8 +83,9 @@ spec = do | |||
74 | \e" | 83 | \e" |
75 | `shouldBe` Right (Response nid (NodeFound [NodeInfo nid' naddr])) | 84 | `shouldBe` Right (Response nid (NodeFound [NodeInfo nid' naddr])) |
76 | 85 | ||
77 | it "properly bencoded (iso)" $ do | 86 | it "properly bencoded (iso)" $ property $ \ nid x xs -> do |
78 | pending | 87 | prop_bencode (Query nid (FindNode x)) |
88 | prop_bencode (Response nid (NodeFound (xs :: [NodeInfo IPv4] ))) | ||
79 | 89 | ||
80 | it "does compatible with existing DHT" $ do | 90 | it "does compatible with existing DHT" $ do |
81 | nid <- genNodeId | 91 | nid <- genNodeId |
@@ -85,10 +95,38 @@ spec = do | |||
85 | 95 | ||
86 | describe "get_peers" $ do | 96 | describe "get_peers" $ do |
87 | it "properly bencoded" $ do | 97 | it "properly bencoded" $ do |
88 | pending | 98 | BE.decode "d2:id20:abcdefghij0123456789\ |
89 | 99 | \9:info_hash20:mnopqrstuvwxyz123456\ | |
90 | it "properly bencoded (iso)" $ do | 100 | \e" |
91 | pending | 101 | `shouldBe` Right (Query "abcdefghij0123456789" |
102 | (GetPeers "mnopqrstuvwxyz123456")) | ||
103 | |||
104 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
105 | \5:token8:aoeusnth\ | ||
106 | \6:valuesl6:\127\0\0\1\1\2\&6:\192\168\1\100\1\2e\ | ||
107 | \e" | ||
108 | `shouldBe` Right (Response "abcdefghij0123456789" | ||
109 | (GotPeers (Right [ "127.0.0.1:258" :: PeerAddr IPv4 | ||
110 | , "192.168.1.100:258" | ||
111 | ]) "aoeusnth")) | ||
112 | |||
113 | BE.decode "d2:id20:abcdefghij0123456789\ | ||
114 | \5:nodes26:mnopqrstuvwxyz123456\127\0\0\1\1\2\ | ||
115 | \5:token8:aoeusnth\ | ||
116 | \e" | ||
117 | `shouldBe` Right (Response "abcdefghij0123456789" | ||
118 | (GotPeers | ||
119 | { peers = Left [NodeInfo "mnopqrstuvwxyz123456" "127.0.0.1:258" | ||
120 | :: NodeInfo IPv4] | ||
121 | , grantedToken = "aoeusnth" | ||
122 | })) | ||
123 | |||
124 | it "properly bencoded (iso)" $ property $ \ nid topic exs token -> do | ||
125 | prop_bencode (Query nid (GetPeers topic)) | ||
126 | let _ = exs :: Either [NodeInfo IPv4] [PeerAddr IPv4] | ||
127 | let nullPeerId paddr = paddr {peerId = Nothing} | ||
128 | let nullPeerIds = either Left (Right . L.map nullPeerId) | ||
129 | prop_bencode (Response nid (GotPeers (nullPeerIds exs) token)) | ||
92 | 130 | ||
93 | it "does compatible with existing DHT" $ do | 131 | it "does compatible with existing DHT" $ do |
94 | nid <- genNodeId | 132 | nid <- genNodeId |
@@ -99,10 +137,23 @@ spec = do | |||
99 | 137 | ||
100 | describe "announce" $ do | 138 | describe "announce" $ do |
101 | it "properly bencoded" $ do | 139 | it "properly bencoded" $ do |
102 | pending | 140 | BE.decode "d2:id20:abcdefghij0123456789\ |
141 | \9:info_hash20:mnopqrstuvwxyz123456\ | ||
142 | \4:porti6881e\ | ||
143 | \5:token8:aoeusnth\ | ||
144 | \e" `shouldBe` Right | ||
145 | (Query "abcdefghij0123456789" | ||
146 | (Announce "mnopqrstuvwxyz123456" 6881 "aoeusnth")) | ||
147 | |||
148 | |||
149 | BE.decode "d2:id20:mnopqrstuvwxyz123456e" | ||
150 | `shouldBe` Right | ||
151 | (Response "mnopqrstuvwxyz123456" Announced) | ||
152 | |||
153 | it "properly bencoded (iso)" $ property $ \ nid topic port token -> do | ||
154 | prop_bencode (Query nid (Announce topic port token)) | ||
155 | prop_bencode (Response nid (Announced)) | ||
103 | 156 | ||
104 | it "properly bencoded (iso)" $ do | ||
105 | pending | ||
106 | 157 | ||
107 | it "does compatible with existing DHT" $ do | 158 | it "does compatible with existing DHT" $ do |
108 | nid <- genNodeId | 159 | nid <- genNodeId |