mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 09:17:43 +03:00
afb2006566
We can’t upgrade to the latest version 1.35.0 since it depends on a newer version of Bazel but we can at least go to 1.34.1. We also have to patch absl and grpc itself to fix mingw support and some undeclared inclusions on Windows. Both patches are taken from upstream PRs (the mingw one has not been merged yet). There is also a small patch to grpc-haskell-core. I’ve started working on upstreaming that but the nix build system is a mess and I haven’t quite managed to get it working there. changelog_begin changelog_end
71 lines
2.9 KiB
Diff
71 lines
2.9 KiB
Diff
diff --git a/cbits/grpc_haskell.c b/cbits/grpc_haskell.c
|
|
index ebbcbb1..236c73e 100644
|
|
--- a/cbits/grpc_haskell.c
|
|
+++ b/cbits/grpc_haskell.c
|
|
@@ -504,8 +504,7 @@ grpc_auth_metadata_processor* mk_auth_metadata_processor(
|
|
|
|
grpc_call_credentials* grpc_metadata_credentials_create_from_plugin_(
|
|
grpc_metadata_credentials_plugin* plugin){
|
|
-
|
|
- return grpc_metadata_credentials_create_from_plugin(*plugin, NULL);
|
|
+ return grpc_metadata_credentials_create_from_plugin(*plugin, GRPC_PRIVACY_AND_INTEGRITY, NULL);
|
|
}
|
|
|
|
//This is a hack to work around GHC being unable to deal with raw struct params.
|
|
diff --git a/src/Network/GRPC/Unsafe.chs b/src/Network/GRPC/Unsafe.chs
|
|
index d11f533..6eb08b8 100644
|
|
--- a/src/Network/GRPC/Unsafe.chs
|
|
+++ b/src/Network/GRPC/Unsafe.chs
|
|
@@ -219,9 +219,6 @@ castPeek p = do
|
|
unTag `Tag'}
|
|
-> `()'#}
|
|
|
|
-{#fun grpc_channel_ping as ^
|
|
- {`Channel', `CompletionQueue', unTag `Tag',unReserved `Reserved'} -> `()' #}
|
|
-
|
|
{#fun grpc_channel_destroy as ^ {`Channel'} -> `()'#}
|
|
|
|
-- | Starts executing a batch of ops in the given 'OpArray'. Does not block.
|
|
diff --git a/tests/LowLevelTests/Op.hs b/tests/LowLevelTests/Op.hs
|
|
index 52b6d55..ff0751a 100644
|
|
--- a/tests/LowLevelTests/Op.hs
|
|
+++ b/tests/LowLevelTests/Op.hs
|
|
@@ -4,6 +4,9 @@
|
|
|
|
module LowLevelTests.Op where
|
|
|
|
+import Control.Concurrent
|
|
+import Control.Exception
|
|
+import Control.Monad
|
|
import Data.ByteString (ByteString)
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
|
@@ -47,14 +50,20 @@ withClientServerUnaryCall :: GRPC
|
|
withClientServerUnaryCall grpc f = do
|
|
withClient grpc clientConf $ \c -> do
|
|
crm <- clientRegisterMethodNormal c "/foo"
|
|
- withServer grpc serverConf $ \s ->
|
|
- withClientCall c crm 10 $ \cc -> do
|
|
+ withServer grpc serverConf $ \s -> do
|
|
+ ccVar <- newEmptyMVar
|
|
+ bracket newEmptyMVar (\v -> putMVar v ()) $ \finished -> do
|
|
+ _ <- forkIO $ void $ withClientCall c crm 10 $ \cc -> do
|
|
+ putMVar ccVar cc
|
|
+ -- NOTE: We need to send client ops here or else `withServerCall` hangs,
|
|
+ -- because registered methods try to do recv ops immediately when
|
|
+ -- created. If later we want to send payloads or metadata, we'll need
|
|
+ -- to tweak this.
|
|
+ _clientRes <- runOps (unsafeCC cc) (clientCQ c) clientEmptySendOps
|
|
+ takeMVar finished
|
|
+ pure (Right ())
|
|
let srm = head (normalMethods s)
|
|
- -- NOTE: We need to send client ops here or else `withServerCall` hangs,
|
|
- -- because registered methods try to do recv ops immediately when
|
|
- -- created. If later we want to send payloads or metadata, we'll need
|
|
- -- to tweak this.
|
|
- _clientRes <- runOps (unsafeCC cc) (clientCQ c) clientEmptySendOps
|
|
+ cc <- takeMVar ccVar
|
|
withServerCall s srm $ \sc ->
|
|
f (c, s, cc, sc)
|
|
|