summaryrefslogtreecommitdiff
path: root/tests/Main.hs
blob: 6577e6f496f65cd36207304b24e359ab43c00122 (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
{-# LANGUAGE RecordWildCards #-}
module Main where
import Control.Exception
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import System.Exit
import System.Environment
import System.Process
import System.Directory
import Text.Printf

import Config
import Spec


type Command = String
type Descr = (ClientName, ClientOpts -> FilePath -> Command)

torrents :: [FilePath]
torrents =
    [ "dapper-dvd-amd64-iso.torrent"
    , "pkg.torrent"
    , "testfile.torrent"
    ]

clients :: [Descr]
clients =
  [ ("rtorrent"
    , \ ClientOpts {..} tfile -> printf
     "rtorrent -p %i-%i -O dht=on -O dht_port=%i -O session=rtorrent-sessiondir %s"
     (fromEnum peerPort) (fromEnum peerPort) (fromEnum nodePort) tfile
    )
  ]

sessionName :: String -- screen session name
sessionName = "bittorrent-testsuite"

setupEnv :: EnvOpts -> IO (Maybe ())
setupEnv EnvOpts {..}
  | Just client <- testClient
  , Just mkCmd  <- lookup client clients = do
    let runner = printf "screen -dm -S %s %s" sessionName
                 (mkCmd remoteOpts "testfile.torrent")
    dir <- getCurrentDirectory
    _   <- createProcess (shell runner) { cwd = Just (dir ++ "/res") }
    return (Just ())

  | Just client <- testClient = do
    printf "Bad client `%s`, use one of %s" client (show (fst <$> clients))
    return Nothing

  | isNothing testClient = do
    printf "Running without remote client"
    return (Just ())

terminateEnv :: IO ()
terminateEnv = do
  printf "closing screen session: %s" sessionName
  _ <- system (printf "screen -S %s -X quit" sessionName)
  return ()

runTestSuite :: [String] -> IO ExitCode
runTestSuite args = do
  printf "running hspec test suite with args: %s\n" (show args)
  catch (withArgs args hspecMain >> return ExitSuccess) return

main :: IO ()
main = do
  (envOpts, suiteArgs) <- getOpts
  running <- setupEnv     envOpts
  code    <- runTestSuite suiteArgs
  when (isJust running) $ do
    terminateEnv
  exitWith code