uniform-io-0.2.0.0: 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

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"