-- | Tests for things that didn't work in the past.
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- for recv and send
module Main where

import Network.Socket

import Control.Exception

import Test.Framework (Test, defaultMain)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertFailure)

------------------------------------------------------------------------
-- Tests

-- Used to segfault on OS X 10.8.2 due to AI_NUMERICSERV being set
-- without a service being set. This is a OS X bug.
testGetAddrInfo :: IO ()
testGetAddrInfo = do
    let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }
    _ <- getAddrInfo (Just hints) (Just "localhost") Nothing
    return ()

mkBadSocketAndTry :: (Socket -> IO a) -> IO (Either IOException a)
mkBadSocketAndTry f = do
    sock <- socket AF_INET Stream defaultProtocol
    try $ f sock

-- Because of 64/32 bitness issues, -1 wasn't correctly checked for on Windows.
-- See also GHC ticket #12010
badRecvShouldThrow :: IO ()
badRecvShouldThrow = do
    res <- mkBadSocketAndTry $ flip recv 1024
    case res of
        Left _ex -> return ()
        Right _  -> assertFailure "recv didn't throw an exception"

badSendShouldThrow :: IO ()
badSendShouldThrow = do
    res <- mkBadSocketAndTry $ flip send "hello"
    case res of
        Left _ex -> return ()
        Right _  -> assertFailure "send didn't throw an exception"

------------------------------------------------------------------------
-- List of all tests

tests :: [Test]
tests =
    [ testCase "testGetAddrInfo" testGetAddrInfo
    , testCase "badRecvShouldThrow" badRecvShouldThrow
    , testCase "badSendShouldThrow" badSendShouldThrow
    ]

------------------------------------------------------------------------
-- Test harness

main :: IO ()
main = withSocketsDo $ defaultMain tests