Socket type and family as CInt patterns

The current sum-type model for Socket types and families is not extensible, and
makes it needlessly difficult to perform generic operations on sockets, see
e.g. #427

This commit, simplifies the model by replacing the sum-types in question with
newtypes around CInt + patterns for the known constant values.  It also adds
the SO_DOMAIN and SO_PROTOCOL options (when available on the target system).

The "Read" instance for "Family" is for simplicify limited to just the address
families actually supported by the library (unspec, inet, inet6 and unix).
The rest could be added if deemed worth the trouble.

Author: hs-viktor

Network/Socket.hs

@@ -134,9 +134,9 @@ module Network.Socket
 
     -- * Socket options
     , SocketOption(SockOpt
-                  ,Debug,ReuseAddr,Type,SoError,DontRoute,Broadcast
-                  ,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
-                  ,MaxSegment,NoDelay,Cork,Linger,ReusePort
+                  ,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute
+                  ,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline
+                  ,TimeToLive,MaxSegment,NoDelay,Cork,Linger,ReusePort
                   ,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
                   ,UseLoopBack,UserTimeout,IPv6Only
                   ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo
@@ -160,11 +160,22 @@ module Network.Socket
     , mkSocket
     , socketToHandle
     -- ** Types of Socket
-    , SocketType(..)
+    , SocketType(GeneralSocketType, UnsupportedSocketType, NoSocketType
+                , Stream, Datagram, Raw, RDM, SeqPacket)
     , isSupportedSocketType
     , getSocketType
     -- ** Family
-    , Family(..)
+    , Family(GeneralFamily, UnsupportedFamily
+            ,AF_UNSPEC,AF_UNIX,AF_INET,AF_INET6,AF_IMPLINK,AF_PUP,AF_CHAOS
+            ,AF_NS,AF_NBS,AF_ECMA,AF_DATAKIT,AF_CCITT,AF_SNA,AF_DECnet
+            ,AF_DLI,AF_LAT,AF_HYLINK,AF_APPLETALK,AF_ROUTE,AF_NETBIOS
+            ,AF_NIT,AF_802,AF_ISO,AF_OSI,AF_NETMAN,AF_X25,AF_AX25,AF_OSINET
+            ,AF_GOSSIP,AF_IPX,Pseudo_AF_XTP,AF_CTF,AF_WAN,AF_SDL,AF_NETWARE
+            ,AF_NDD,AF_INTF,AF_COIP,AF_CNT,Pseudo_AF_RTIP,Pseudo_AF_PIP
+            ,AF_SIP,AF_ISDN,Pseudo_AF_KEY,AF_NATM,AF_ARP,Pseudo_AF_HDRCMPLT
+            ,AF_ENCAP,AF_LINK,AF_RAW,AF_RIF,AF_NETROM,AF_BRIDGE,AF_ATMPVC
+            ,AF_ROSE,AF_NETBEUI,AF_SECURITY,AF_PACKET,AF_ASH,AF_ECONET
+            ,AF_ATMSVC,AF_IRDA,AF_PPPOX,AF_WANPIPE,AF_BLUETOOTH,AF_CAN)
     , isSupportedFamily
     , packFamily
     , unpackFamily

Network/Socket/Info.hsc

@@ -124,18 +124,17 @@ instance Storable AddrInfo where
                         then return Nothing
                         else Just <$> peekCString ai_canonname_ptr
 
-        socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype
         return $ AddrInfo {
             addrFlags = unpackBits aiFlagMapping ai_flags
           , addrFamily = unpackFamily ai_family
-          , addrSocketType = socktype
+          , addrSocketType = unpackSocketType ai_socktype
           , addrProtocol = ai_protocol
           , addrAddress = ai_addr
           , addrCanonName = ai_canonname
           }
 
     poke p (AddrInfo flags family sockType protocol _ _) = do
-        c_stype <- packSocketTypeOrThrow "AddrInfo.poke" sockType
+        let c_stype = packSocketType sockType
 
         (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags)
         (#poke struct addrinfo, ai_family) p (packFamily family)

Network/Socket/Options.hsc

@@ -9,8 +9,8 @@
 
 module Network.Socket.Options (
     SocketOption(SockOpt
-                ,Debug,ReuseAddr,Type,SoError,DontRoute,Broadcast
-                ,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
+                ,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute
+                ,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
                 ,MaxSegment,NoDelay,Cork,Linger,ReusePort
                 ,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
                 ,UseLoopBack,UserTimeout,IPv6Only
@@ -53,8 +53,7 @@ isSupportedSocketOption opt = opt /= SockOpt (-1) (-1)
 --
 --   Since: 3.0.1.0
 getSocketType :: Socket -> IO SocketType
-getSocketType s = (fromMaybe NoSocketType . unpackSocketType . fromIntegral)
-                    <$> getSocketOption s Type
+getSocketType s = unpackSocketType <$> getSockOpt s Type
 
 #ifdef SOL_SOCKET
 -- | SO_DEBUG
@@ -71,13 +70,31 @@ pattern ReuseAddr      = SockOpt (#const SOL_SOCKET) (#const SO_REUSEADDR)
 #else
 pattern ReuseAddr      = SockOpt (-1) (-1)
 #endif
--- | SO_TYPE
+
+-- | SO_DOMAIN, read-only
+pattern SoDomain :: SocketOption
+#ifdef SO_DOMAIN
+pattern SoDomain       = SockOpt (#const SOL_SOCKET) (#const SO_DOMAIN)
+#else
+pattern SoDomain       = SockOpt (-1) (-1)
+#endif
+
+-- | SO_TYPE, read-only
 pattern Type :: SocketOption
 #ifdef SO_TYPE
 pattern Type           = SockOpt (#const SOL_SOCKET) (#const SO_TYPE)
 #else
 pattern Type           = SockOpt (-1) (-1)
 #endif
+
+-- | SO_PROTOCOL, read-only
+pattern SoProtocol :: SocketOption
+#ifdef SO_PROTOCOL
+pattern SoProtocol     = SockOpt (#const SOL_SOCKET) (#const SO_PROTOCOL)
+#else
+pattern SoProtocol     = SockOpt (-1) (-1)
+#endif
+
 -- | SO_ERROR
 pattern SoError :: SocketOption
 #ifdef SO_ERROR

Network/Socket/Syscall.hs

@@ -84,7 +84,7 @@ socket family stype protocol = E.bracketOnError create c_close $ \fd -> do
     return s
   where
     create = do
-        c_stype <- modifyFlag <$> packSocketTypeOrThrow "socket" stype
+        let c_stype = modifyFlag $ packSocketType stype
         throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
             c_socket (packFamily family) c_stype protocol