socket-0.4.0.0: tests/IPV6_V6ONLY.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Exception
import Control.Concurrent
import Control.Concurrent.Async
import System.Socket
import System.Socket.Family.INET
import System.Socket.Family.INET6
import System.Exit

main :: IO ()
main = do 
  t0001
  t0002

t0001 :: IO ()
t0001 = 
  bracket
    ( do
        server <- socket                              `onException` p 0 :: IO (Socket INET6 DGRAM UDP)
        client <- socket                              `onException` p 1 :: IO (Socket INET  DGRAM UDP)
        return (server, client)
    )
    (\(server,client)-> do
        close server                                  `onException` p 2
        close client                                  `onException` p 3
    )
    (\(server,client)-> do
        setSockOpt server (IPV6_V6ONLY True)          `onException` p 4
        bind server (SockAddrIn6 7777 0 in6addrANY 0) `onException` p 5

        threadDelay 1000000 -- wait for the listening socket being set up
        sendTo client "PING" mempty (SockAddrIn 7777 inaddrLOOPBACK)
                                                      `onException` p 6
        eith <- race
          ( recvFrom server 4096 mempty `onException` p 7 >> return () )
          ( threadDelay 1000000 )
        case eith of
          Left  () -> e 8        -- we didn't expect receiving a msg
          Right () -> return ()  -- timeout is the expected behaviour
    )
  where
    e i  = error ("t0001." ++ show i)
    p i  = print ("t0001." ++ show i)

t0002 :: IO ()
t0002 = 
  bracket
    ( do
        server <- socket                              `onException` p 0 :: IO (Socket INET6 DGRAM UDP)
        client <- socket                              `onException` p 1 :: IO (Socket INET  DGRAM UDP)
        return (server, client)
    )
    (\(server,client)-> do
        close server                                  `onException` p 2
        close client                                  `onException` p 3
    )
    (\(server,client)-> do
        setSockOpt server (IPV6_V6ONLY False)         `onException` p 4
        bind server (SockAddrIn6 7778 0 in6addrANY 0) `onException` p 5

        threadDelay 1000000 -- wait for the listening socket being set up
        sendTo client "PING" mempty (SockAddrIn 7778 inaddrLOOPBACK)
                                                      `onException` p 6
        eith <- race
          ( recvFrom server 4096 mempty `onException` p 7 >> return ())
          ( threadDelay 1000000 )
        case eith of
          Left  () -> return ()  -- we received the expected msg
          Right () -> e 8        -- timeout occured
    )
  where
    e i  = error ("t0002." ++ show i)
    p i  = print ("t0002." ++ show i)