mysql-pure-1.0.2: test/TCPStreams.hs

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module TCPStreams (tests) where

------------------------------------------------------------------------------
import           Control.Concurrent             (forkIO, newEmptyMVar, putMVar,
                                                 takeMVar)
import qualified Network.Socket                 as N
import           System.Timeout                 (timeout)
import           Test.Tasty
import           Test.Tasty.HUnit                     hiding (Test)
import qualified Data.ByteString                as B
import qualified Data.ByteString.Lazy           as L
import           System.Directory               (removeFile)
------------------------------------------------------------------------------
import qualified Data.TLSSetting                as TLS
import           Data.Connection
import qualified System.IO.Streams              as Stream
import qualified System.IO.Streams.TCP          as TCP
import qualified System.IO.Streams.TLS          as TLS
------------------------------------------------------------------------------

tests :: TestTree
tests = testGroup "tests" [ testGroup "TCP" tcpTests
        , testGroup "TLS"  tlsTests
        ]

------------------------------------------------------------------------------

tcpTests :: [TestTree]
tcpTests = [ testTCPSocket ]

testTCPSocket :: TestTree
testTCPSocket = testCase "network/socket" $
    N.withSocketsDo $ do
    x <- timeout (10 * 10^(6::Int)) go
    assertEqual "ok" (Just ()) x

  where
    go = do
        portMVar   <- newEmptyMVar
        resultMVar <- newEmptyMVar
        forkIO $ client portMVar resultMVar
        server portMVar
        l <- takeMVar resultMVar
        assertEqual "testSocket" l ["ok"]

    client mvar resultMVar = do
        _ <- takeMVar mvar
        conn <- TCP.connect "127.0.0.1" 8888
        send conn "ok"
        Stream.toList (source conn) >>= putMVar resultMVar
        close conn

    server mvar = do
        sock <- TCP.bindAndListen 1024 8888
        putMVar mvar ()
        conn <- TCP.accept sock
        req <- Stream.readExactly 2 (source conn)
        send conn (L.fromStrict req)
        close conn

------------------------------------------------------------------------------

tlsTests :: [TestTree]
tlsTests = [ testTLSSocket
             -- TODO disabled because won't work in a  nix container
             -- , testHTTPS
           ]

testTLSSocket :: TestTree
testTLSSocket = testCase "network/socket" $
    N.withSocketsDo $ do
    x <- timeout (10 * 10^(6::Int)) go
    assertEqual "ok" (Just ()) x

  where
    go = do
        portMVar   <- newEmptyMVar
        resultMVar <- newEmptyMVar
        forkIO $ client portMVar resultMVar
        server portMVar
        l <- takeMVar resultMVar
        assertEqual "testSocket" l ["ok"]

    client mvar resultMVar = do
        _ <- takeMVar mvar
        cp <- TLS.makeClientParams (TLS.CustomCAStore "./test/cert/ca.pem")
        conn <- TLS.connect cp (Just "Winter") "127.0.0.1" 8889
        send conn "ok"
        Stream.toList (source conn) >>= putMVar resultMVar
        close conn

    server mvar = do
        sp <- TLS.makeServerParams "./test/cert/server-cert.pem" [] "./test/cert/server-key.pem"
        sock <- TCP.bindAndListen 1024 8889
        putMVar mvar ()
        conn <- TLS.accept sp sock
        req <- Stream.readExactly 2 (source conn)
        send conn (L.fromStrict req)
        close conn

testHTTPS :: TestTree
testHTTPS = testCase "network/https" $
    N.withSocketsDo $ do
    x <- timeout (10 * 10^(6::Int)) go
    assertEqual "ok" (Just 1024) x
  where
    go = do
        cp <- TLS.makeClientParams TLS.MozillaCAStore
        conn <- TLS.connect cp Nothing "www.bing.com" 443
        send conn ("GET / HTTP/1.1\r\n")
        send conn ("Host: www.bing.com\r\n")
        send conn ("\r\n")
        bs <- Stream.readExactly 1024 (source conn)
        close conn
        return (B.length bs)