uniform-io/test/Targets.hs

{-# 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
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
  ]

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"

testBS :: IO Progress
testBS = do
  let dt = "Some data to test ByteString"
  (len, echo) <- U.withByteStringIO' dt (
    \io -> let
      count = countAndEcho io :: Int -> ByteString -> IO Int
      in U.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 :: U.UniformIO io => io -> Int -> ByteString -> IO Int
    countAndEcho io initial dt = do
      U.uPut io dt
      return $ initial + BS.length dt