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
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Exception
import Control.Concurrent (killThread)
import Control.Concurrent.MVar
import Control.Monad
import Prelude hiding (catch)
import Network (withSocketsDo)
import Test.Framework (defaultMain, testGroup)
import System.Environment
import Snap.Http.Server.Config
import qualified Snap.Internal.Http.Parser.Tests
import qualified Snap.Internal.Http.Server.Tests
import qualified Snap.Internal.Http.Server.TimeoutManager.Tests
import qualified Test.Blackbox
ports :: Int -> [Int]
ports sp = [sp]
#ifdef OPENSSL
sslports :: Int -> [Maybe Int]
sslports sp = map Just [(sp + 100)]
#else
sslports :: Int -> [Maybe Int]
sslports _ = repeat Nothing
#endif
backends :: Int -> [(Int,Maybe Int)]
backends sp = zip (ports sp)
(sslports sp)
getStartPort :: IO Int
getStartPort = (liftM read (getEnv "STARTPORT") >>= evaluate)
`catch` \(_::SomeException) -> return 8111
main :: IO ()
main = withSocketsDo $ do
sp <- getStartPort
let bends = backends sp
tinfos <- forM bends $ \(port,sslport) ->
Test.Blackbox.startTestServer port sslport
defaultMain (tests ++ concatMap blackbox bends) `finally` do
mapM_ killThread $ map fst tinfos
mapM_ takeMVar $ map snd tinfos
where tests =
[ testGroup "Snap.Internal.Http.Parser.Tests"
Snap.Internal.Http.Parser.Tests.tests
, testGroup "Snap.Internal.Http.Server.Tests"
Snap.Internal.Http.Server.Tests.tests
, testGroup "Snap.Internal.Http.Server.TimeoutManager.Tests"
Snap.Internal.Http.Server.TimeoutManager.Tests.tests
]
blackbox (port, sslport) =
[ testGroup ("Test.Blackbox")
$ Test.Blackbox.tests port
, testGroup ("Test.Blackbox SSL")
$ Test.Blackbox.ssltests sslport
]
|
