123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122 |
- {-# 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'
|