{-# LINE 1 "src/Network/Multicast.hsc" #-}
-----------------------------------------------------------------------------
{-# LINE 2 "src/Network/Multicast.hsc" #-}
-- |
-- Module      :  Network.Multicast
-- Copyright   :  (c) Audrey Tang 2008
-- License     :  MIT License
-- 
-- Maintainer  :  audreyt@audreyt.org
-- Stability   :  experimental
-- Portability :  portable
--
-- The "Network.Multicast" module is for sending UDP datagrams over multicast
-- (class D) addresses.
--
-----------------------------------------------------------------------------

{-# LINE 16 "src/Network/Multicast.hsc" #-}

module Network.Multicast (
    -- * Simple sending and receiving
      multicastSender, multicastReceiver
    -- * Additional Socket operations
    , addMembership, dropMembership, setLoopbackMode
    -- * Loopback flags
    , LoopbackMode, enableLoopback, noLoopback
) where
import Network.BSD
import Network.Socket
import Foreign.C.Types
import Foreign.C.Error
import Foreign.Storable
import Foreign.Marshal
import Foreign.Ptr

type LoopbackMode = Bool

enableLoopback, noLoopback :: LoopbackMode
enableLoopback = True
noLoopback     = False

-- | Calling 'multicastSender' creates a client side UDP socket for sending
-- multicast datagrams to the specified host and port.
--
-- Minimal example:
--
-- > import Network.Socket
-- > import Network.Multicast
-- > main = withSocketsDo $ do
-- >     (sock, addr) <- multicastSender "224.0.0.99" 9999 noLoopback
-- >     let loop = do
-- >         sendTo sock "Hello, world" addr
-- >         loop in loop
--
multicastSender :: HostName -> PortNumber -> LoopbackMode -> IO (Socket, SockAddr)
multicastSender host port loop = do
    proto <- getProtocolNumber "udp"
    sock  <- socket AF_INET Datagram proto
    if loop then return () else setLoopbackMode sock loop
    host  <- inet_addr host
    let addr = SockAddrInet port host
    return (sock, addr)

-- | Calling 'multicastReceiver' creates and binds a UDP socket for listening
-- multicast datagrams on the specified host and port.
--
-- Minimal example:
--
-- > import Network.Socket
-- > import Network.Multicast
-- > main = withSocketsDo $ do
-- >     sock <- multicastReceiver "224.0.0.99" 9999
-- >     let loop = do
-- >         (msg, _, addr) <- recvFrom sock 1024
-- >         print (msg, addr) in loop
--
multicastReceiver :: HostName -> PortNumber -> IO Socket
multicastReceiver host port = do
    proto <- getProtocolNumber "udp"
    sock  <- socket AF_INET Datagram proto
    addMembership sock host

{-# LINE 82 "src/Network/Multicast.hsc" #-}
    host  <- inet_addr host
    let addr = SockAddrInet port host
    bindSocket sock addr
    return sock

-- | Enable or disable the loopback mode on a socket created by 'multicastSender'.
-- Loopback is enabled by default; disabling it may improve performance a little bit.
setLoopbackMode :: Socket -> LoopbackMode -> IO ()
setLoopbackMode (MkSocket s _ _ _ _) mode = maybeIOError "setLoopbackMode" $
    alloca $ \loopPtr -> do
        let loop = if mode then 1 else 0 :: CUChar
        poke loopPtr loop
        c_setsockopt s _IPPROTO_IP _IP_MULTICAST_LOOP (castPtr loopPtr) (toEnum $ sizeOf loop)

-- | Make the socket listen on multicast datagrams sent by the specified 'HostName'.
addMembership :: Socket -> HostName -> IO ()
addMembership s = maybeIOError "addMembership" . doMulticastGroup _IP_ADD_MEMBERSHIP s

-- | Stop the socket from listening on multicast datagrams sent by the specified 'HostName'.
dropMembership :: Socket -> HostName -> IO ()
dropMembership s = maybeIOError "dropMembership" . doMulticastGroup _IP_DROP_MEMBERSHIP s

maybeIOError :: String -> IO CInt -> IO ()
maybeIOError name f = f >>= \err -> case err of
    0 -> return ()
    _ -> ioError (errnoToIOError name (Errno (fromIntegral err)) Nothing Nothing)

doMulticastGroup :: CInt -> Socket -> HostName -> IO CInt
doMulticastGroup flag (MkSocket s _ _ _ _) host = allocaBytes (8) $ \mReqPtr -> do
{-# LINE 111 "src/Network/Multicast.hsc" #-}
    addr <- inet_addr host
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) mReqPtr addr
{-# LINE 113 "src/Network/Multicast.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) mReqPtr (0 `asTypeOf` addr)
{-# LINE 114 "src/Network/Multicast.hsc" #-}
    c_setsockopt s _IPPROTO_IP flag (castPtr mReqPtr) ((8))
{-# LINE 115 "src/Network/Multicast.hsc" #-}


{-# LINE 119 "src/Network/Multicast.hsc" #-}
foreign import ccall unsafe "setsockopt"

{-# LINE 121 "src/Network/Multicast.hsc" #-}
    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt

_IPPROTO_IP :: CInt
_IPPROTO_IP = 0
{-# LINE 125 "src/Network/Multicast.hsc" #-}

_IP_ADD_MEMBERSHIP, _IP_DROP_MEMBERSHIP, _IP_MULTICAST_LOOP :: CInt
_IP_ADD_MEMBERSHIP  = 35
{-# LINE 128 "src/Network/Multicast.hsc" #-}
_IP_DROP_MEMBERSHIP = 36
{-# LINE 129 "src/Network/Multicast.hsc" #-}
_IP_MULTICAST_LOOP  = 34
{-# LINE 130 "src/Network/Multicast.hsc" #-}