Server performance and stability improvements (#48)

* concurrent echo client for stress testing

* update examples for benchmarking, tweak cabal file

* mark frequently-used call as unsafe for performance boost

* add unsafe annotation to non-blocking C calls on critical path

* more unsafe annotations -- server performance almost doubled now

* one CQ for all call ops

* unsafe annotation on start_batch

* wait for all client threads, replace error with fail

* add -O2

examples/echo/echo-client/Main.hs

@@ -4,6 +4,7 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds       #-}
 
+import           Control.Concurrent.Async
 import           Control.Monad
 import qualified Data.ByteString.Lazy                      as BL
 import           Data.Protobuf.Wire.Class
@@ -13,6 +14,7 @@ import           Data.Word
 import           GHC.Generics                              (Generic)
 import           Network.GRPC.LowLevel
 import qualified Network.GRPC.LowLevel.Client.Unregistered as U
+import           System.Random                             (randomRIO)
 
 echoMethod = MethodName "/echo.Echo/DoEcho"
 addMethod = MethodName "/echo.Add/DoAdd"
@@ -23,10 +25,10 @@ regMain = withGRPC $ \g ->
   withClient g (ClientConfig "localhost" 50051 []) $ \c -> do
   rm <- clientRegisterMethodNormal c echoMethod
   replicateM_ 100000 $ clientRequest c rm 5 "hi" mempty >>= \case
-    Left e -> error $ "Got client error: " ++ show e
+    Left e -> fail $ "Got client error: " ++ show e
     Right r
       | rspBody r == "hi" -> return ()
-      | otherwise -> error $ "Got unexpected payload: " ++ show r
+      | otherwise -> fail $ "Got unexpected payload: " ++ show r
 
 -- NB: If you change these, make sure to change them in the server as well.
 -- TODO: Put these in a common location (or just hack around it until CG is working)
@@ -42,24 +44,31 @@ instance Message AddResponse
 highlevelMain = withGRPC $ \g ->
     withClient g (ClientConfig "localhost" 50051 []) $ \c -> do
     rm <- clientRegisterMethodNormal c echoMethod
+    rmAdd <- clientRegisterMethodNormal c addMethod
+    let oneThread = replicateM_ 10000 $ body c rm rmAdd
+    tids <- replicateM 4 (async oneThread)
+    results <- mapM waitCatch tids
+    print $ "waitCatch results: " ++ show (sequence results)
+      where body c rm rmAdd = do
               let pay = EchoRequest "hi"
                   enc = BL.toStrict . toLazyByteString $ pay
-    replicateM_ 1 $ clientRequest c rm 5 enc mempty >>= \case
+              clientRequest c rm 5 enc mempty >>= \case
-      Left e  -> error $ "Got client error: " ++ show e
+                Left e  -> fail $ "Got client error: " ++ show e
                 Right r -> case fromByteString (rspBody r) of
-        Left e -> error $ "Got decoding error: " ++ show e
+                  Left e -> fail $ "Got decoding error: " ++ show e
                   Right dec
                     | dec == pay -> return ()
-          | otherwise -> error $ "Got unexpected payload: " ++ show dec
+                    | otherwise -> fail $ "Got unexpected payload: " ++ show dec
-    rmAdd <- clientRegisterMethodNormal c addMethod
+              x <- liftM Fixed $ randomRIO (0,1000)
-    let addPay = AddRequest 1 2
+              y <- liftM Fixed $ randomRIO (0,1000)
+              let addPay = AddRequest x y
                   addEnc = BL.toStrict . toLazyByteString $ addPay
-    replicateM_ 1 $ clientRequest c rmAdd 5 addEnc mempty >>= \case
+              clientRequest c rmAdd 5 addEnc mempty >>= \case
-      Left e -> error $ "Got client error on add request: " ++ show e
+                Left e -> fail $ "Got client error on add request: " ++ show e
                 Right r -> case fromByteString (rspBody r) of
-        Left e -> error $ "failed to decode add response: " ++ show e
+                  Left e -> fail $ "failed to decode add response: " ++ show e
                   Right dec
-          | dec == AddResponse 3 -> return ()
+                    | dec == AddResponse (x + y) -> return ()
-          | otherwise -> error $ "Got wrong add answer: " ++ show dec
+                    | otherwise -> fail $ "Got wrong add answer: " ++ show dec ++ "expected: " ++ show x ++ " + " ++ show y ++ " = " ++ show (x+y)
 
 main = highlevelMain

examples/echo/echo-cpp/echo-client.cc

@@ -1,5 +1,6 @@
 #include <string>
 #include <iostream>
+#include <thread>
 
 #include <grpc++/grpc++.h>
 
@@ -51,24 +52,31 @@ private:
   unique_ptr<Add::Stub> stub_;
 };
 
