Patches for compiling to wasm

Author: palas

cardano-diffusion/lib/Cardano/Network/Diffusion/Handlers.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 
 #if !defined(mingw32_HOST_OS)
 #define POSIX

cardano-diffusion/lib/Cardano/Network/NodeToClient.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE NamedFieldPuns      #-}
@@ -171,7 +172,11 @@ nodeToClientProtocols protocols _version _versionData =
 maximumMiniProtocolLimits :: MiniProtocolLimits
 maximumMiniProtocolLimits =
     MiniProtocolLimits {
+#if !defined(wasm32_HOST_ARCH)
       maximumIngressQueue = 0xffffffff
+#else
+      maximumIngressQueue = 0x7fffffff
+#endif
     }
 
 

cardano-diffusion/lib/Cardano/Network/NodeToNode.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE NamedFieldPuns      #-}
@@ -77,7 +78,11 @@ import Data.ByteString.Lazy qualified as BL
 import Data.Word
 
 import Network.Mux qualified as Mx
+#if !defined(wasm32_HOST_ARCH)
 import Network.Socket (Socket, StructLinger (..))
+#else
+import Network.Socket (Socket)
+#endif
 import Network.Socket qualified as Socket
 
 import Cardano.Network.NodeToNode.Version
@@ -401,6 +406,7 @@ connectTo
   -> Maybe Socket.SockAddr
   -> Socket.SockAddr
   -> IO (Either SomeException (Either a b))
