summaryrefslogtreecommitdiff
path: root/bittorrent/bench/Throughtput.hs
blob: d040440516ce458ccfcd64ed9600fa0bd3918383 (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
{-# LANGUAGE ViewPatterns  #-}
{-# LANGUAGE PatternGuards #-}
module Main (main) where

import Control.Concurrent
import Data.Bitfield
import Network.BitTorrent
import System.Environment
import Control.Monad.Reader
import Data.IORef


main :: IO ()
main = do
  [path]  <- getArgs
  torrent <- fromFile path

  print (contentLayout "./" (tInfo torrent))

  client  <- newClient 100 []
  swarm   <- newLeecher  client torrent

  ref <- liftIO $ newIORef 0
  discover swarm $ do
    forever $ do
      e <- awaitEvent
      case e of
        Available bf
          | Just m <- findMin bf -> yieldEvent (Want (BlockIx m 0 10))
          |     otherwise        -> return ()
        Want     bix -> liftIO $ print bix
        Fragment blk -> do

          sc <- liftIO $ getSessionCount swarm
          addr <- asks connectedPeerAddr

          liftIO $ do
            x <- atomicModifyIORef ref (\x -> (succ x, x))
            if x `mod` 100 == 0
              then print (x, sc, addr)
              else return ()

          yieldEvent (Want (BlockIx 0 0 (16 * 1024)))


  print "Bye-bye! =_="