summaryrefslogtreecommitdiff
path: root/tests/Network/BitTorrent/DHT/SessionSpec.hs
blob: 32e4c158d9fa4f858889b8417a47f9abe3dcbce5 (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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
{-# LANGUAGE ScopedTypeVariables #-}
module Network.BitTorrent.DHT.SessionSpec (spec) where
import Control.Applicative
import Control.Concurrent
import Control.Exception
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Conduit.Lazy
import Data.Default
import Data.List as L
import Test.Hspec
import Test.QuickCheck

import Network.BitTorrent.Address
import Network.BitTorrent.DHT
import Network.BitTorrent.DHT.Message
import Network.BitTorrent.DHT.Session
import Network.BitTorrent.DHT.Query

import Data.TorrentSpec ()
import Network.BitTorrent.CoreSpec ()
import Network.BitTorrent.DHT.TokenSpec ()


myAddr :: NodeAddr IPv4
myAddr = "127.0.0.1:60000"

simpleDHT :: DHT IPv4 a -> IO a
simpleDHT m =
  bracket (newNode defaultHandlers def myAddr nullLogger Nothing) closeNode $ \ node ->
    runDHT node m

isRight :: Either a b -> Bool
isRight (Left  _) = False
isRight (Right _) = True

isLeft :: Either a b -> Bool
isLeft = not . isRight

nullLogger :: LogFun
nullLogger _ _ _ _ = return ()

spec :: Spec
spec = do
  describe "session" $ do
    it "is active until closeNode called" $ do
      node <- newNode [] def myAddr nullLogger Nothing
      runDHT node monadActive `shouldReturn` True
      runDHT node monadActive `shouldReturn` True
      closeNode node
      runDHT node monadActive `shouldReturn` False

  describe "tokens" $ do
    it "should not complain about valid token" $
      property $ \ (addrs :: [NodeAddr IPv4]) -> do
        isOks <- simpleDHT $ do
          forM addrs $ \ addr -> do
            token <- grantToken addr
            checkToken addr token
        L.and isOks `shouldBe` True

    it "should complain about invalid token" $
      property $ \ (addr :: NodeAddr IPv4) token -> do
        isOk <- simpleDHT (checkToken addr token)
        isOk `shouldBe` False

  describe "routing table" $
    it "accept any node entry when table is empty" $
      property $ \ (nid :: NodeId) -> do
        let info = NodeInfo nid myAddr
        closest <- simpleDHT $ do
           _ <- insertNode info Nothing
           liftIO $ yield
           getClosest nid
        closest `shouldSatisfy` L.elem info

  describe "peer storage" $ do
    it "should return nodes, if there are no peers" $ property $ \ ih -> do
      res <- simpleDHT $ do getPeerList ih
      res `shouldSatisfy` isLeft

    it "should return peers, if any" $ property $ \ ih addr -> do
      res <- simpleDHT $ do
                 insertPeer ih addr
                 getPeerList ih
      res `shouldSatisfy` isRight

  describe "topic storage" $ do
    it "should not grow indefinitely" $ do
      pending

  describe "messaging" $ do
    describe "queryNode" $ do
      it "should always ping this node" $ do
        (rid, tid) <- simpleDHT $ do
          (remoteId, Ping) <- queryNode myAddr Ping
          thisId <- myNodeIdAccordingTo (read "8.8.8.8:6881")
          return (remoteId, thisId)
        rid `shouldBe` tid

    describe "queryParallel" $ do
      it "should handle parallel requests" $ do
        (nid, resps) <- simpleDHT $ do
          me <- myNodeIdAccordingTo (read "8.8.8.8:6881")
          ( (,) me ) <$> queryParallel (L.replicate 100 $ queryNode myAddr Ping)
        resps `shouldSatisfy` L.all (== (nid, Ping))

    describe "(<@>) operator" $ do
      it "" $
         pending