+#if !defined(wasm32_HOST_ARCH)
 connectTo sn tr =
     connectToNode sn makeSocketBearer
                   ConnectToArgs {
@@ -418,7 +424,9 @@ connectTo sn tr =
         Socket.setSockOpt sock Socket.Linger
                               (StructLinger { sl_onoff  = 1,
                                               sl_linger = 0 })
-
+#else
+connectTo _ _ = error "connecTo not supported in wasm"
+#endif
 -- | Node-To-Node protocol connections which negotiated
 -- `InitiatorAndResponderDiffusionMode` are `Duplex`.
 --

ouroboros-network/demo/connection-manager.hs

@@ -12,6 +12,7 @@
 {-# LANGUAGE TupleSections            #-}
 {-# LANGUAGE TypeApplications         #-}
 {-# LANGUAGE TypeOperators            #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 
 -- just to use 'debugTracer'
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}

ouroboros-network/framework/io-tests/Test/Ouroboros/Network/Server/IO.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE PolyKinds           #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 
 #if __GLASGOW_HASKELL__ >= 908
 {-# OPTIONS_GHC -Wno-x-partial #-}

ouroboros-network/framework/io-tests/Test/Ouroboros/Network/Socket.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 
 {-# OPTIONS_GHC -Wno-orphans     #-}
 module Test.Ouroboros.Network.Socket (tests) where

ouroboros-network/framework/lib/Ouroboros/Network/Snocket.hs

@@ -10,6 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TypeSynonymInstances       #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 
 #if !defined(mingw32_HOST_OS)
 #define POSIX

ouroboros-network/framework/lib/Ouroboros/Network/Socket.hs

@@ -61,7 +61,9 @@ import Codec.CBOR.Read qualified as CBOR
 import Codec.CBOR.Term qualified as CBOR
 import Control.Applicative (Alternative)
 import Control.Concurrent.Class.MonadSTM.Strict
+#if !defined(wasm32_HOST_ARCH)
 import Control.Monad (unless, when)
+#endif
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTime.SI
@@ -72,8 +74,11 @@ import Data.Hashable
 import Data.Monoid.Synchronisation (FirstToFinish (..))
 import Data.Typeable (Typeable)
 import Data.Word (Word16)
-
+#if !defined(wasm32_HOST_ARCH)
 import Network.Socket (SockAddr, Socket, StructLinger (..))
+#else
+import Network.Socket (SockAddr, Socket)
+#endif
 import Network.Socket qualified as Socket
 
 import Control.Tracer
@@ -136,6 +141,7 @@ sockAddrFamily Socket.SockAddrUnix {}  = Socket.AF_UNIX
 -- is expected.
 --
 configureSocket :: Socket -> Maybe SockAddr -> IO ()
+#if !defined(wasm32_HOST_ARCH)
 configureSocket sock addr = do
     let fml = sockAddrFamily <$> addr
     Socket.setSocketOption sock Socket.ReuseAddr 1
@@ -157,14 +163,18 @@ configureSocket sock addr = do
       -- it is enabled by default on some systems. Disabled here since we run a separate
       -- IPv4 server instance if configured to use IPv4.
       $ Socket.setSocketOption sock Socket.IPv6Only 1
-
+#else
+configureSocket _ _ =
+    error "configureSocket not supported in wasm"
+#endif
 
 -- | Configure sockets passed through systemd socket activation.
 -- Currently 'ReuseAddr' and 'Linger' options are not configurable with
 -- 'systemd.socket', these options are set by this function.  For other socket
 -- options we only trace if they are not set.
 --
 configureSystemdSocket :: Tracer IO SystemdSocketTracer -> Socket -> SockAddr -> IO ()
+#if !defined(wasm32_HOST_ARCH)
 configureSystemdSocket tracer sock addr = do
    let fml = sockAddrFamily addr
    case fml of
@@ -190,6 +200,10 @@ configureSystemdSocket tracer sock addr = do
      ipv6OnlyOpt <- Socket.getSocketOption sock Socket.IPv6Only
      unless (ipv6OnlyOpt /= 0) $
        traceWith tracer (SocketOptionNotSet Socket.IPv6Only)
+#else
+configureSystemdSocket _ _ _ =
+    error "configureSystemdSocket not supported in wasm"
+#endif
 
 data SystemdSocketTracer = SocketOptionNotSet Socket.SocketOption
   deriving Show

ouroboros-network/ouroboros-network.cabal

@@ -464,9 +464,10 @@ test-suite tests-lib-tests
     tasty,
     tasty-quickcheck,
 
-  ghc-options:
-    -rtsopts
-    -threaded
+  if !arch(wasm32)
+    ghc-options:
+      -rtsopts
+      -threaded
 
 library framework-tests-lib
   import: ghc-options
@@ -532,9 +533,10 @@ test-suite framework-sim-tests
     typed-protocols:{typed-protocols, cborg, examples},
     with-utf8,
 
-  ghc-options:
-    -rtsopts
-    -threaded
+  if !arch(wasm32)
+    ghc-options:
+      -rtsopts
+      -threaded
 
   if flag(ipv6)
     cpp-options: -DOUROBOROS_NETWORK_IPV6
@@ -574,6 +576,8 @@ test-suite framework-io-tests
   ghc-options:
     -rtsopts
     -threaded
+  if arch(wasm32)
+    buildable: False
 
 library orphan-instances
   import: ghc-options
@@ -632,6 +636,8 @@ executable demo-ping-pong
     network-mux,
     ouroboros-network:{api, framework},
     typed-protocols:examples,
+  if arch(wasm32)
+    buildable: False
 
 executable demo-connection-manager
   import: ghc-options
@@ -811,10 +817,13 @@ test-suite protocols-tests
     tasty,
 
   ghc-options:
-    -threaded
     -Wall
     -Wunused-packages
-    -rtsopts
+
+  if !arch(wasm32)
+    ghc-options:
+      -threaded
+      -rtsopts
 
 -- Simulation Test Library
 library ouroboros-network-tests-lib
@@ -895,11 +904,13 @@ test-suite ouroboros-network-sim-tests
 
   ghc-options:
     -fno-ignore-asserts
-    -threaded
-    -rtsopts
-    +RTS
-    -T
-    -RTS
+  if !arch(wasm32)
+      ghc-options:
+        -threaded
+        -rtsopts
+        +RTS
+        -T
+        -RTS
 
 -- Tests which require system calls provided by `Win32-network` or `network`
 -- library.  These tests are compiled natively & run on all supported
@@ -939,12 +950,13 @@ test-suite ouroboros-network-io-tests
   else
     build-depends: process
 
-  ghc-options:
-    -threaded
-    -rtsopts
-    +RTS
-    -T
-    -RTS
+  if !arch(wasm32)
+    ghc-options:
+      -threaded
+      -rtsopts
+      +RTS
+      -T
+      -RTS
 
 benchmark sim-benchmarks
   import: ghc-options-tests
@@ -964,10 +976,12 @@ benchmark sim-benchmarks
   -- https://gitlab.haskell.org/ghc/ghc/-/issues/25165
   ghc-options:
     -fno-ignore-asserts
-    -threaded
-    -rtsopts
-    -with-rtsopts=-A32m
-    -fproc-alignment=64
-    +RTS
-    -T
-    -RTS
+  if !arch(wasm32)
+    ghc-options:
+      -threaded
+      -rtsopts
+      -with-rtsopts=-A32m
+      -fproc-alignment=64
+      +RTS
+      -T
+      -RTS

ouroboros-network/tests/io/Test/Ouroboros/Network/Socket.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE BangPatterns        #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE FlexibleContexts    #-}
@@ -7,6 +8,7 @@
 {-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE TypeFamilies        #-}
 
+{-# OPTIONS_GHC -Wno-deprecations            #-}
 {-# OPTIONS_GHC -Wno-orphans                 #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 module Test.Ouroboros.Network.Socket (tests) where
@@ -129,7 +131,11 @@ testVersionCodecCBORTerm !_ =
     decodeTerm :: CBOR.Term -> Either Text TestVersionData
     decodeTerm (CBOR.TList [CBOR.TInt x])
       | x >= 0
+#if !defined(wasm32_HOST_ARCH)
       , x <= 0xffffffff
+#else
+      , x <= 0x7fffffff
+#endif
       = Right
           TestVersionData {
               networkMagic = NetworkMagic (fromIntegral x)