blob: c21f55efdbd85cd298cba2c2b03caf36ea99b254 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.BitTorrent.Exchange.ConnectionSpec (spec) where
import Control.Applicative
import Control.Monad.Trans
import Data.Default
import Test.Hspec
import Test.QuickCheck
import Data.Torrent
import Data.Torrent.InfoHash
import Network.BitTorrent.Core
import Network.BitTorrent.Exchange.Connection
import Network.BitTorrent.Exchange.Message
import Config
import Network.BitTorrent.Exchange.MessageSpec ()
nullSession :: InfoHash -> PeerId -> SessionLink ()
nullSession ih pid = SessionLink ih pid Nothing Nothing ()
instance Arbitrary Options where
arbitrary = return def
instance Arbitrary ConnectionPrefs where
arbitrary = ConnectionPrefs <$> arbitrary <*> pure def
<*> arbitrary <*> arbitrary
withWire :: ConnectionPrefs -> Wire () () -> IO ()
withWire prefs wire =
withRemote $ \ ClientOpts {..} -> do
pid <- genPeerId
t <- getTestTorrent
let ih = idInfoHash (tInfoDict t)
let cfg = ConnectionConfig prefs (nullSession ih pid) (wire)
let addr = PeerAddr Nothing "127.0.0.1" peerPort
connectWire addr cfg
spec :: Spec
spec = do
describe "connectWire" $ do
it "can establish connection with all possible preferences" $
property $ \ prefs -> do
withWire prefs (return ())
it "must not connect with invalid topic" $ do
pending
describe "acceptWire" $ do
it "" $ do
pending
describe "messaging" $ do
it "first message is bitfield" $ do
withWire def $ do
msg <- recvMessage
let isBitfield (Available (Bitfield _)) = True
isBitfield _ = False
liftIO $ msg `shouldSatisfy` isBitfield
|
