mirror of
https://github.com/digital-asset/daml.git
synced 2024-11-10 10:46:11 +03:00
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)
|
||
|
|
|