Separating dht-client library from bittorrent package.

1 files changed, 97 insertions, 0 deletions

diff --git a/bittorrent/tests/Main.hs b/bittorrent/tests/Main.hs
new file mode 100644
index 00000000..5ed953da
--- /dev/null
+++ b/bittorrent/tests/Main.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE RecordWildCards #-}
+module Main where
+import Control.Exception
+import Control.Monad
+import Data.Functor
+import Data.Maybe
+import System.Directory
+import System.Exit
+import System.Environment
+import System.FilePath
+import System.Process
+import Text.Printf
+import Test.Hspec
+
+import Config
+import qualified Spec as Generated
+
+
+type Command = String
+type Descr = (ClientName, ClientOpts -> FilePath -> Command)
+
+torrents :: [FilePath]
+torrents =
+    [ "dapper-dvd-amd64-iso.torrent"
+    , "pkg.torrent"
+    , "testfile.torrent"
+    ]
+
+rtorrentSessionDir :: String
+rtorrentSessionDir = "rtorrent-sessiondir"
+
+sessionName :: String -- screen session name
+sessionName = "bittorrent-testsuite"
+
+tmpDir :: FilePath
+tmpDir = "res"
+
+clients :: [Descr]
+clients =
+  [ ("rtorrent"
+    , \ ClientOpts {..} tfile -> printf
+     "rtorrent -p %i-%i -O dht=on -O dht_port=%i -O session=%s %s"
+     (fromEnum peerPort) (fromEnum peerPort) (fromEnum nodePort)
+      rtorrentSessionDir tfile
+    )
+  ]
+
+setupEnv :: EnvOpts -> IO (Maybe ())
+setupEnv EnvOpts {..}
+  | Just client <- testClient
+  , Just mkCmd  <- lookup client clients = do
+    _ <- printf "Setting up %s\n" client
+
+    let torrentPath = "testfile.torrent"
+    let runner = printf "screen -dm -S %s %s" sessionName
+                 (mkCmd remoteOpts torrentPath)
+
+    wd <- getCurrentDirectory
+    createDirectoryIfMissing True (wd </> tmpDir </> rtorrentSessionDir)
+    _ <- createProcess (shell runner) { cwd = Just (wd </> tmpDir) }
+
+    return (Just ())
+
+  | Just client <- testClient = do
+    _ <- printf "Bad client `%s`, use one of %s\n" client (show (fst <$> clients))
+    return Nothing
+
+  | otherwise = do
+    _ <- printf "Running without remote client\n"
+    return (Just ())
+
+terminateEnv :: IO ()
+terminateEnv = do
+  wd <- getCurrentDirectory
+  removeDirectoryRecursive (wd </> tmpDir </> rtorrentSessionDir)
+  _ <- printf "closing screen session: %s\n" 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 (hspec Generated.spec) >> return ExitSuccess) return
+
+withEnv :: EnvOpts -> IO a -> IO a
+withEnv opts action = bracket (setupEnv opts) terminate (const action)
+  where
+    terminate running = do
+      when (isJust running) $ do
+        terminateEnv
+
+main :: IO ()
+main = do
+  (envOpts, suiteArgs) <- getOpts
+  withEnv envOpts $ do
+    code    <- runTestSuite suiteArgs
+    exitWith code