-- Make sure getting and setting work.  This doesn't test if the options
-- actually do anything, it just makes sure getsockopt reflects changes by
-- setsockopt.
--
-- TODO: Add test for getError
{-# LANGUAGE CPP #-}
import qualified Network.Socket.Options as Opt

import Prelude hiding (catch, last)

import Control.Exception
import Control.Monad
import Network.Socket

type Getter a = Socket -> IO a
type Setter a = Socket -> a -> IO ()

test_getType :: IO ()
test_getType = runTest "getType" $ do
    f AF_INET Stream    0
    f AF_INET Datagram  0
    f AF_INET Raw       1
    where
        f domain type_ protocol = do
            e <- try $ socket domain type_ protocol
            case e of
                Left ex ->
                    not_ok (show type_) $ show (ex :: SomeException)
                Right sock -> do
                    t <- Opt.getType sock
                    if t == type_
                        then ok     (show type_)
                        else not_ok (show type_) $ "getType returned " ++ show t ++ " instead"

test_getAcceptConn :: IO ()
test_getAcceptConn = runTest "getAcceptConn" $ do
    sock <- socket AF_INET Stream defaultProtocol
    a1 <- Opt.getAcceptConn sock
    expect (a1 == False) "getAcceptConn returns False for a fresh socket"

    bindSocket sock $ SockAddrInet 1234 iNADDR_ANY
    a2 <- Opt.getAcceptConn sock
    expect (a2 == False) "getAcceptConn returns False after bindSocket"

    listen sock 5
    a3 <- Opt.getAcceptConn sock
    expect (a3 == True) "getAcceptConn returns True after listen is called"

testBool :: String -> Getter Bool -> Setter Bool -> IO ()
testBool = testBoolWithSocketType Stream

testBoolWithSocketType :: SocketType -> String -> Getter Bool -> Setter Bool -> IO ()
testBoolWithSocketType type_ name get set = runTest name $ do
    sock <- socket AF_INET type_ defaultProtocol

    v1 <- get sock
    ok $ "Initial value: " ++ show v1

    set sock (not v1)
    v2 <- get sock
    expect (v2 == not v1) "setsockopt changed result of getsockopt"

    set sock v1
    v3 <- get sock
    expect (v3 == v1) "setsockopt changed result of getsockopt again"

testInt :: String -> Getter Int -> Setter Int -> IO ()
testInt name get set = runTest name $ do
    sock <- socket AF_INET Stream defaultProtocol

    v1 <- get sock
    ok $ "Initial value: " ++ show v1

    let setTo last v = do
            set sock v
            actual <- get sock
            if actual /= last
                then ok     ("set " ++ show v ++ ", got " ++ show actual)
                else not_ok (show v) ("value did not change")
            return actual

    _ <- foldM setTo v1 [0, 10000, 1, 1000000, 0]
    return ()

testMicroseconds
    :: String
    -> Getter Opt.Microseconds
    -> Setter Opt.Microseconds
    -> IO ()
testMicroseconds name get set = runTest name $ do
    sock <- socket AF_INET Stream defaultProtocol

    v1 <- get sock
    ok $ "Initial value: " ++ show v1
    
    let setTo (setval, getval) = do
            set sock setval
            actual <- get sock
            if actual == getval
                then ok     ("set " ++ show setval ++ ", get " ++ show getval)
                else not_ok ("set " ++ show setval ++ ", get " ++ show getval)
                            ("actually got " ++ show actual)

    mapM_ setTo
#if mingw32_HOST_OS
        [ (0,0)
        , (1, 1000)
        , (10000, 10000)
        , (12345, 12000)
        , (4000000000000, 4000000000000)
        , (0,0)
        ]
#else
        [ (0,0)
        , (1,10000)
        , (50000, 50000)
        , (1234567, 1240000)
        , (4000000000000, 4000000000000)
        , (0,0)
        ]
#endif

test_linger :: IO ()
test_linger = runTest "SO_LINGER" $ do
    sock <- socket AF_INET Stream defaultProtocol

    linger <- Opt.getLinger sock
    ok $ "Initial value: " ++ show linger

    let v1 = Nothing
        v2 = Just 1
        v3 = Just 30000

        setTo v = do
            Opt.setLinger sock v
            actual <- Opt.getLinger sock
            if actual == v
                then ok     (show v)
                else not_ok (show v) ("getLinger returned " ++ show actual ++ " instead")

    mapM_ setTo [v1, v2, v3, v1]

runTest :: String -> IO () -> IO ()
runTest name action = do
    putStrLn $ name ++ ":"
    action `catch` \ex -> do
        putStrLn ""
        putStrLn $ "Test " ++ name ++ " encountered an exception:\n    "
                ++ show (ex :: SomeException)
    putStrLn ""

ok :: String -> IO ()
ok msg = putStrLn $ "    ok:     " ++ msg

not_ok :: String -> String -> IO ()
not_ok msg reason = do
    putStrLn $ "    not ok: " ++ msg
    putStrLn $ "        reason: " ++ reason

expect :: Bool -> String -> IO ()
expect b msg =
    if b
        then putStrLn $ "    ok:     " ++ msg
        else putStrLn $ "    not ok: " ++ msg

main :: IO ()
main = do
    test_getType
    test_getAcceptConn

    testBoolWithSocketType Datagram
             "SO_BROADCAST" Opt.getBroadcast    Opt.setBroadcast
    testBool "SO_DEBUG"     Opt.getDebug        Opt.setDebug
    testBool "SO_DONTROUTE" Opt.getDontRoute    Opt.setDontRoute
    testBool "SO_KEEPALIVE" Opt.getKeepAlive    Opt.setKeepAlive
    testBool "SO_OOBINLINE" Opt.getOOBInline    Opt.setOOBInline
    testBool "SO_REUSEADDR" Opt.getReuseAddr    Opt.setReuseAddr
    testBool "TCP_NODELAY"  Opt.getTcpNoDelay   Opt.setTcpNoDelay

    testInt  "SO_RCVBUF"    Opt.getRecvBuf      Opt.setRecvBuf
    testInt  "SO_SNDBUF"    Opt.getSendBuf      Opt.setSendBuf

    testMicroseconds "SO_RCVTIMEO" Opt.getRecvTimeout Opt.setRecvTimeout
    testMicroseconds "SO_SNDTIMEO" Opt.getSendTimeout Opt.setSendTimeout

    test_linger

    putStrLn "Tests finished."