+void do10k(EchoClient* client, AddClient* addClient){
+  string msg("hi");
+
+  for(int i = 0; i < 10000; i++){
+    Status status = client->DoEcho(msg);
+    if(!status.ok()){
+      cout<<"Error: "<<status.error_code()<<endl;
+    }
+    AddResponse answer = addClient->DoAdd(1,2);
+  }
+}
+
 int main(){
 
   EchoClient client(grpc::CreateChannel("localhost:50051",
                                         grpc::InsecureChannelCredentials()));
-  string msg("hi");
-  /*
-  while(true){
-    Status status = client.DoEcho(msg);
-    if(!status.ok()){
-      cout<<"Error: "<<status.error_code()<<endl;
-      return 1;
-    }
-  }
-  */
-
   AddClient addClient (grpc::CreateChannel("localhost:50051",
                                         grpc::InsecureChannelCredentials()));
-  AddResponse answer = addClient.DoAdd(1,2);
+  thread unus(do10k,&client,&addClient);
-  cout<<"Got answer: "<<answer.answer()<<endl;
+  thread duo(do10k,&client,&addClient);
+  thread tres(do10k,&client,&addClient);
+  thread quattuor(do10k,&client,&addClient);
+  unus.join();
+  duo.join();
+  tres.join();
+  quattuor.join();
   return 0;
 }

examples/echo/echo-cpp/echo-server.cc

@@ -12,30 +12,35 @@ using grpc::ServerBuilder;
 using grpc::ServerContext;
 using grpc::Status;
 
-using echo::EchoRequest;
+using namespace echo;
-using echo::Echo;
 
 atomic_int reqCount;
 
 class EchoServiceImpl final : public Echo::Service {
     Status DoEcho(ServerContext* ctx, const EchoRequest* req,
                   EchoRequest* resp) override {
-      reqCount++;
-      if(reqCount % 100 == 0){
-        cout<<reqCount<<endl;
-      }
       resp->set_message(req->message());
       return Status::OK;
     }
 };
 
