Multicast support

Network/Socket.hs

@@ -170,7 +170,12 @@ module Network.Socket (
         DontFragment,
         RecvIPv6HopLimit,
         RecvIPv6TClass,
-        RecvIPv6PktInfo
+        RecvIPv6PktInfo,
+        MulticastIF,
+        MulticastTTL,
+        MulticastLoop,
+        AddMembership,
+        DropMembership
     ),
     isSupportedSocketOption,
     whenSupported,
@@ -400,6 +405,9 @@ module Network.Socket (
 
     -- * Deprecated
     withSocketsDo,
+
+    -- * Multicast Group
+    MulticastGroup (..),
 ) where
 
 import Network.Socket.Buffer hiding (

Network/Socket/Options.hsc

@@ -18,6 +18,7 @@ module Network.Socket.Options (
                 ,UseLoopBack,UserTimeout,IPv6Only
                 ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo,DontFragment
                 ,RecvIPv6HopLimit,RecvIPv6TClass,RecvIPv6PktInfo
+                ,MulticastIF,MulticastTTL,MulticastLoop,AddMembership,DropMembership
                 ,CustomSockOpt)
   , isSupportedSocketOption
   , whenSupported
@@ -397,6 +398,48 @@ pattern RecvIPv6PktInfo = SockOpt (-1) (-1)
 #endif
 #endif // HAVE_DECL_IPPROTO_IPV6
 
+-- | Multicast interface.
+#ifdef IP_MULTICAST_IF
+pattern MulticastIF :: SocketOption
+pattern MulticastIF = SockOpt (#const IPPROTO_IP) (#const IP_MULTICAST_IF)
+#else
+pattern MulticastIF :: SocketOption
+pattern MulticastIF = SockOpt (-1) (-1)
+#endif
+-- | Multicast TTL.
+#ifdef IP_MULTICAST_TTL
+pattern MulticastTTL :: SocketOption
+pattern MulticastTTL = SockOpt (#const IPPROTO_IP) (#const IP_MULTICAST_TTL)
+#else
+pattern MulticastTTL :: SocketOption
+pattern MulticastTTL = SockOpt (-1) (-1)
+#endif
+-- | Multicast loopback.
+#ifdef IP_MULTICAST_LOOP
+pattern MulticastLoop :: SocketOption
+pattern MulticastLoop = SockOpt (#const IPPROTO_IP) (#const IP_MULTICAST_LOOP)
+#else
+pattern MulticastLoop :: SocketOption
+pattern MulticastLoop = SockOpt (-1) (-1)
+#endif
+-- | Add membership.
+#ifdef IP_ADD_MEMBERSHIP
+pattern AddMembership :: SocketOption
+pattern AddMembership = SockOpt (#const IPPROTO_IP) (#const IP_ADD_MEMBERSHIP)
+#else
+pattern AddMembership :: SocketOption
+pattern AddMembership = SockOpt (-1) (-1)
+#endif
+-- | Drop membership.
+#ifdef IP_DROP_MEMBERSHIP
+pattern DropMembership :: SocketOption
+pattern DropMembership = SockOpt (#const IPPROTO_IP) (#const IP_DROP_MEMBERSHIP)
+#else
+pattern DropMembership :: SocketOption
+pattern DropMembership = SockOpt (-1) (-1)
+#endif
+
+
 pattern CustomSockOpt :: (CInt, CInt) -> SocketOption
 pattern CustomSockOpt xy <- ((\(SockOpt x y) -> (x, y)) -> xy)
   where

Network/Socket/Types.hsc

@@ -85,6 +85,9 @@ module Network.Socket.Types (
     , htonl
     , ntohl
     , In6Addr(..)
+
+    -- * Multicast Group
+    , MulticastGroup(..)
     ) where
 
 import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef', mkWeakIORef, modifyIORef')
@@ -1528,3 +1531,27 @@ foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO ()
 -- | Zero a structure.
 zeroMemory :: Ptr a -> CSize -> IO ()
 zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes)
+
+
+------------------------------------------------------------------------
+-- Multicast Group
+
+data MulticastGroup = MulticastGroup
+    { groupAddress :: HostAddress
+    , localAddress :: Maybe HostAddress
+    } deriving (Show, Eq)
+
+instance Storable MulticastGroup where
+    sizeOf ~_ = #size struct ip_mreq
+    alignment ~_ = #alignment struct ip_mreq
+    peek p = do
+        g <- (#peek struct ip_mreq, imr_multiaddr) p
+        l <- (#peek struct ip_mreq, imr_interface) p
+        pure . MulticastGroup g $ case l of
+            0 -> Nothing
+            loc -> Just loc
+    poke p (MulticastGroup g l) = do
+        (#poke struct ip_mreq, imr_multiaddr) p g
+        (#poke struct ip_mreq, imr_interface) p (case l of
+            Nothing -> 0
+            Just loc -> loc)