Support Wasm/WASI

Author: amesgen

Network/Socket/Buffer.hsc

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 
+#include "HsNet.h"
 ##include "HsNetDef.h"
 #if defined(mingw32_HOST_OS)
 #  include "windows.h"
@@ -57,6 +58,7 @@ sendBufTo :: SocketAddress sa =>
           -> Int         -- Data to send
           -> sa
           -> IO Int      -- Number of Bytes sent
+#ifdef HAVE_SENDTO
 sendBufTo s ptr nbytes sa =
   withSocketAddress sa $ \p_sa siz -> fromIntegral <$> do
     withFdSocket s $ \fd -> do
@@ -65,6 +67,10 @@ sendBufTo s ptr nbytes sa =
             flags = 0
         throwSocketErrorWaitWrite s "Network.Socket.sendBufTo" $
           c_sendto fd ptr n flags p_sa sz
+#else
+sendBufTo _ _ _ _ = unsupported "sendBufTo"
+{-# WARNING sendBufTo "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 #if defined(mingw32_HOST_OS)
 socket2FD :: Socket -> IO FD
@@ -112,6 +118,7 @@ sendBuf s str len = fromIntegral <$> do
 -- NOTE: blocking on Windows unless you compile with -threaded (see
 -- GHC ticket #1129)
 recvBufFrom :: SocketAddress sa => Socket -> Ptr a -> Int -> IO (Int, sa)
+#ifdef HAVE_RECVFROM
 recvBufFrom s ptr nbytes
     | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBufFrom")
     | otherwise = withNewSocketAddress $ \ptr_sa sz -> alloca $ \ptr_len ->
@@ -124,6 +131,10 @@ recvBufFrom s ptr nbytes
             sockaddr <- peekSocketAddress ptr_sa
                 `catchIOError` \_ -> getPeerName s
             return (fromIntegral len, sockaddr)
+#else
+recvBufFrom _ _ _ = unsupported "recvBufFrom"
+{-# WARNING recvBufFrom "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 -- | Receive data from the socket.  The socket must be in a connected
 -- state. This function may return fewer bytes than specified.  If the
@@ -204,6 +215,7 @@ sendBufMsg :: SocketAddress sa
            -> [Cmsg]            -- ^ Control messages
            -> MsgFlag           -- ^ Message flags
            -> IO Int            -- ^ The length actually sent
+#ifdef HAVE_STRUCT_CMSGHDR
 sendBufMsg s sa bufsizs cmsgs flags = do
   sz <- withSocketAddress sa $ \addrPtr addrSize ->
 #if !defined(mingw32_HOST_OS)
@@ -237,6 +249,10 @@ sendBufMsg s sa bufsizs cmsgs flags = do
                 c_sendmsg fd msgHdrPtr (fromIntegral cflags) send_ptr nullPtr nullPtr
 #endif
   return $ fromIntegral sz
+#else
+sendBufMsg _ _ _ _ _ = unsupported "sendBufMsg"
+{-# WARNING sendBufMsg "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 -- | Receive data from the socket using recvmsg(2). The supplied
 --   buffers are filled in order, with subsequent buffers used only
@@ -252,6 +268,7 @@ recvBufMsg :: SocketAddress sa
                                 --   'MSG_CTRUNC' is returned
            -> MsgFlag           -- ^ Message flags
            -> IO (sa,Int,[Cmsg],MsgFlag) -- ^ Source address, total bytes received, control messages and message flags
+#ifdef HAVE_STRUCT_CMSGHDR
 recvBufMsg s bufsizs clen flags = do
   withNewSocketAddress $ \addrPtr addrSize ->
     allocaBytes clen $ \ctrlPtr ->
@@ -295,6 +312,10 @@ recvBufMsg s bufsizs clen flags = do
             cmsgs <- parseCmsgs msgHdrPtr
             let flags' = MsgFlag $ fromIntegral $ msgFlags hdr
             return (sockaddr, len, cmsgs, flags')
+#else
+recvBufMsg _ _ _ _ = unsupported "recvBufMsg"
+{-# WARNING recvBufMsg "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 #if !defined(mingw32_HOST_OS)
 foreign import ccall unsafe "send"
@@ -317,8 +338,11 @@ foreign import CALLCONV SAFE_ON_WIN "WSARecvMsg"
 
 foreign import ccall unsafe "recv"
   c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt
+#ifdef HAVE_SENDTO
 foreign import CALLCONV SAFE_ON_WIN "sendto"
   c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> CInt -> IO CInt
+#endif
+#ifdef HAVE_RECVFROM
 foreign import CALLCONV SAFE_ON_WIN "recvfrom"
   c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> Ptr CInt -> IO CInt
-
+#endif

Network/Socket/Cbits.hsc

@@ -7,8 +7,14 @@ import Network.Socket.Imports
 -- | This is the value of SOMAXCONN, typically 128.
 -- 128 is good enough for normal network servers but
 -- is too small for high performance servers.
+--
+-- TODO what if not present
 maxListenQueue :: Int
+#ifdef SOMAXCONN
 maxListenQueue = #const SOMAXCONN
+#else
+maxListenQueue = 1
+#endif
 
 #if defined(mingw32_HOST_OS)
 wsaNotInitialized :: CInt

Network/Socket/If.hs

@@ -10,29 +10,46 @@ module Network.Socket.If (
 import Foreign.Marshal.Alloc (allocaBytes)
 
 import Network.Socket.Imports
+#if !defined(HAVE_IF_NAMETOINDEX) || !defined(HAVE_IF_INDEXTONAME)
+import Network.Socket.Internal (unsupported)
+#endif
 
 -- | Returns the index corresponding to the interface name.
 --
 --   Since 2.7.0.0.
 ifNameToIndex :: String -> IO (Maybe Int)
+#ifdef HAVE_IF_NAMETOINDEX
 ifNameToIndex ifname = do
   index <- withCString ifname c_if_nametoindex
   -- On failure zero is returned. We'll return Nothing.
   return $ if index == 0 then Nothing else Just $ fromIntegral index
+#else
+ifNameToIndex _ = unsupported "ifNameToIndex"
+{-# WARNING ifNameToIndex "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 -- | Returns the interface name corresponding to the index.
 --
 --   Since 2.7.0.0.
 ifIndexToName :: Int -> IO (Maybe String)
+#ifdef HAVE_IF_INDEXTONAME
 ifIndexToName ifn = allocaBytes 16 $ \ptr -> do -- 16 == IFNAMSIZ
     r <- c_if_indextoname (fromIntegral ifn) ptr
     if r == nullPtr then
         return Nothing
       else
         Just <$> peekCString ptr
+#else
+ifIndexToName _ = unsupported "ifIndexToName"
+{-# WARNING ifIndexToName "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
+#ifdef HAVE_IF_NAMETOINDEX
 foreign import CALLCONV safe "if_nametoindex"
    c_if_nametoindex :: CString -> IO CUInt
+#endif
 
+#ifdef HAVE_IF_INDEXTONAME
 foreign import CALLCONV safe "if_indextoname"
    c_if_indextoname :: CUInt -> CString -> IO CString
+#endif

Network/Socket/Info.hsc

@@ -81,14 +81,26 @@ aiFlagMapping =
 #else
      (AI_ALL, 0),
 #endif
+#if HAVE_DECL_AI_CANONNAME
      (AI_CANONNAME, #const AI_CANONNAME),
+#else
+     (AI_CANONNAME, 0),
+#endif
+#if HAVE_DECL_AI_NUMERICHOST
      (AI_NUMERICHOST, #const AI_NUMERICHOST),
+#else
+     (AI_NUMERICHOST, 0),
+#endif
 #if HAVE_DECL_AI_NUMERICSERV
      (AI_NUMERICSERV, #const AI_NUMERICSERV),
 #else
      (AI_NUMERICSERV, 0),
 #endif
+#if HAVE_DECL_AI_PASSIVE
      (AI_PASSIVE, #const AI_PASSIVE),
+#else
+     (AI_PASSIVE, 0),
+#endif
 #if HAVE_DECL_AI_V4MAPPED
      (AI_V4MAPPED, #const AI_V4MAPPED)
 #else
@@ -110,6 +122,7 @@ data AddrInfo = AddrInfo {
   , addrCanonName :: Maybe String
   } deriving (Eq, Show)
 
+#if HAVE_STRUCT_ADDRINFO
 instance Storable AddrInfo where
     sizeOf    ~_ = #const sizeof(struct addrinfo)
     alignment ~_ = alignment (0 :: CInt)
@@ -149,6 +162,8 @@ instance Storable AddrInfo where
         (#poke struct addrinfo, ai_addr) p nullPtr
         (#poke struct addrinfo, ai_canonname) p nullPtr
         (#poke struct addrinfo, ai_next) p nullPtr
+#else
+#endif
 
 -- | Flags that control the querying behaviour of 'getNameInfo'.
 --   For more information, see <https://tools.ietf.org/html/rfc3493#page-30>
@@ -176,11 +191,34 @@ data NameInfoFlag =
 
 niFlagMapping :: [(NameInfoFlag, CInt)]
 
-niFlagMapping = [(NI_DGRAM, #const NI_DGRAM),
-                 (NI_NAMEREQD, #const NI_NAMEREQD),
-                 (NI_NOFQDN, #const NI_NOFQDN),
-                 (NI_NUMERICHOST, #const NI_NUMERICHOST),
-                 (NI_NUMERICSERV, #const NI_NUMERICSERV)]
+niFlagMapping =
+    [
+#if HAVE_DECL_NI_
+     (NI_DGRAM, #const NI_DGRAM),
+#else
+     (NI_DGRAM, 0),
+#endif
+#if HAVE_DECL_NI_NAMEREQD
+     (NI_NAMEREQD, #const NI_NAMEREQD),
+#else
+     (NI_NAMEREQD, 0),
+#endif
+#if HAVE_DECL_NI_NOFQDN
+     (NI_NOFQDN, #const NI_NOFQDN),
+#else
+     (NI_NOFQDN, 0),
+#endif
+#if HAVE_DECL_NI_NUMERICHOST
+     (NI_NUMERICHOST, #const NI_NUMERICHOST),
+#else
+     (NI_NUMERICHOST, 0),
+#endif
+#if HAVE_DECL_NI_NUMERICSERV
+     (NI_NUMERICSERV, #const NI_NUMERICSERV)
+#else
+     (NI_NUMERICSERV, 0)
+#endif
+    ]
 
 -- | Default hints for address lookup with 'getAddrInfo'.
 --
@@ -268,6 +306,7 @@ getAddrInfoNE
     -> Maybe HostName -- ^ host name to look up
     -> Maybe ServiceName -- ^ service name to look up
     -> IO (NonEmpty AddrInfo) -- ^ resolved addresses, with "best" first
+#if HAVE_GETADDRINFO
 getAddrInfoNE hints node service = alloc getaddrinfo
   where
     alloc body = withSocketsDo $ maybeWith withCString node $ \c_node ->
@@ -308,15 +347,6 @@ getAddrInfoNE hints node service = alloc getaddrinfo
     filteredHints = hints
 #endif
 
-getAddrInfoList
-    :: Maybe AddrInfo
-    -> Maybe HostName
-    -> Maybe ServiceName
-    -> IO [AddrInfo]
-getAddrInfoList hints node service =
-    -- getAddrInfo never returns an empty list.
-    NE.toList <$> getAddrInfoNE hints node service
-
 followAddrInfo :: Ptr AddrInfo -> IO (NonEmpty AddrInfo)
 followAddrInfo ptr_ai
     -- POSIX requires that getaddrinfo(3) returns at least one addrinfo.
@@ -342,6 +372,10 @@ foreign import ccall safe "hsnet_getaddrinfo"
 
 foreign import ccall safe "hsnet_freeaddrinfo"
     c_freeaddrinfo :: Ptr AddrInfo -> IO ()
+#else
+getAddrInfoNE _ _ _ = unsupported "getAddrInfoNE"
+{-# WARNING getAddrInfo "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 gai_strerror :: CInt -> IO String
 
@@ -354,6 +388,15 @@ foreign import ccall safe "gai_strerror"
 gai_strerror n = ioError $ userError $ "Network.Socket.gai_strerror not supported: " ++ show n
 #endif
 
+getAddrInfoList
+    :: Maybe AddrInfo
+    -> Maybe HostName
+    -> Maybe ServiceName
+    -> IO [AddrInfo]
+getAddrInfoList hints node service =
+    -- getAddrInfo never returns an empty list.
+    NE.toList <$> getAddrInfoNE hints node service
+
 -----------------------------------------------------------------------------
 
 withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a
@@ -382,6 +425,7 @@ getNameInfo
     -> Bool -- ^ whether to look up a service name
     -> SockAddr -- ^ the address to look up
     -> IO (Maybe HostName, Maybe ServiceName)
+#if HAVE_GETNAMEINFO
 getNameInfo flags doHost doService addr = alloc getnameinfo
   where
     alloc body = withSocketsDo $
@@ -423,6 +467,10 @@ getNameInfo flags doHost doService addr = alloc getnameinfo
 foreign import ccall safe "hsnet_getnameinfo"
     c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString
                   -> CSize -> CInt -> IO CInt
+#else
+getNameInfo _ _ _ _ = unsupported "getNameInfo"
+{-# WARNING getNameInfo "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 -- | Pack a list of values into a bitmask.  The possible mappings from
 -- value to bit-to-set are given as the first argument.  We assume

Network/Socket/Internal.hs

@@ -51,6 +51,9 @@ module Network.Socket.Internal
     -- * Null socket address type
     , NullSockAddr (..)
 
+    -- * Unsupported functionality
+    , unsupported
+
     -- * Low-level helpers
     , zeroMemory
     ) where

Network/Socket/Name.hs

@@ -17,13 +17,18 @@ import Network.Socket.Types
 
 -- | Getting peer's socket address.
 getPeerName :: SocketAddress sa => Socket -> IO sa
+#ifdef HAVE_GETPEERNAME
 getPeerName s =
  withNewSocketAddress $ \ptr sz ->
    with (fromIntegral sz) $ \int_star -> withFdSocket s $ \fd -> do
      throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerName" $
        c_getpeername fd ptr int_star
      _sz <- peek int_star
      peekSocketAddress ptr
+#else
+getPeerName _ = unsupported "getPeerName"
+{-# WARNING getPeerName "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 -- | Getting my socket address.
 getSocketName :: SocketAddress sa => Socket -> IO sa
@@ -34,8 +39,10 @@ getSocketName s =
        c_getsockname fd ptr int_star
      peekSocketAddress ptr
 
+#ifdef HAVE_GETPEERNAME
 foreign import CALLCONV unsafe "getpeername"
   c_getpeername :: CInt -> Ptr sa -> Ptr CInt -> IO CInt
+#endif
 foreign import CALLCONV unsafe "getsockname"
   c_getsockname :: CInt -> Ptr sa -> Ptr CInt -> IO CInt
 

Network/Socket/Options.hsc

@@ -404,12 +404,17 @@ setSockOpt :: Storable a
            -> SocketOption
            -> a
            -> IO ()
+#ifdef HAVE_SETSOCKOPT
 setSockOpt s (SockOpt level opt) v = do
     with v $ \ptr -> void $ do
         let sz = fromIntegral $ sizeOf v
         withFdSocket s $ \fd ->
           throwSocketErrorIfMinus1_ "Network.Socket.setSockOpt" $
           c_setsockopt fd level opt ptr sz
+#else
+setSockOpt _ _ _  = unsupported "setSockOpt"
+{-# WARNING setSockOpt "operation will throw 'IOError' \"unsupported operation\"" #-}
+#endif
 
 -- | Set a socket option value
 --
@@ -474,7 +479,7 @@ getSocketType s = unpackSocketType <$> getSockOpt s Type
 #if __GLASGOW_HASKELL__ >= 806
 {-# COMPLETE CustomSockOpt #-}
 #endif
-#ifdef SO_LINGER
+
 -- | Low level @SO_LINGER@ option value, which can be used with 'setSockOpt' or
 -- @'setSockOptValue' . 'SockOptValue'@.
 data StructLinger = StructLinger {
@@ -486,6 +491,7 @@ data StructLinger = StructLinger {
   }
   deriving (Eq, Ord, Show)
 
+#ifdef SO_LINGER
 instance Storable StructLinger where
     sizeOf    ~_ = (#const sizeof(struct linger))
     alignment ~_ = alignment (0 :: CInt)
@@ -540,5 +546,7 @@ instance Storable SocketTimeout where
 
 foreign import CALLCONV unsafe "getsockopt"
   c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt
+#ifdef HAVE_SETSOCKOPT
 foreign import CALLCONV unsafe "setsockopt"
   c_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt
+#endif