summaryrefslogtreecommitdiff
path: root/tests/Network
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Network')
-rw-r--r--tests/Network/BitTorrent/CoreSpec.hs3
-rw-r--r--tests/Network/BitTorrent/DHT/MessageSpec.hs75
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.
2module Network.BitTorrent.CoreSpec (spec) where 2module Network.BitTorrent.CoreSpec (spec) where
3import Network.BitTorrent.Core.FingerprintSpec as CoreSpec ()
4import Network.BitTorrent.Core.NodeSpec as CoreSpec ()
3import Network.BitTorrent.Core.PeerIdSpec as CoreSpec () 5import Network.BitTorrent.Core.PeerIdSpec as CoreSpec ()
6import Network.BitTorrent.Core.PeerAddrSpec as CoreSpec ()
4 7
5import Test.Hspec (Spec) 8import 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 #-}
2module Network.BitTorrent.DHT.MessageSpec (spec) where 2module Network.BitTorrent.DHT.MessageSpec (spec) where
3import Control.Monad.Reader 3import Control.Monad.Reader
4import Test.Hspec
5import Data.BEncode as BE 4import Data.BEncode as BE
5import Data.ByteString.Lazy as BL
6import Data.Default 6import Data.Default
7import Data.List as L 7import Data.List as L
8import Network.BitTorrent.Core 8import Network.BitTorrent.Core
9import Network.BitTorrent.DHT.Message 9import Network.BitTorrent.DHT.Message
10import Network.KRPC 10import Network.KRPC
11import Network.Socket (PortNumber) 11import Network.Socket (PortNumber)
12import Test.Hspec
13import Test.QuickCheck
14
15import Network.BitTorrent.CoreSpec ()
16import Data.Torrent.InfoHashSpec ()
12 17
13 18
14remoteAddr :: SockAddr 19remoteAddr :: SockAddr
@@ -29,6 +34,9 @@ rpc action = do
29isProtocolError :: KError -> Bool 34isProtocolError :: KError -> Bool
30isProtocolError KError {..} = errorCode == ProtocolError 35isProtocolError KError {..} = errorCode == ProtocolError
31 36
37prop_bencode :: Eq a => Show a => BEncode a => a -> Expectation
38prop_bencode x = BE.decode (BL.toStrict (BE.encode x)) `shouldBe` Right x
39
32spec :: Spec 40spec :: Spec
33spec = do 41spec = 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