+class AddServiceImpl final : public Add::Service {
+    Status DoAdd(ServerContext* ctx, const AddRequest* req,
+                 AddResponse* resp) override {
+      resp->set_answer(req->addx() + req->addy());
+      return Status::OK;
+    }
+};
+
 int main(){
   string server_address("localhost:50051");
-  EchoServiceImpl service;
+  EchoServiceImpl echoService;
+  AddServiceImpl addService;
 
   ServerBuilder builder;
   builder.AddListeningPort(server_address, grpc::InsecureServerCredentials());
-  builder.RegisterService(&service);
+  builder.RegisterService(&echoService);
+  builder.RegisterService(&addService);
   unique_ptr<Server> server(builder.BuildAndStart());
   server->Wait();
   return 0;

examples/echo/echo-server/Main.hs

@@ -104,10 +104,7 @@ addHandler :: Handler 'Normal
 addHandler =
   UnaryHandler "/echo.Add/DoAdd" $
     \c -> do
-      --tputStrLn $ "UnaryHandler for DoAdd hit, b=" ++ show b
       let b = payload c
-      print (addX b)
-      print (addY b)
       return ( AddResponse $ addX b + addY b
              , metadata c
              , StatusOk

grpc-haskell.cabal

@@ -103,7 +103,7 @@ executable echo-server
   else
     buildable: False
   default-language: Haskell2010
-  ghc-options:      -Wall -g -threaded
+  ghc-options:      -Wall -g -threaded -rtsopts -with-rtsopts=-N -O2
   hs-source-dirs:   examples/echo/echo-server
   main-is:          Main.hs
 
@@ -118,10 +118,11 @@ executable echo-client
       , proto3-wire
       , protobuf-wire
       , text
+      , random
   else
     buildable: False
   default-language: Haskell2010
-  ghc-options:      -Wall -g -threaded
+  ghc-options:      -Wall -g -threaded -rtsopts -with-rtsopts=-N -O2
   hs-source-dirs:   examples/echo/echo-client
   main-is:          Main.hs
 
@@ -146,7 +147,7 @@ test-suite test
     LowLevelTests.Op,
     UnsafeTests
   default-language:     Haskell2010
-  ghc-options:          -Wall -fwarn-incomplete-patterns -fno-warn-unused-do-bind -g -threaded
+  ghc-options:          -Wall -fwarn-incomplete-patterns -fno-warn-unused-do-bind -g -threaded -rtsopts
   hs-source-dirs:       tests
   main-is:              Properties.hs
   type:                 exitcode-stdio-1.0

src/Network/GRPC/LowLevel/Call.hs

@@ -212,6 +212,5 @@ destroyServerCall :: ServerCall a -> IO ()
 destroyServerCall sc@ServerCall{ unsafeSC = c, .. } = do
   grpcDebug "destroyServerCall(R): entered."
   debugServerCall sc
-  _ <- shutdownCompletionQueue callCQ
   grpcDebug $ "Destroying server-side call object: " ++ show c
   C.grpcCallDestroy c

src/Network/GRPC/LowLevel/Call/Unregistered.hs

@@ -51,5 +51,4 @@ destroyServerCall call@ServerCall{..} = do
   grpcDebug "destroyServerCall(U): entered."
   debugServerCall call
   grpcDebug $ "Destroying server-side call object: " ++ show unsafeSC
-  shutdownCompletionQueue callCQ
   C.grpcCallDestroy unsafeSC

src/Network/GRPC/LowLevel/Server.hs

@@ -51,6 +51,9 @@ data Server = Server
   { serverGRPC           :: GRPC
   , unsafeServer         :: C.Server
   , serverCQ             :: CompletionQueue
+  -- ^ CQ used for receiving new calls.
+  , serverCallCQ               :: CompletionQueue
+  -- ^ CQ for running ops on calls. Not used to receive new calls.
   , normalMethods        :: [RegisteredMethod 'Normal]
   , sstreamingMethods    :: [RegisteredMethod 'ServerStreaming]
   , cstreamingMethods    :: [RegisteredMethod 'ClientStreaming]
@@ -139,28 +142,32 @@ startServer grpc conf@ServerConfig{..} =
     C.grpcServerStart server
     forks <- newTVarIO S.empty
     shutdown <- newTVarIO False
-    return $ Server grpc server cq ns ss cs bs conf forks shutdown
+    ccq <- createCompletionQueue grpc
+    return $ Server grpc server cq ccq ns ss cs bs conf forks shutdown
+
+
 
 stopServer :: Server -> IO ()
 -- TODO: Do method handles need to be freed?
-stopServer Server{ unsafeServer = s, serverCQ = scq, .. } = do
+stopServer server@Server{ unsafeServer = s, .. } = do
   grpcDebug "stopServer: calling shutdownNotify."
-  shutdownNotify
+  shutdownNotify serverCQ
   grpcDebug "stopServer: cancelling all calls."
   C.grpcServerCancelAllCalls s
   cleanupForks
   grpcDebug "stopServer: call grpc_server_destroy."
   C.grpcServerDestroy s
   grpcDebug "stopServer: shutting down CQ."
-  shutdownCQ
+  shutdownCQ serverCQ
+  shutdownCQ serverCallCQ
 
-  where shutdownCQ = do
+  where shutdownCQ scq = do
           shutdownResult <- shutdownCompletionQueue scq
           case shutdownResult of
             Left _ -> do putStrLn "Warning: completion queue didn't shut down."
                          putStrLn "Trying to stop server anyway."
             Right _ -> return ()
-        shutdownNotify = do
+        shutdownNotify scq = do
           let shutdownTag = C.tag 0
           serverShutdownAndNotify s scq shutdownTag
           grpcDebug "called serverShutdownAndNotify; plucking."
@@ -286,9 +293,8 @@ serverRegisterMethodBiDiStreaming internalServer meth e = do
 serverCreateCall :: Server
                  -> RegisteredMethod mt
                  -> IO (Either GRPCIOError (ServerCall (MethodPayload mt)))
-serverCreateCall Server{..} rm = do
+serverCreateCall Server{..} rm =
-  callCQ <- createCompletionQueue serverGRPC
+  serverRequestCall rm unsafeServer serverCQ serverCallCQ
-  serverRequestCall rm unsafeServer serverCQ callCQ
 
 withServerCall :: Server
                -> RegisteredMethod mt

src/Network/GRPC/LowLevel/Server/Unregistered.hs

@@ -30,8 +30,7 @@ import qualified Network.GRPC.Unsafe.Op                             as C
 serverCreateCall :: Server
                  -> IO (Either GRPCIOError ServerCall)
 serverCreateCall Server{..} = do
-  callCQ <- createCompletionQueue serverGRPC
+  serverRequestCall unsafeServer serverCQ serverCallCQ
-  serverRequestCall unsafeServer serverCQ callCQ
 
 withServerCall :: Server
                -> (ServerCall -> IO (Either GRPCIOError a))

src/Network/GRPC/Unsafe.chs

@@ -47,8 +47,8 @@ deriving instance Show Call
 
 deriving instance Show CallDetails
 
-{#fun create_call_details as ^ {} -> `CallDetails'#}
+{#fun unsafe create_call_details as ^ {} -> `CallDetails'#}
-{#fun destroy_call_details as ^ {`CallDetails'} -> `()'#}
+{#fun unsafe destroy_call_details as ^ {`CallDetails'} -> `()'#}
 
 withCallDetails :: (CallDetails -> IO a) -> IO a
 withCallDetails = bracket createCallDetails destroyCallDetails
@@ -210,7 +210,7 @@ castPeek p = do
 -- When complete, an event identified by the given 'Tag'
 -- will be pushed onto the 'CompletionQueue' that was associated with the given
 -- 'Call' when the 'Call' was created.
-{#fun grpc_call_start_batch as ^
+{#fun unsafe grpc_call_start_batch as ^
   {`Call', `OpArray', `Int', unTag `Tag',unReserved `Reserved'} -> `CallError'#}
 
 {#fun grpc_call_cancel as ^ {`Call',unReserved `Reserved'} -> `()'#}
@@ -280,8 +280,8 @@ getPeerPeek cstr = do
    `CompletionQueue',unTag `Tag'}
   -> `CallError'#}
 
-{#fun call_details_get_method as ^ {`CallDetails'} -> `String'#}
+{#fun unsafe call_details_get_method as ^ {`CallDetails'} -> `String'#}
 
-{#fun call_details_get_host as ^ {`CallDetails'} -> `String'#}
+{#fun unsafe call_details_get_host as ^ {`CallDetails'} -> `String'#}
 
 {#fun call_details_get_deadline as ^ {`CallDetails'} -> `CTimeSpec' peek* #}

src/Network/GRPC/Unsafe/ByteBuffer.chs

@@ -41,9 +41,9 @@ instance Storable ByteBuffer where
 
 -- | Creates a pointer to a 'ByteBuffer'. This is used to receive data when
 -- creating a GRPC_OP_RECV_MESSAGE op.
-{#fun create_receiving_byte_buffer as ^ {} -> `Ptr ByteBuffer' id#}
+{#fun unsafe create_receiving_byte_buffer as ^ {} -> `Ptr ByteBuffer' id#}
 
-{#fun destroy_receiving_byte_buffer as ^ {id `Ptr ByteBuffer'} -> `()'#}
+{#fun unsafe destroy_receiving_byte_buffer as ^ {id `Ptr ByteBuffer'} -> `()'#}
 
 withByteBufferPtr :: (Ptr ByteBuffer -> IO a) -> IO a
 withByteBufferPtr
@@ -56,24 +56,24 @@ withByteBufferPtr
 {#fun grpc_raw_compressed_byte_buffer_create as ^
   {`Slice', `CULong', `CompressionAlgorithm'} -> `ByteBuffer'#}
 
-{#fun grpc_byte_buffer_copy as ^ {`ByteBuffer'} -> `ByteBuffer'#}
+{#fun unsafe grpc_byte_buffer_copy as ^ {`ByteBuffer'} -> `ByteBuffer'#}
 
-{#fun grpc_byte_buffer_length as ^ {`ByteBuffer'} -> `CULong'#}
+{#fun unsafe grpc_byte_buffer_length as ^ {`ByteBuffer'} -> `CULong'#}
 
-{#fun grpc_byte_buffer_destroy as ^ {`ByteBuffer'} -> `()'#}
+{#fun unsafe grpc_byte_buffer_destroy as ^ {`ByteBuffer'} -> `()'#}
 
-{#fun byte_buffer_reader_create as ^ {`ByteBuffer'} -> `ByteBufferReader'#}
+{#fun unsafe byte_buffer_reader_create as ^ {`ByteBuffer'} -> `ByteBufferReader'#}
 
-{#fun byte_buffer_reader_destroy as ^ {`ByteBufferReader'} -> `()'#}
+{#fun unsafe byte_buffer_reader_destroy as ^ {`ByteBufferReader'} -> `()'#}
 
 {#fun grpc_byte_buffer_reader_next as ^
   {`ByteBufferReader', `Slice'} -> `CInt'#}
 
 -- | Returns a 'Slice' containing the entire contents of the 'ByteBuffer' being
 -- read by the given 'ByteBufferReader'.
-{#fun grpc_byte_buffer_reader_readall_ as ^ {`ByteBufferReader'} -> `Slice'#}
+{#fun unsafe grpc_byte_buffer_reader_readall_ as ^ {`ByteBufferReader'} -> `Slice'#}
 
-{#fun grpc_raw_byte_buffer_from_reader as ^
+{#fun unsafe grpc_raw_byte_buffer_from_reader as ^
   {`ByteBufferReader'} -> `ByteBuffer'#}
 
 withByteStringAsByteBuffer :: B.ByteString -> (ByteBuffer -> IO a) -> IO a

src/Network/GRPC/Unsafe/Metadata.chs

@@ -29,18 +29,18 @@ deriving instance Show MetadataKeyValPtr
 
 deriving instance Show MetadataArray
 
-{#fun metadata_array_get_metadata as ^
+{#fun unsafe metadata_array_get_metadata as ^
   {`MetadataArray'} -> `MetadataKeyValPtr'#}
 
 -- | Overwrites the metadata in the given 'MetadataArray'. The given
 -- 'MetadataKeyValPtr' *must* have been created with 'createMetadata' in this
 -- module.
-{#fun metadata_array_set_metadata as ^
+{#fun unsafe metadata_array_set_metadata as ^
   {`MetadataArray', `MetadataKeyValPtr'} -> `()'#}
 
-{#fun metadata_array_get_count as ^ {`MetadataArray'} -> `Int'#}
+{#fun unsafe metadata_array_get_count as ^ {`MetadataArray'} -> `Int'#}
 
-{#fun metadata_array_get_capacity as ^ {`MetadataArray'} -> `Int'#}
+{#fun unsafe metadata_array_get_capacity as ^ {`MetadataArray'} -> `Int'#}
 
 instance Storable MetadataArray where
   sizeOf (MetadataArray r) = sizeOf r
@@ -50,28 +50,28 @@ instance Storable MetadataArray where
 
 -- | Create an empty 'MetadataArray'. Returns a pointer to it so that we can
 -- pass it to the appropriate op creation functions.
-{#fun metadata_array_create as ^ {} -> `Ptr MetadataArray' id#}
+{#fun unsafe metadata_array_create as ^ {} -> `Ptr MetadataArray' id#}
 
-{#fun metadata_array_destroy as ^ {id `Ptr MetadataArray'} -> `()'#}
+{#fun unsafe metadata_array_destroy as ^ {id `Ptr MetadataArray'} -> `()'#}
 
 -- Note: I'm pretty sure we must call out to C to allocate these
 -- because they are nested structs.
 -- | Allocates space for exactly n metadata key/value pairs.
-{#fun metadata_alloc as ^ {`Int'} -> `MetadataKeyValPtr'#}
+{#fun unsafe metadata_alloc as ^ {`Int'} -> `MetadataKeyValPtr'#}
 
-{#fun metadata_free as ^ {`MetadataKeyValPtr'} -> `()'#}
+{#fun unsafe metadata_free as ^ {`MetadataKeyValPtr'} -> `()'#}
 
 -- | Sets a metadata key/value pair at the given index in the
 -- 'MetadataKeyValPtr'. No error checking is performed to ensure the index is
 -- in bounds!
-{#fun set_metadata_key_val as setMetadataKeyVal
+{#fun unsafe set_metadata_key_val as setMetadataKeyVal
   {useAsCString* `ByteString', useAsCString* `ByteString',
    `MetadataKeyValPtr', `Int'} -> `()'#}
 
-{#fun get_metadata_key as getMetadataKey'
+{#fun unsafe get_metadata_key as getMetadataKey'
   {`MetadataKeyValPtr', `Int'} -> `CString'#}
 
-{#fun get_metadata_val as getMetadataVal'
+{#fun unsafe get_metadata_val as getMetadataVal'
   {`MetadataKeyValPtr', `Int'} -> `CString'#}
 
 --TODO: The test suggests this is leaking.

src/Network/GRPC/Unsafe/Op.chs

@@ -24,11 +24,11 @@ import Foreign.Ptr
 -- http://stackoverflow.com/questions/1113855/is-the-sizeofenum-sizeofint-always
 -- | Allocates space for a 'StatusCode' and returns a pointer to it. Used to
 -- receive a status code from the server with 'opRecvStatusClient'.
-{#fun create_status_code_ptr as ^ {} -> `Ptr StatusCode' castPtr#}
+{#fun unsafe create_status_code_ptr as ^ {} -> `Ptr StatusCode' castPtr#}
 
-{#fun deref_status_code_ptr as ^ {castPtr `Ptr StatusCode'} -> `StatusCode'#}
+{#fun unsafe deref_status_code_ptr as ^ {castPtr `Ptr StatusCode'} -> `StatusCode'#}
 
-{#fun destroy_status_code_ptr as ^ {castPtr `Ptr StatusCode'} -> `()' #}
+{#fun unsafe destroy_status_code_ptr as ^ {castPtr `Ptr StatusCode'} -> `()' #}
 
 -- | Represents an array of ops to be passed to 'grpcCallStartBatch'.
 -- Create an array with 'opArrayCreate', then create individual ops in the array
@@ -41,10 +41,10 @@ import Foreign.Ptr
 deriving instance Show OpArray
 
 -- | Creates an empty 'OpArray' with space for the given number of ops.
-{#fun op_array_create as ^ {`Int'} -> `OpArray'#}
+{#fun unsafe op_array_create as ^ {`Int'} -> `OpArray'#}
 
 -- | Destroys an 'OpArray' of the given size.
-{#fun op_array_destroy as ^ {`OpArray', `Int'} -> `()'#}
+{#fun unsafe op_array_destroy as ^ {`OpArray', `Int'} -> `()'#}
 
 -- | brackets creating and destroying an 'OpArray' with the given size.
 withOpArray :: Int -> (OpArray -> IO a) -> IO a
@@ -54,41 +54,41 @@ withOpArray n f = bracket (opArrayCreate n) (flip opArrayDestroy n) f
 -- index of the given 'OpArray', containing the given
 -- metadata. The metadata is copied and can be destroyed after calling this
 -- function.
-{#fun op_send_initial_metadata as ^
+{#fun unsafe op_send_initial_metadata as ^
   {`OpArray', `Int', `MetadataKeyValPtr', `Int'} -> `()'#}
 
 -- | Creates an op of type GRPC_OP_SEND_INITIAL_METADATA at the specified
 -- index of the given 'OpArray'. The op will contain no metadata.
-{#fun op_send_initial_metadata_empty as ^ {`OpArray', `Int'} -> `()'#}
+{#fun unsafe op_send_initial_metadata_empty as ^ {`OpArray', `Int'} -> `()'#}
 
 -- | Creates an op of type GRPC_OP_SEND_MESSAGE at the specified index of
 -- the given 'OpArray'. The given 'ByteBuffer' is
 -- copied and can be destroyed after calling this function.
-{#fun op_send_message as ^ {`OpArray', `Int', `ByteBuffer'} -> `()'#}
+{#fun unsafe op_send_message as ^ {`OpArray', `Int', `ByteBuffer'} -> `()'#}
 
 -- | Creates an 'Op' of type GRPC_OP_SEND_CLOSE_FROM_CLIENT at the specified
 -- index of the given 'OpArray'.
-{#fun op_send_close_client as ^ {`OpArray', `Int'} -> `()'#}
+{#fun unsafe op_send_close_client as ^ {`OpArray', `Int'} -> `()'#}
 
 -- | Creates an op of type GRPC_OP_RECV_INITIAL_METADATA at the specified
 -- index of the given 'OpArray', and ties the given
 -- 'MetadataArray' pointer to that op so that the received metadata can be
 -- accessed. It is the user's responsibility to destroy the 'MetadataArray'.
-{#fun op_recv_initial_metadata as ^
+{#fun unsafe op_recv_initial_metadata as ^
   {`OpArray', `Int',id `Ptr MetadataArray'} -> `()'#}
 
 -- | Creates an op of type GRPC_OP_RECV_MESSAGE at the specified index of the
 -- given 'OpArray', and ties the given
 -- 'ByteBuffer' pointer to that op so that the received message can be
 -- accessed. It is the user's responsibility to destroy the 'ByteBuffer'.
-{#fun op_recv_message as ^ {`OpArray', `Int',id `Ptr ByteBuffer'} -> `()'#}
+{#fun unsafe op_recv_message as ^ {`OpArray', `Int',id `Ptr ByteBuffer'} -> `()'#}
 
 -- | Creates an op of type GRPC_OP_RECV_STATUS_ON_CLIENT at the specified
 -- index of the given 'OpArray', and ties all the
 -- input pointers to that op so that the results of the receive can be
 -- accessed. It is the user's responsibility to free all the input args after
 -- this call.
-{#fun op_recv_status_client as ^
+{#fun unsafe op_recv_status_client as ^
   {`OpArray', `Int',id `Ptr MetadataArray', castPtr `Ptr StatusCode',
    castPtr `Ptr CString', `Int'}
   -> `()'#}
@@ -97,12 +97,12 @@ withOpArray n f = bracket (opArrayCreate n) (flip opArrayDestroy n) f
 -- of the given 'OpArray', and ties the input
 -- pointer to that op so that the result of the receive can be accessed. It is
 -- the user's responsibility to free the pointer.
-{#fun op_recv_close_server as ^ {`OpArray', `Int', id `Ptr CInt'} -> `()'#}
+{#fun unsafe op_recv_close_server as ^ {`OpArray', `Int', id `Ptr CInt'} -> `()'#}
 
 -- | Creates an op of type GRPC_OP_SEND_STATUS_FROM_SERVER at the specified
 -- index of the given 'OpArray'. The given
 -- Metadata and string are copied when creating the op, and can be safely
 -- destroyed immediately after calling this function.
-{#fun op_send_status_server as ^
+{#fun unsafe op_send_status_server as ^
   {`OpArray', `Int', `Int', `MetadataKeyValPtr', `StatusCode', `CString'}
   -> `()'#}

src/Network/GRPC/Unsafe/Slice.chs

@@ -27,17 +27,17 @@ deriving instance Show Slice
 -- maybe the established idiom is to do what c2hs does.
 
 -- | Get the length of a slice.
-{#fun gpr_slice_length_ as ^ {`Slice'} -> `CULong'#}
+{#fun unsafe gpr_slice_length_ as ^ {`Slice'} -> `CULong'#}
 
 -- | Returns a pointer to the start of the character array contained by the
 -- slice.
-{#fun gpr_slice_start_ as ^ {`Slice'} -> `Ptr CChar' castPtr #}
+{#fun unsafe gpr_slice_start_ as ^ {`Slice'} -> `Ptr CChar' castPtr #}
 
-{#fun gpr_slice_from_copied_buffer_ as ^ {`CString', `Int'} -> `Slice'#}
+{#fun unsafe gpr_slice_from_copied_buffer_ as ^ {`CString', `Int'} -> `Slice'#}
 
 -- | Properly cleans up all memory used by a 'Slice'. Danger: the Slice should
 -- not be used after this function is called on it.
-{#fun free_slice as ^ {`Slice'} -> `()'#}
+{#fun unsafe free_slice as ^ {`Slice'} -> `()'#}
 
 -- | Copies a 'Slice' to a ByteString.
 -- TODO: there are also non-copying unsafe ByteString construction functions.

src/Network/GRPC/Unsafe/Time.chs

@@ -30,7 +30,7 @@ instance Storable CTimeSpec where
 -- 'timespecDestroy'.
 {#pointer *gpr_timespec as CTimeSpecPtr -> CTimeSpec #}
 
-{#fun timespec_destroy as ^ {`CTimeSpecPtr'} -> `()'#}
+{#fun unsafe timespec_destroy as ^ {`CTimeSpecPtr'} -> `()'#}
 
 {#fun gpr_inf_future_ as ^ {`ClockType'} -> `CTimeSpecPtr'#}
 
@@ -53,7 +53,7 @@ withDeadlineSeconds i = bracket (secondsToDeadline i) timespecDestroy
 
 -- | Returns a GprClockMonotonic representing an infinitely distant deadline.
 -- wraps gpr_inf_future in the gRPC library.
-{#fun infinite_deadline as ^ {} -> `CTimeSpecPtr'#}
+{#fun unsafe infinite_deadline as ^ {} -> `CTimeSpecPtr'#}
 
 withInfiniteDeadline :: (CTimeSpecPtr -> IO a) -> IO a
 withInfiniteDeadline = bracket infiniteDeadline timespecDestroy