{-# LANGUAGE OverloadedStrings #-} module Targets (tests) where import Distribution.TestSuite import Base (simpleTest) import Control.Concurrent(forkIO) import qualified System.IO.Uniform as U import System.Timeout (timeout) import qualified Data.ByteString.Char8 as C8 tests :: IO [Test] tests = return [ simpleTest "network" testNetwork, simpleTest "file" testFile, simpleTest "network TLS" testTls ] testNetwork :: IO Progress testNetwork = do recv <- U.bindPort 8888 forkIO $ do s <- U.accept recv l <- U.uRead s 100 U.uPut s l U.uClose s return () r' <- timeout 1000000 $ do s <- U.connectToHost "127.0.0.1" 8888 let l = "abcdef\n" U.uPut s l l' <- U.uRead s 100 U.uClose s if l == l' then return . Finished $ Pass else return . Finished . Fail . C8.unpack $ l' U.closePort recv case r' of Just r -> return r Nothing -> return . Finished . Fail $ "Execution blocked" testFile :: IO Progress testFile = do let file = "test/testFile" s <- U.openFile file let l = "abcde\n" U.uPut s l U.uClose s s' <- U.openFile file l' <- U.uRead s' 100 U.uClose s' if l == l' then return . Finished $ Pass else return . Finished . Fail . C8.unpack $ l' testTls :: IO Progress testTls = do recv <- U.bindPort 8888 let set = U.TlsSettings "test/key.pem" "test/cert.pem" "test/dh.pem" forkIO $ do s' <- U.accept recv s <- U.startTls set s' l <- U.uRead s 100 U.uPut s l U.uClose s return () r' <- timeout 1000000 $ do s' <- U.connectToHost "127.0.0.1" 8888 s <- U.startTls set s' let l = "abcdef\n" U.uPut s l l' <- U.uRead s 100 U.uClose s if l == l' then return . Finished $ Pass else return . Finished . Fail . C8.unpack $ l' U.closePort recv case r' of Just r -> return r Nothing -> return . Finished . Fail $ "Execution blocked"