diff --git a/cbits/tlsinc.c b/cbits/tlsinc.c --- a/cbits/tlsinc.c +++ b/cbits/tlsinc.c @@ -558,10 +558,12 @@ if ( retval == -1 ) { - if ( errno == EINTR ) + if ( errno == EINTR ) { // printf("."); - can_go = 0; + // I get a lot of these signals due to the fact of the + // Haskell runtime having its own use for signals. + return TIMEOUT_REACHED; } else { perror("select()"); return BAD_HAPPENED; diff --git a/hs-src/SecondTransfer.hs b/hs-src/SecondTransfer.hs --- a/hs-src/SecondTransfer.hs +++ b/hs-src/SecondTransfer.hs @@ -8,8 +8,18 @@ Portability : POSIX This library implements enough of the HTTP/2 to build -compliant HTTP/2 servers. The library +compliant HTTP/2 servers. +Frame encoding and decoding is done with +Kazu Yamamoto's package, our goal +here is to sort the HTTP/2 frames according to the protocol. + +You can find more detailed information about this library at the page + (but notice that the site uses +the library and doesn't yet talk HTTP/1.1, so use a modern browser). + +The library + * Is concurrent, meaning that you can use amazing Haskell lightweight threads to process the requests. @@ -21,11 +31,11 @@ should even be able to do both simultaneously. Setting up TLS for HTTP/2 correctly is enough of a shore, so I have bundled here the -TLS setup logic. +TLS setup logic. Before you read any further, ATTENTION: enable always the threaded +ghc runtime in your final programs if you want TLS to work. -Frame encoding and decoding is done with -Kazu Yamamoto's package. + Here is how you create a very basic HTTP/2 webserver: @ @@ -117,6 +127,9 @@ -- its source for the response data. A coherent worker can also present -- create streams to push to the client. Headers + , HeaderName + , HeaderValue + , Header , Request , Footers , CoherentWorker @@ -132,6 +145,11 @@ -- ** Callback types ,Attendant + -- *** Push, Pull and Close actions + -- + -- | You don't need to do anything with these types if you are using + -- `http2Attendant` and `tlsServeWithALPN`. But they are useful if + -- you want to implement your own layer. ,PullAction ,PushAction ,CloseAction diff --git a/hs-src/SecondTransfer/Http2.hs b/hs-src/SecondTransfer/Http2.hs --- a/hs-src/SecondTransfer/Http2.hs +++ b/hs-src/SecondTransfer/Http2.hs @@ -4,11 +4,11 @@ ,makeSessionsContext ,defaultSessionsConfig -- | Configuration information - ,SessionsConfig + ,SessionsConfig(..) -- | Context. You need to use `makeSessionsContext` to instance -- one of this. ,SessionsContext - ,SessionsCallbacks + ,SessionsCallbacks(..) ,ErrorCallback ,sessionsCallbacks @@ -22,7 +22,7 @@ defaultSessionsConfig, makeSessionsContext, - SessionsConfig, + SessionsConfig(..), SessionsContext, SessionsCallbacks, ErrorCallback, diff --git a/hs-src/SecondTransfer/Http2/Framer.cpphs b/hs-src/SecondTransfer/Http2/Framer.cpphs --- a/hs-src/SecondTransfer/Http2/Framer.cpphs +++ b/hs-src/SecondTransfer/Http2/Framer.cpphs @@ -144,8 +144,13 @@ let -- TODO: Dodgy exception handling here... - close_on_error session_id session_context comp = E.finally ( - E.catch comp (exc_handler session_id session_context)) close_action + close_on_error session_id session_context comp = + E.finally ( + E.catch + comp + (exc_handler session_id session_context) + ) + close_action exc_handler :: Int -> SessionsContext -> FramerException -> IO () exc_handler x y e = do @@ -407,8 +412,13 @@ -- And don't forget the thread itself let - close_on_error session_id session_context comp = E.finally ( - E.catch comp (exc_handler session_id session_context)) close_action + close_on_error session_id session_context comp = + E.finally + (E.catch + comp + (exc_handler session_id session_context) + ) + close_action exc_handler :: Int -> SessionsContext -> IOProblem -> IO () exc_handler x y e = do diff --git a/hs-src/SecondTransfer/Http2/MakeAttendant.hs b/hs-src/SecondTransfer/Http2/MakeAttendant.hs --- a/hs-src/SecondTransfer/Http2/MakeAttendant.hs +++ b/hs-src/SecondTransfer/Http2/MakeAttendant.hs @@ -21,7 +21,10 @@ -- @ -- -- Given a `CoherentWorker`, this function wraps it with flow control, multiplexing, --- and state maintenance needed to run an HTTP/2 session. +-- and state maintenance needed to run an HTTP/2 session. +-- +-- Notice that this function is using HTTP/2 over TLS. We haven't implemented yet +-- a session handling mechanism for HTTP/1.1 . http2Attendant :: SessionsContext -> CoherentWorker -> Attendant http2Attendant sessions_context coherent_worker push_action pull_action close_action = do let diff --git a/hs-src/SecondTransfer/Http2/Session.cpphs b/hs-src/SecondTransfer/Http2/Session.cpphs --- a/hs-src/SecondTransfer/Http2/Session.cpphs +++ b/hs-src/SecondTransfer/Http2/Session.cpphs @@ -25,8 +25,8 @@ ,SessionsContext(..) ,SessionCoordinates(..) ,SessionComponent(..) - ,SessionsCallbacks - ,SessionsConfig + ,SessionsCallbacks(..) + ,SessionsConfig(..) ,ErrorCallback -- Internal stuff @@ -189,6 +189,7 @@ -- | Callbacks that you can provide your sessions to notify you -- of interesting things happening in the server. data SessionsCallbacks = SessionsCallbacks { + -- Callback used to report errors during this session _reportErrorCallback :: Maybe ErrorCallback } @@ -197,6 +198,7 @@ -- | Configuration information you can provide to the session maker. data SessionsConfig = SessionsConfig { + -- | Session callbacks _sessionsCallbacks :: SessionsCallbacks } @@ -254,6 +256,7 @@ -- NH2.Frame != Frame data SessionData = SessionData { + -- ATTENTION: Ignore the warning coming from here for now _sessionsContext :: SessionsContext ,_sessionInput :: Chan (Either SessionInputCommand InputFrame) @@ -372,7 +375,8 @@ (SessionOutput session_output) ) - +-- TODO: Some ill clients can break this thread with exceptions. Make these paths a bit +--- more robust. sessionInputThread :: ReaderT SessionData IO () sessionInputThread = do INSTRUMENTATION( liftIO $ debugM "HTTP2.Session" "Entering sessionInputThread" ) @@ -420,25 +424,27 @@ let for_worker_thread = set streamId stream_id for_worker_thread_uns headers_bytes <- getHeaderBytes stream_id dyn_table <- liftIO $ takeMVar decode_headers_table_mvar - (new_table, header_list ) <- liftIO $ HP.decodeHeader dyn_table headers_bytes + (new_table, header_list ) <- liftIO $ {-# SCC "decodeHeader" #-} HP.decodeHeader dyn_table headers_bytes -- Good moment to remove the headers from the table.... we don't want a space -- leak here - liftIO $ H.delete stream_request_headers stream_id - liftIO $ putMVar decode_headers_table_mvar new_table + liftIO $ do + H.delete stream_request_headers stream_id + putMVar decode_headers_table_mvar new_table + -- TODO: Validate headers, abort session if the headers are invalid. + -- Otherwise other invariants will break!! + -- THIS IS PROBABLY THE BEST PLACE FOR DOING IT. + -- If the headers end the request.... post_data_source <- if not (frameEndsStream frame) then do - mechanism <- createMechanismForStream stream_id let source = postDataSourceFromMechanism mechanism return $ Just source else do return Nothing - -- I'm clear to start the worker, in its own thread - -- !! liftIO $ do thread_id <- forkIO $ runReaderT (workerThread (header_list, post_data_source) coherent_worker) @@ -475,12 +481,20 @@ Right frame@(NH2.Frame (NH2.FrameHeader _ _ nh2_stream_id) (NH2.DataFrame somebytes)) -> do -- So I got data to process -- TODO: Handle end of stream - let stream_id = NH2.fromStreamIdentifier nh2_stream_id + let stream_id = NH2.fromStreamIdentifier nh2_stream_id + -- TODO: Handle the cases where the stream_id doesn't match an already existent + -- stream. In such cases it is justified to reset the connection with a protocol_error. + streamWorkerSendData stream_id somebytes -- After that data has been received and forwarded downstream, we can issue a windows update -- -- TODO: We can use wider frames to avoid congestion... -- .... and we can also be more compositional with these short bursts of data.... + -- + -- TODO: Consider that the best place to output these frames can be somewhere else... + -- + -- TODO: Use a special, with-quota queue here to do flow control. Don't send meaningless + -- WindowUpdateFrame's sendOutFrame (NH2.EncodeInfo NH2.defaultFlags @@ -558,10 +572,9 @@ sendOutFrame :: NH2.EncodeInfo -> NH2.FramePayload -> ReaderT SessionData IO () sendOutFrame encode_info payload = do session_output_mvar <- view sessionOutput - session_output <- liftIO $ takeMVar session_output_mvar + session_output <- liftIO $ takeMVar session_output_mvar liftIO $ writeChan session_output $ Right (encode_info, payload) - liftIO $ putMVar session_output_mvar session_output @@ -579,6 +592,8 @@ -- TODO: Can be optimized by factoring out the mechanism lookup +-- TODO IMPORTANT: This is a good place to drop the postinputmechanism +-- for a stream, so that unprocessed data can be garbage-collected. closePostDataSource :: GlobalStreamId -> ReaderT SessionData IO () closePostDataSource stream_id = do stream2postinputmechanism <- view stream2PostInputMechanism @@ -591,8 +606,7 @@ liftIO $ writeChan chan Nothing Nothing -> - -- This is an internal error, the mechanism should be - -- created when the stream ends + -- TODO: This is a protocol error, handle it properly error "Internal error/closePostDataSource" @@ -608,7 +622,8 @@ Nothing -> -- This is an internal error, the mechanism should be - -- created when the headers end + -- created when the headers end (and if the headers + -- do not finish the stream) error "Internal error" @@ -633,14 +648,14 @@ return $ NS.member stream_id cancelled_streams + workerThread :: Request -> CoherentWorker -> WorkerMonad () workerThread req coherent_worker = do headers_output <- view headersOutput stream_id <- view streamId - (headers, _, data_and_conclussion) <- liftIO $ coherent_worker req - -- liftIO $ putStrLn $ "Num pushed streams: " ++ (show $ length pushed_streams) + (headers, _, data_and_conclussion) <- liftIO $ coherent_worker req -- Now I send the headers, if that's possible at all headers_sent <- liftIO $ newEmptyMVar @@ -661,7 +676,7 @@ (transPipe liftIO data_and_conclussion) `fuseBothMaybe` (sendDataOfStream stream_id headers_sent) - -- BIG TODO: Send the headers ... likely stream conclusion semantics + -- BIG TODO: Send the footers ... likely stream conclusion semantics -- will need to be changed. return () else @@ -686,21 +701,6 @@ consumer data_output --- sendDataOfStream :: Sink - - --- Allow this very important function to be used in the future to process footers - --- difficultFunction :: (Monad m) --- => ConduitM () a2 m r1 -> ConduitM a2 Void m r2 --- -> m (r2, Maybe r1) --- difficultFunction l r = liftM (fmap getLast) $ runWriterT (l' $$ r') --- where --- l' = transPipe lift l >>= lift . tell . Last . Just --- r' = transPipe lift r - - - appendHeaderFragmentBlock :: GlobalStreamId -> B.ByteString -> ReaderT SessionData IO () appendHeaderFragmentBlock global_stream_id bytes = do ht <- view stream2HeaderBlockFragment @@ -822,8 +822,8 @@ withLockedSessionOutput (\ session_output -> writeChan session_output $ Right ( NH2.EncodeInfo { NH2.encodeFlags = NH2.setEndStream NH2.defaultFlags - ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id - ,NH2.encodePadding = Nothing }, + ,NH2.encodeStreamId = NH2.toStreamIdentifier stream_id + ,NH2.encodePadding = Nothing }, NH2.DataFrame "" ) ) diff --git a/hs-src/SecondTransfer/MainLoop/CoherentWorker.hs b/hs-src/SecondTransfer/MainLoop/CoherentWorker.hs --- a/hs-src/SecondTransfer/MainLoop/CoherentWorker.hs +++ b/hs-src/SecondTransfer/MainLoop/CoherentWorker.hs @@ -9,6 +9,9 @@ module SecondTransfer.MainLoop.CoherentWorker( getHeaderFromFlatList + , HeaderName + , HeaderValue + , Header , Headers , FinalizationHeaders , Request @@ -28,14 +31,22 @@ import Data.Foldable (find) import Data.Typeable +-- | The name part of a header +type HeaderName = B.ByteString +-- | The value part of a header +type HeaderValue = B.ByteString + +-- | The complete header +type Header = (HeaderName, HeaderValue) + -- |List of headers. The first part of each tuple is the header name -- (be sure to conform to the HTTP/2 convention of using lowercase) -- and the second part is the headers contents. This list needs to include -- the special :method, :scheme, :authority and :path pseudo-headers for -- requests; and :status (with a plain numeric value represented in ascii digits) -- for responses. -type Headers = [(B.ByteString, B.ByteString)] +type Headers = [Header] -- |This is a Source conduit (see Haskell Data.Conduit library from Michael Snoyman) -- that you can use to retrieve the data sent by the client piece-wise. diff --git a/hs-src/SecondTransfer/MainLoop/Logging.hs b/hs-src/SecondTransfer/MainLoop/Logging.hs --- a/hs-src/SecondTransfer/MainLoop/Logging.hs +++ b/hs-src/SecondTransfer/MainLoop/Logging.hs @@ -42,14 +42,6 @@ ) updateGlobalLogger "OpenSSL" ( setHandlers [s] . - setLevel INFO - ) - updateGlobalLogger "HarWorker" ( - setHandlers [s] . - setLevel DEBUG - ) - updateGlobalLogger "ResearchWorker" ( - setHandlers [s] . setLevel DEBUG ) updateGlobalLogger "HTTP2.Framer" ( diff --git a/hs-src/SecondTransfer/MainLoop/OpenSSL_TLS.cpphs b/hs-src/SecondTransfer/MainLoop/OpenSSL_TLS.cpphs --- a/hs-src/SecondTransfer/MainLoop/OpenSSL_TLS.cpphs +++ b/hs-src/SecondTransfer/MainLoop/OpenSSL_TLS.cpphs @@ -158,7 +158,7 @@ INSTRUMENTATION( errorM "OpenSSL" "Could not create listening socket" ) throwIO $ TLSLayerGenericProblem "Could not create listening end" else do - INSTRUMENTATION( infoM "OpenSSL" "Listening soxket created" ) + INSTRUMENTATION( infoM "OpenSSL" "Listening socket created" ) return () forever $ do @@ -173,7 +173,7 @@ INSTRUMENTATION( infoM "OpenSSL" "A connection was accepted" ) return $ Right p | re == timeoutReached -> tryOnce - | re == badHappened -> return $ Left "A wait for connection failed" + | re == badHappened -> return $ Left ("A wait for connection failed" :: String) r in tryOnce @@ -204,11 +204,13 @@ -- Ensure that the socket and the struct are only closed once closeAction = do + -- debugM "OpenSSL" "About to close connection" b <- readMVar already_closed_mvar if not b then do - putMVar already_closed_mvar True + modifyMVar_ already_closed_mvar (\ _ -> return True) disposeWiredSession wired_ptr + -- debugM "OpenSSL" "dispose clalled" else return () @@ -313,11 +315,13 @@ B.packCStringLen (pcharbuffer, fromIntegral recvd_bytes) closeAction = do + -- debugM "OpenSSL" "Close action about to be invoked" b <- readMVar already_closed_mvar if not b then do - putMVar already_closed_mvar True + modifyMVar_ already_closed_mvar (\ _ -> return True) disposeWiredSession wired_ptr + -- debugM "OpenSSL" "Close action invoked" else return () diff --git a/hs-src/SecondTransfer/Utils.hs b/hs-src/SecondTransfer/Utils.hs --- a/hs-src/SecondTransfer/Utils.hs +++ b/hs-src/SecondTransfer/Utils.hs @@ -6,43 +6,28 @@ ,word24ToInt ,putWord24be ,getWord24be - -- ,getTimeDiff - -- ,timeAsDouble - -- ,reportTimedEvent ,lowercaseText ,unfoldChannelAndSource ,stripString - -- ,neutralizeUrl ,domainFromUrl - -- ,hashFromUrl - -- ,hashSafeFromUrl - -- ,unSafeUrl - -- ,SafeUrl ) where import Control.Concurrent.Chan import Control.Monad.Trans.Class (lift) --- import qualified Crypto.Hash.MD5 as MD5 import Data.Binary (Binary, get, put, putWord8) import Data.Binary.Get (Get, getWord16be, getWord8) import Data.Binary.Put (Put, putWord16be) import Data.Bits import qualified Data.ByteString as B --- import qualified Data.ByteString.Base16 as B16 import Data.ByteString.Char8 (pack, unpack) --- import Data.Hashable (Hashable) import Data.Conduit import qualified Data.Text as T import Data.Text.Encoding import qualified Network.URI as U --- import qualified System.Clock as SC --- import Text.Printf (printf) --- import qualified Text.Show.ByteString as S(Show(..)) - strToInt::String -> Int strToInt = fromIntegral . toInteger . (read::String->Integer) @@ -51,11 +36,6 @@ deriving (Show) --- Newtype to protect url usage --- newtype SafeUrl = SafeUrl { unSafeUrl :: B.ByteString } deriving (Eq, Show, Hashable) - - - word24ToInt :: Word24 -> Int word24ToInt (Word24 w24) = w24 @@ -117,25 +97,6 @@ stripString = filter $ \ ch -> (ch /= '\n') && ( ch /= ' ') --- neutralizeUrl :: B.ByteString -> B.ByteString --- neutralizeUrl url = let --- Just (U.URI {- scheme -} _ authority u_path u_query u_frag) = U.parseURI $ unpack url --- Just (U.URIAuth _ use_host _) = authority --- complete_url = U.URI { --- U.uriScheme = "snu:" --- ,U.uriAuthority = Just $ U.URIAuth { --- U.uriUserInfo = "" --- ,U.uriRegName = use_host --- ,U.uriPort = "" --- } --- ,U.uriPath = u_path --- ,U.uriQuery = u_query --- ,U.uriFragment = u_frag --- } --- in --- pack $ show complete_url - - domainFromUrl :: B.ByteString -> B.ByteString domainFromUrl url = let Just (U.URI {- scheme -} _ authority _ _ _) = U.parseURI $ unpack url @@ -143,11 +104,3 @@ in pack use_host - --- hashFromUrl :: B.ByteString -> B.ByteString --- hashFromUrl url = --- B.take 10 . B16.encode . MD5.finalize $ foldl MD5.update MD5.init $ [urlHashSalt, neutralizeUrl url] - - --- hashSafeFromUrl :: B.ByteString -> SafeUrl --- hashSafeFromUrl = SafeUrl . hashFromUrl diff --git a/hs-src/SecondTransfer/Utils/HTTPHeaders.hs b/hs-src/SecondTransfer/Utils/HTTPHeaders.hs new file mode 100644 --- /dev/null +++ b/hs-src/SecondTransfer/Utils/HTTPHeaders.hs @@ -0,0 +1,35 @@ +module SecondTransfer.Utils.HTTPHeaders ( + lowercaseHeaders + ,headersAreValidHTTP2 + ) where + +import Data.Char (isUpper) +import Data.Text (toLower) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) + + +import SecondTransfer.MainLoop.CoherentWorker (Headers) + +-- Why having a headers library? The one at Network.HTTP.Headers works +-- with Strings and is not very friendly to custom headers. +-- This is a very basic, lightweight normalizer. + +-- | HTTP headers are case-insensitive, so we can use lowercase versions +-- everywhere +lowercaseHeaders :: Headers -> Headers +lowercaseHeaders = map (\(h,v) -> (low h, v)) + where + low = encodeUtf8 . toLower . decodeUtf8 + + +-- | Checks that headers are lowercase +headersAreValidHTTP2 :: Headers -> Bool +headersAreValidHTTP2 headers = + let + isOk a_header = not . T.any isUpper . decodeUtf8 . fst $ a_header + in + foldl + (\ prev e -> (flip (&&)) (isOk e) $! prev) + True + headers diff --git a/second-transfer.cabal b/second-transfer.cabal --- a/second-transfer.cabal +++ b/second-transfer.cabal @@ -7,13 +7,13 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version : 0.3.0.4 +version : 0.4.0.0 synopsis : Second Transfer HTTP/2 web server description : Second Transfer HTTP/2 web server -homepage : https://github.com/alcidesv/second-transfer +homepage : https://www.httptwo.com/second-transfer/ license : BSD3 @@ -23,7 +23,8 @@ maintainer : alcidesv@zunzun.se -copyright : Copyright 2015, Alcides Viamontes Esquivel +copyright : Copyright 2015, Alcides Viamontes Esquivel + category : Network stability : experimental @@ -63,6 +64,7 @@ , SecondTransfer.MainLoop.Internal , SecondTransfer.Exception , SecondTransfer.MainLoop.Logging + , SecondTransfer.Utils.HTTPHeaders other-modules: SecondTransfer.MainLoop.CoherentWorker , SecondTransfer.MainLoop.PushPullType @@ -87,56 +89,21 @@ -- Other library packages from which modules are imported. build-depends: base >=4.7 && < 4.8, - -- optparse-applicative - -- aeson >= 0.8 - -- connection >= 0.2 && < 0.3 exceptions >= 0.8 && < 0.9, bytestring == 0.10.4.0, - -- base64-bytestring >= 1.0 base16-bytestring >= 0.1.1, - -- data-default == 0.5.3 - -- tls >= 1.2 && < 1.3 - -- data-default-class == 0.0.1 network >= 2.6 && < 2.7, - -- x509 == 1.5.0.1 - -- certificate == 1.3.9 - -- x509-store == 1.5.0 - -- x509-system == 1.5.0 text >= 1.2 && < 1.3, - -- bitset == 1.4.8 binary == 0.7.1.0, - -- pipes == 4.1.4 containers == 0.5.5.1, - -- clock == 0.4.1.3 - -- network-simple == 0.4.0.2 - -- pipes-concurrency >= 2.0 && < 2.1 - -- unix == 2.7.0.1 - -- filepath == 1.3.0.2 - -- directory == 1.2.1.0 - -- asn1-encoding == 0.9.0 - -- crypto-pubkey >= 0.2.7 && <0.3 - -- asn1-types == 0.3.0 - -- crypto-random == 0.0.8 - -- cryptohash >= 0.11, - -- streaming-commons >= 0.1 && < 0.2 conduit >= 1.2.4 && < 1.3, - -- conduit-combinators >= 0.3.0 && < 0.4 transformers >=0.3 && <= 0.5, - -- mmorph == 1.0.4 - -- QuickCheck == 2.7.6 network-uri >= 2.6 && < 2.7, hashtables >= 1.2 && < 1.3, - -- dequeue == 0.1.5 lens >= 4.7 && < 4.8, - -- base64-bytestring >= 1.0 http2 >= 0.7, - ---- hedis == 0.6.5 - -- blaze-builder >= 0.3.3 && < 0.4 - -- process >= 1.2 && < 1.3 - -- void hslogger >= 1.2.6, hashable >= 1.2 - -- -- asn-data -- Directories containing source files. hs-source-dirs: hs-src @@ -155,10 +122,11 @@ -- cc-options: -g3 -O0 - ghc-options: + -- ghc-options: -O2 extra-libraries: ssl crypto + -- NOTICE: Please fill-in with an-up-to date library path here extra-lib-dirs: /opt/openssl-1.0.2/lib include-dirs: macros/ diff --git a/tests/tests-hs-src/hunit_tests.hs b/tests/tests-hs-src/hunit_tests.hs --- a/tests/tests-hs-src/hunit_tests.hs +++ b/tests/tests-hs-src/hunit_tests.hs @@ -1,16 +1,25 @@ + +module Main where + +import System.Exit + import Test.HUnit import SecondTransfer.Test.DecoySession import Tests.HTTP2Session +import Tests.Utils tests = TestList [ TestLabel "testPrefaceChecks" testPrefaceChecks, - TestLabel "testPrefaceChecks2" testPrefaceChecks2 + TestLabel "testPrefaceChecks2" testPrefaceChecks2, + TestLabel "testLowercaseHeaders" testLowercaseHeaders ] main = do - runTestTT tests - return () + rets <- runTestTT tests + if (errors rets == 0 && failures rets == 0) + then exitWith ExitSuccess + else exitWith $ ExitFailure (-1)