diff options
-rw-r--r-- | bittorrent.cabal | 1 | ||||
-rw-r--r-- | tests/Network/BitTorrent/Exchange/WireSpec.hs | 59 |
2 files changed, 60 insertions, 0 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal index e6a6db93..303e93c6 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal | |||
@@ -210,6 +210,7 @@ test-suite spec | |||
210 | Network.BitTorrent.Tracker.RPC.UDPSpec | 210 | Network.BitTorrent.Tracker.RPC.UDPSpec |
211 | Network.BitTorrent.Tracker.SessionSpec | 211 | Network.BitTorrent.Tracker.SessionSpec |
212 | Network.BitTorrent.Exchange.MessageSpec | 212 | Network.BitTorrent.Exchange.MessageSpec |
213 | Network.BitTorrent.Exchange.WireSpec | ||
213 | System.Torrent.StorageSpec | 214 | System.Torrent.StorageSpec |
214 | System.Torrent.FileMapSpec | 215 | System.Torrent.FileMapSpec |
215 | build-depends: base == 4.* | 216 | build-depends: base == 4.* |
diff --git a/tests/Network/BitTorrent/Exchange/WireSpec.hs b/tests/Network/BitTorrent/Exchange/WireSpec.hs new file mode 100644 index 00000000..550c20f9 --- /dev/null +++ b/tests/Network/BitTorrent/Exchange/WireSpec.hs | |||
@@ -0,0 +1,59 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
2 | {-# OPTIONS_GHC -fno-warn-orphans #-} | ||
3 | module Network.BitTorrent.Exchange.WireSpec (spec) where | ||
4 | import Control.Applicative | ||
5 | import Control.Monad.Trans | ||
6 | import Data.Default | ||
7 | import Test.Hspec | ||
8 | import Test.QuickCheck | ||
9 | |||
10 | import Data.Torrent | ||
11 | import Data.Torrent.InfoHash | ||
12 | import Network.BitTorrent.Core | ||
13 | import Network.BitTorrent.Exchange.Message | ||
14 | import Network.BitTorrent.Exchange.Wire | ||
15 | |||
16 | import Config | ||
17 | import Network.BitTorrent.Exchange.MessageSpec () | ||
18 | |||
19 | nullSession :: InfoHash -> PeerId -> ConnectionSession () | ||
20 | nullSession ih pid = ConnectionSession ih pid Nothing Nothing () | ||
21 | |||
22 | instance Arbitrary Options where | ||
23 | arbitrary = return def | ||
24 | |||
25 | instance Arbitrary ConnectionPrefs where | ||
26 | arbitrary = ConnectionPrefs <$> arbitrary <*> pure def | ||
27 | <*> arbitrary <*> arbitrary | ||
28 | |||
29 | withWire :: ConnectionPrefs -> Wire () () -> IO () | ||
30 | withWire prefs wire = | ||
31 | withRemote $ \ ClientOpts {..} -> do | ||
32 | pid <- genPeerId | ||
33 | t <- getTestTorrent | ||
34 | let ih = idInfoHash (tInfoDict t) | ||
35 | let cfg = ConnectionConfig prefs (nullSession ih pid) (wire) | ||
36 | let addr = PeerAddr Nothing "127.0.0.1" peerPort | ||
37 | connectWire addr cfg | ||
38 | |||
39 | spec :: Spec | ||
40 | spec = do | ||
41 | describe "connectWire" $ do | ||
42 | it "can establish connection with all possible preferences" $ | ||
43 | property $ \ prefs -> do | ||
44 | withWire prefs (return ()) | ||
45 | |||
46 | it "must not connect with invalid topic" $ do | ||
47 | pending | ||
48 | |||
49 | describe "acceptWire" $ do | ||
50 | it "" $ do | ||
51 | pending | ||
52 | |||
53 | describe "messaging" $ do | ||
54 | it "first message is bitfield" $ do | ||
55 | withWire def $ do | ||
56 | msg <- recvMessage | ||
57 | let isBitfield (Available (Bitfield _)) = True | ||
58 | isBitfield _ = False | ||
59 | liftIO $ msg `shouldSatisfy` isBitfield | ||