{-# LANGUAGE OverloadedStrings #-} module Targets (tests) where import Distribution.TestSuite import Base (simpleTest) import Control.Concurrent(forkIO) import qualified System.IO as I import System.IO.Uniform import System.IO.Uniform.Network import System.IO.Uniform.File --import System.IO.Uniform.Std import System.IO.Uniform.ByteString import System.IO.Uniform.HandlePair import System.Timeout (timeout) import qualified Data.ByteString.Char8 as C8 import Data.ByteString (ByteString) import qualified Data.ByteString as BS tests :: IO [Test] tests = return [ simpleTest "network" testNetwork, simpleTest "file" testFile, simpleTest "network TLS" testTls, simpleTest "byte string" testBS, simpleTest "handle pair" testHandlePair ] testNetwork :: IO Progress testNetwork = do recv <- bindPort 8888 forkIO $ do s <- accept recv l <- uRead s 100 uPut s l uClose s return () r' <- timeout 1000000 $ do s <- connectToHost "127.0.0.1" 8888 let l = "abcdef\n" uPut s l l' <- uRead s 100 uClose s if l == l' then return . Finished $ Pass else return . Finished . Fail . C8.unpack $ l' 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 <- openFile file let l = "abcde\n" uPut s l uClose s s' <- openFile file l' <- uRead s' 100 uClose s' if l == l' then return . Finished $ Pass else return . Finished . Fail . C8.unpack $ l' testTls :: IO Progress testTls = do recv <- bindPort 8888 let set = TlsSettings "test/key.pem" "test/cert.pem" "test/dh.pem" forkIO $ do s' <- accept recv s <- startTls set s' l <- uRead s 100 uPut s l uClose s return () r' <- timeout 1000000 $ do s' <- connectToHost "127.0.0.1" 8888 s <- startTls set s' let l = "abcdef\n" uPut s l l' <- uRead s 100 uClose s if l == l' then return . Finished $ Pass else return . Finished . Fail . C8.unpack $ l' closePort recv case r' of Just r -> return r Nothing -> return . Finished . Fail $ "Execution blocked" testBS :: IO Progress testBS = do let dt = "Some data to test ByteString" (len, echo) <- withByteStringIO dt ( \io -> let count = countAndEcho io :: Int -> ByteString -> IO Int in mapOverInput io 2 count 0 ) :: IO (Int, ByteString) if dt /= echo || BS.length dt /= len then return . Finished . Fail $ "Failure on ByteStringIO test" else return . Finished $ Pass where countAndEcho :: UniformIO io => io -> Int -> ByteString -> IO Int countAndEcho io initial dt = do uPut io dt return $ initial + BS.length dt testHandlePair :: IO Progress testHandlePair = do let l = "abcde\n" h <- I.openFile "test/testHandles" I.WriteMode let s = fromHandles h h uPut s l uClose s h' <- I.openFile "test/testHandles" I.ReadMode let s' = fromHandles h' h' l' <- uRead s' 100 uClose s' if l == l' then return . Finished $ Pass else return . Finished . Fail . C8.unpack $ l'