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
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Control.Concurrent (killThread, takeMVar)
import qualified Control.Exception as E
import Control.Monad (liftM)
import Data.Maybe (maybeToList)
#if !MIN_VERSION_network(2,7,0)
import Network (withSocketsDo)
#endif
import System.Environment
import Test.Framework (defaultMain, testGroup)
------------------------------------------------------------------------------
import qualified Snap.Internal.Http.Server.TLS as TLS
------------------------------------------------------------------------------
import qualified Snap.Internal.Http.Server.Address.Tests as Address
import qualified Snap.Internal.Http.Server.Parser.Tests as Parser
import qualified Snap.Internal.Http.Server.Session.Tests as Session
import qualified Snap.Internal.Http.Server.Socket.Tests as Socket
import qualified Snap.Internal.Http.Server.TimeoutManager.Tests as TimeoutManager
import Snap.Test.Common (eatException)
#ifdef HAS_SENDFILE
import qualified System.SendFile.Tests as SendFile
#endif
import qualified Test.Blackbox
#if MIN_VERSION_network(2,7,0)
withSocketsDo :: IO a -> IO a
withSocketsDo = id
#endif
------------------------------------------------------------------------------
main :: IO ()
main = withSocketsDo $ TLS.withTLS $ eatException $
E.bracket (Test.Blackbox.startTestServers)
cleanup
(\tinfos -> do
let blackboxTests = bbox tinfos
defaultMain $ tests ++ blackboxTests
)
where
cleanup (x, y, m) = do
let backends = [x, y] ++ maybeToList m
mapM_ (killThread . (\(a, _, _) -> a)) backends
mapM_ (takeMVar . (\(_, _, a) -> a)) backends
bbox ((_, port, _), (_, port2, _), m) =
[ testGroup "Blackbox" $
concat [ Test.Blackbox.tests port
, Test.Blackbox.haTests port2
, Test.Blackbox.ssltests $ fmap (\(_,x,_) -> x) m
]
]
tests = [ testGroup "Address" Address.tests
, testGroup "Parser" Parser.tests
#ifdef HAS_SENDFILE
, testGroup "SendFile" SendFile.tests
#endif
, testGroup "Server" Session.tests
, testGroup "Socket" Socket.tests
, testGroup "TimeoutManager" TimeoutManager.tests
]
------------------------------------------------------------------------------
sslPort :: Int -> Maybe Int
#ifdef OPENSSL
sslPort sp = Just (sp + 100)
#else
sslPort _ = Nothing
#endif
ports :: Int -> (Int, Maybe Int)
ports sp = (sp, sslPort sp)
getStartPort :: IO Int
getStartPort = (liftM read (getEnv "STARTPORT") >>= E.evaluate)
`E.catch` \(_::E.SomeException) -> return 8111
|
