    {-# LINE 1 "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.
    --
    -----------------------------------------------------------------------------

    module Network.Multicast (
        -- * Simple sending and receiving
          multicastSender, multicastReceiver
        -- * Additional Socket operations
        , addMembership, dropMembership
        , setLoopbackMode, setTimeToLive, setInterface
        -- * Socket options
        , TimeToLive, 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
    import Control.Exception (bracketOnError)
    import Data.Word (Word32)

    type TimeToLive = Int
    type LoopbackMode = Bool

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

    inet_addr :: HostName -> IO HostAddress
    inet_addr :: HostName -> IO Word32
    inet_addr = (HostEntry -> Word32) -> IO HostEntry -> IO Word32
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HostEntry -> Word32
    hostAddress (IO HostEntry -> IO Word32)
    -> (HostName -> IO HostEntry) -> HostName -> IO Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HostName -> IO HostEntry
    getHostByName

    -- | 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
    -- >     let loop = do
    -- >         sendTo sock "Hello, world" addr
    -- >         loop in loop
    --
    multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr)
    multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr)
    multicastSender HostName
    host PortNumber
    port = do
        addr  <- (Word32 -> SockAddr) -> IO Word32 -> IO SockAddr
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (PortNumber -> Word32 -> SockAddr
    SockAddrInet PortNumber
    port) (HostName -> IO Word32
    Network.Multicast.inet_addr HostName
    host)
        proto <- getProtocolNumber "udp"
        sock  <- socket AF_INET Datagram proto
        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 :: HostName -> PortNumber -> IO Socket
    multicastReceiver HostName
    host PortNumber
    port = IO Socket
    -> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError IO Socket
    get Socket -> IO ()
    close Socket -> IO Socket
    setup
      where
        get :: IO Socket
        get :: IO Socket
    get = do
          proto <- HostName -> IO CInt
    getProtocolNumber HostName
    "udp"
          sock  <- socket AF_INET Datagram proto

    {-# LINE 90 "src/Network/Multicast.hsc" #-}
          setSocketOption sock ReuseAddr 1
          return sock

    {-# LINE 93 "src/Network/Multicast.hsc" #-}
        setup :: Socket -> IO Socket
        setup :: Socket -> IO Socket
    setup Socket
    sock = do
          Socket -> SockAddr -> IO ()
    bind Socket
    sock (SockAddr -> IO ()) -> SockAddr -> IO ()
    forall a b. (a -> b) -> a -> b
    $ PortNumber -> Word32 -> SockAddr
    SockAddrInet PortNumber
    port Word32
    Network.Multicast.iNADDR_ANY
          Socket -> HostName -> Maybe HostName -> IO ()
    addMembership Socket
    sock HostName
    host Maybe HostName
    forall a. Maybe a
    Nothing
          Socket -> IO Socket
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Socket
    sock

    iNADDR_ANY :: HostAddress
    iNADDR_ANY :: Word32
    iNADDR_ANY = Word32 -> Word32
    Network.Multicast.htonl Word32
    0

    -- | Converts the from host byte order to network byte order.
    foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32

    class IOCompat f where ioCompat :: f -> (Socket -> IO CInt)
    instance IOCompat (Socket -> IO CInt) where ioCompat :: (Socket -> IO CInt) -> Socket -> IO CInt
    ioCompat = (Socket -> IO CInt) -> Socket -> IO CInt
    forall a. a -> a
    id
    instance IOCompat (Socket -> CInt) where ioCompat :: (Socket -> CInt) -> Socket -> IO CInt
    ioCompat = (CInt -> IO CInt
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> IO CInt) -> (Socket -> CInt) -> Socket -> IO CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .)

    doSetSocketOption :: Storable a => CInt -> Socket -> a -> IO CInt
    doSetSocketOption :: forall a. Storable a => CInt -> Socket -> a -> IO CInt
    doSetSocketOption CInt
    ip_multicast_option Socket
    sock a
    x = (Ptr a -> IO CInt) -> IO CInt
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr a -> IO CInt) -> IO CInt) -> (Ptr a -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr -> do
        Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr a
    ptr a
    x
        fd <- ((Socket -> IO CInt) -> Socket -> IO CInt
    forall f. IOCompat f => f -> Socket -> IO CInt
    ioCompat Socket -> IO CInt
    fdSocket) Socket
    sock
        c_setsockopt fd _IPPROTO_IP ip_multicast_option (castPtr ptr) (toEnum $ sizeOf x)

    -- | 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 :: Socket -> LoopbackMode -> IO ()
    setLoopbackMode Socket
    sock LoopbackMode
    mode = HostName -> IO CInt -> IO ()
    maybeIOError HostName
    "setLoopbackMode" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let loop :: CUChar
    loop = if LoopbackMode
    mode then CUChar
    1 else CUChar
    0 :: CUChar
        CInt -> Socket -> CUChar -> IO CInt
    forall a. Storable a => CInt -> Socket -> a -> IO CInt
    doSetSocketOption CInt
    _IP_MULTICAST_LOOP Socket
    sock CUChar
    loop

    -- | Set the Time-to-Live of the multicast.
    setTimeToLive :: Socket -> TimeToLive -> IO ()
    setTimeToLive :: Socket -> Int -> IO ()
    setTimeToLive Socket
    sock Int
    ttl = HostName -> IO CInt -> IO ()
    maybeIOError HostName
    "setTimeToLive" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let val :: CInt
    val = Int -> CInt
    forall a. Enum a => Int -> a
    toEnum Int
    ttl :: CInt
        CInt -> Socket -> CInt -> IO CInt
    forall a. Storable a => CInt -> Socket -> a -> IO CInt
    doSetSocketOption CInt
    _IP_MULTICAST_TTL Socket
    sock CInt
    val

    -- | Set the outgoing interface address of the multicast.
    setInterface :: Socket -> HostName -> IO ()
    setInterface :: Socket -> HostName -> IO ()
    setInterface Socket
    sock HostName
    host = HostName -> IO CInt -> IO ()
    maybeIOError HostName
    "setInterface" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        addr <- HostName -> IO Word32
    Network.Multicast.inet_addr HostName
    host
        doSetSocketOption _IP_MULTICAST_IF sock addr

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

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

    maybeIOError :: String -> IO CInt -> IO ()
    maybeIOError :: HostName -> IO CInt -> IO ()
    maybeIOError HostName
    name IO CInt
    f = IO CInt
    f IO CInt -> (CInt -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \CInt
    err -> case CInt
    err of
        CInt
    0 -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        CInt
    _ -> IOError -> IO ()
    forall a. IOError -> IO a
    ioError (HostName -> Errno -> Maybe Handle -> Maybe HostName -> IOError
    errnoToIOError HostName
    name (CInt -> Errno
    Errno (CInt -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    err)) Maybe Handle
    forall a. Maybe a
    Nothing Maybe HostName
    forall a. Maybe a
    Nothing)

    doMulticastGroup :: CInt -> Socket -> HostName -> Maybe HostName -> IO CInt
    doMulticastGroup :: CInt -> Socket -> HostName -> Maybe HostName -> IO CInt
    doMulticastGroup CInt
    flag Socket
    sock HostName
    host Maybe HostName
    local = Int -> (Ptr (ZonkAny 0) -> IO CInt) -> IO CInt
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes (Int
    8) ((Ptr (ZonkAny 0) -> IO CInt) -> IO CInt)
    -> (Ptr (ZonkAny 0) -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ \Ptr (ZonkAny 0)
    mReqPtr -> do
    {-# LINE 149 "src/Network/Multicast.hsc" #-}
        addr <- Network.Multicast.inet_addr host
        iface <- case local of
            Nothing -> return (0 `asTypeOf` addr)
    {-# LINE 152 "src/Network/Multicast.hsc" #-}
            Just loc -> Network.Multicast.inet_addr loc
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) mReqPtr addr
    {-# LINE 154 "src/Network/Multicast.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4) mReqPtr iface
    {-# LINE 155 "src/Network/Multicast.hsc" #-}
        fd <- (ioCompat fdSocket) sock
        c_setsockopt fd _IPPROTO_IP flag (castPtr mReqPtr) ((8))
    {-# LINE 157 "src/Network/Multicast.hsc" #-}

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

    foreign import ccall unsafe "setsockopt"
        c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt

    getLastError :: CInt -> IO CInt
    getLastError :: CInt -> IO CInt
    getLastError = CInt -> IO CInt
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    _IP_MULTICAST_IF, _IP_MULTICAST_TTL, _IP_MULTICAST_LOOP, _IP_ADD_MEMBERSHIP, _IP_DROP_MEMBERSHIP :: CInt
    _IP_MULTICAST_IF :: CInt
    _IP_MULTICAST_IF    = CInt
    32
    {-# LINE 185 "src/Network/Multicast.hsc" #-}
    _IP_MULTICAST_TTL   = 33
    {-# LINE 186 "src/Network/Multicast.hsc" #-}
    _IP_MULTICAST_LOOP  = 34
    {-# LINE 187 "src/Network/Multicast.hsc" #-}
    _IP_ADD_MEMBERSHIP  = 35
    {-# LINE 188 "src/Network/Multicast.hsc" #-}
    _IP_DROP_MEMBERSHIP = 36
    {-# LINE 189 "src/Network/Multicast.hsc" #-}

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

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