Network.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module System.IO.Streams.Tests.Network (tests) where

------------------------------------------------------------------------------
import           Control.Concurrent                 (forkIO, newEmptyMVar, putMVar, takeMVar)
import           Control.Monad                      (join)
import qualified Data.ByteString.Char8              as S
import           Data.IORef                         (atomicModifyIORef, newIORef)
import qualified Network.Socket                     as N
import           System.IO.Error                    (eofErrorType, mkIOError)
import           System.Timeout                     (timeout)
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit                         hiding (Test)
#if MIN_VERSION_network(2,7,0)
#else
import           Data.List                          (intercalate)
#endif
------------------------------------------------------------------------------
import qualified System.IO.Streams.Internal         as Streams
import qualified System.IO.Streams.Internal.Network as Streams
import qualified System.IO.Streams.List             as Streams
------------------------------------------------------------------------------
import           System.IO.Streams.Tests.Common     (expectExceptionH)

tests :: [Test]
tests = [ testSocket
        , testSocketWithError
        ]

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

  where
    -- compats
#if MIN_VERSION_network(2,7,0)
    mkAddr = return . N.tupleToHostAddress
    defaultPort = N.defaultPort
    close = N.close
    bind = N.bind
#else
    mkAddr (o1,o2,o3,o4) = N.inet_addr . intercalate "." $ map show [o1,o2,o3,o4]
    defaultPort = N.aNY_PORT
    close = N.sClose
    bind = N.bindSocket
#endif

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

    client mvar resultMVar = do
        port <- takeMVar mvar
        sock <- N.socket N.AF_INET N.Stream N.defaultProtocol
        addr <- mkAddr (127, 0, 0, 1)
        let saddr = N.SockAddrInet port addr
        N.connect sock saddr
        (is, os) <- Streams.socketToStreams sock
        Streams.fromList ["", "ok"] >>= Streams.connectTo os
        N.shutdown sock N.ShutdownSend
        Streams.toList is >>= putMVar resultMVar
        close sock

    server mvar = do
        sock  <- N.socket N.AF_INET N.Stream N.defaultProtocol
        addr <- mkAddr (127, 0, 0, 1)
        let saddr = N.SockAddrInet defaultPort addr
        bind sock saddr
        N.listen sock 5
        port  <- N.socketPort sock
        putMVar mvar port
        (csock, _) <- N.accept sock
        (is, os) <- Streams.socketToStreams csock
        Streams.toList is >>= flip Streams.writeList os
        close csock
        close sock

testSocketWithError :: Test
testSocketWithError = testCase "network/socket-error" $ N.withSocketsDo $ do
    codes1 <- newIORef [ return 1
                       , ioError $ mkIOError eofErrorType "eof" Nothing Nothing ]
    codes2 <- newIORef [ return 1
                       , ioError $ userError "foo" ]

    (is1, _)  <- Streams.socketToStreamsWithBufferSizeImpl (rbuf codes1) 64 (error "z")
    (Just s1) <- Streams.read is1
    assertEqual "one byte" 1 $ S.length s1
    Nothing   <- Streams.read is1

    (is2, _)  <- Streams.socketToStreamsWithBufferSizeImpl (rbuf codes2) 64 undefined
    (Just s2) <- Streams.read is2
    assertEqual "one byte" 1 $ S.length s2
    expectExceptionH $ Streams.read is2

  where
    rbuf rcodes _ _ _ = join $ atomicModifyIORef rcodes $ \codes ->
                        (tail codes, head codes)