From ab4dea344de9c955683254694c05cddbc27ff15c Mon Sep 17 00:00:00 2001 From: Connor Clark Date: Thu, 21 Jul 2016 12:55:16 -0700 Subject: [PATCH] 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 | 49 +++++++++++-------- examples/echo/echo-cpp/echo-client.cc | 34 ++++++++----- examples/echo/echo-cpp/echo-server.cc | 21 +++++--- examples/echo/echo-server/Main.hs | 3 -- grpc-haskell.cabal | 7 +-- src/Network/GRPC/LowLevel/Call.hs | 1 - .../GRPC/LowLevel/Call/Unregistered.hs | 1 - src/Network/GRPC/LowLevel/Server.hs | 24 +++++---- .../GRPC/LowLevel/Server/Unregistered.hs | 3 +- src/Network/GRPC/Unsafe.chs | 10 ++-- src/Network/GRPC/Unsafe/ByteBuffer.chs | 18 +++---- src/Network/GRPC/Unsafe/Metadata.chs | 22 ++++----- src/Network/GRPC/Unsafe/Op.chs | 28 +++++------ src/Network/GRPC/Unsafe/Slice.chs | 8 +-- src/Network/GRPC/Unsafe/Time.chs | 4 +- 15 files changed, 128 insertions(+), 105 deletions(-) diff --git a/examples/echo/echo-client/Main.hs b/examples/echo/echo-client/Main.hs index 42a5ca8..ade9dfd 100644 --- a/examples/echo/echo-client/Main.hs +++ b/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 - let pay = EchoRequest "hi" - enc = BL.toStrict . toLazyByteString $ pay - replicateM_ 1 $ clientRequest c rm 5 enc mempty >>= \case - Left e -> error $ "Got client error: " ++ show e - Right r -> case fromByteString (rspBody r) of - Left e -> error $ "Got decoding error: " ++ show e - Right dec - | dec == pay -> return () - | otherwise -> error $ "Got unexpected payload: " ++ show dec rmAdd <- clientRegisterMethodNormal c addMethod - let addPay = AddRequest 1 2 - addEnc = BL.toStrict . toLazyByteString $ addPay - replicateM_ 1 $ clientRequest c rmAdd 5 addEnc mempty >>= \case - Left e -> error $ "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 - Right dec - | dec == AddResponse 3 -> return () - | otherwise -> error $ "Got wrong add answer: " ++ show dec + 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 + clientRequest c rm 5 enc mempty >>= \case + Left e -> fail $ "Got client error: " ++ show e + Right r -> case fromByteString (rspBody r) of + Left e -> fail $ "Got decoding error: " ++ show e + Right dec + | dec == pay -> return () + | otherwise -> fail $ "Got unexpected payload: " ++ show dec + x <- liftM Fixed $ randomRIO (0,1000) + y <- liftM Fixed $ randomRIO (0,1000) + let addPay = AddRequest x y + addEnc = BL.toStrict . toLazyByteString $ addPay + clientRequest c rmAdd 5 addEnc mempty >>= \case + Left e -> fail $ "Got client error on add request: " ++ show e + Right r -> case fromByteString (rspBody r) of + Left e -> fail $ "failed to decode add response: " ++ show e + Right dec + | dec == AddResponse (x + y) -> return () + | otherwise -> fail $ "Got wrong add answer: " ++ show dec ++ "expected: " ++ show x ++ " + " ++ show y ++ " = " ++ show (x+y) main = highlevelMain diff --git a/examples/echo/echo-cpp/echo-client.cc b/examples/echo/echo-cpp/echo-client.cc index 628d674..3be4760 100644 --- a/examples/echo/echo-cpp/echo-client.cc +++ b/examples/echo/echo-cpp/echo-client.cc @@ -1,5 +1,6 @@ #include #include +#include #include @@ -51,24 +52,31 @@ private: unique_ptr 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: "<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: "<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(builder.BuildAndStart()); server->Wait(); return 0; diff --git a/examples/echo/echo-server/Main.hs b/examples/echo/echo-server/Main.hs index a2d476d..241a374 100644 --- a/examples/echo/echo-server/Main.hs +++ b/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 diff --git a/grpc-haskell.cabal b/grpc-haskell.cabal index 66cd841..e846638 100644 --- a/grpc-haskell.cabal +++ b/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 diff --git a/src/Network/GRPC/LowLevel/Call.hs b/src/Network/GRPC/LowLevel/Call.hs index 04bb84e..9d9cca9 100644 --- a/src/Network/GRPC/LowLevel/Call.hs +++ b/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 diff --git a/src/Network/GRPC/LowLevel/Call/Unregistered.hs b/src/Network/GRPC/LowLevel/Call/Unregistered.hs index b96739b..f65a2e7 100644 --- a/src/Network/GRPC/LowLevel/Call/Unregistered.hs +++ b/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 diff --git a/src/Network/GRPC/LowLevel/Server.hs b/src/Network/GRPC/LowLevel/Server.hs index e15d72f..bddd825 100644 --- a/src/Network/GRPC/LowLevel/Server.hs +++ b/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 - callCQ <- createCompletionQueue serverGRPC - serverRequestCall rm unsafeServer serverCQ callCQ +serverCreateCall Server{..} rm = + serverRequestCall rm unsafeServer serverCQ serverCallCQ withServerCall :: Server -> RegisteredMethod mt diff --git a/src/Network/GRPC/LowLevel/Server/Unregistered.hs b/src/Network/GRPC/LowLevel/Server/Unregistered.hs index 22fcc72..bd29312 100644 --- a/src/Network/GRPC/LowLevel/Server/Unregistered.hs +++ b/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 callCQ + serverRequestCall unsafeServer serverCQ serverCallCQ withServerCall :: Server -> (ServerCall -> IO (Either GRPCIOError a)) diff --git a/src/Network/GRPC/Unsafe.chs b/src/Network/GRPC/Unsafe.chs index c58cc87..02669f6 100644 --- a/src/Network/GRPC/Unsafe.chs +++ b/src/Network/GRPC/Unsafe.chs @@ -47,8 +47,8 @@ deriving instance Show Call deriving instance Show CallDetails -{#fun create_call_details as ^ {} -> `CallDetails'#} -{#fun destroy_call_details as ^ {`CallDetails'} -> `()'#} +{#fun unsafe create_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* #} diff --git a/src/Network/GRPC/Unsafe/ByteBuffer.chs b/src/Network/GRPC/Unsafe/ByteBuffer.chs index 9181077..28026ba 100644 --- a/src/Network/GRPC/Unsafe/ByteBuffer.chs +++ b/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 diff --git a/src/Network/GRPC/Unsafe/Metadata.chs b/src/Network/GRPC/Unsafe/Metadata.chs index 0ab7121..42a7edd 100644 --- a/src/Network/GRPC/Unsafe/Metadata.chs +++ b/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. diff --git a/src/Network/GRPC/Unsafe/Op.chs b/src/Network/GRPC/Unsafe/Op.chs index b0078ac..8724a4f 100644 --- a/src/Network/GRPC/Unsafe/Op.chs +++ b/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'} -> `()'#} diff --git a/src/Network/GRPC/Unsafe/Slice.chs b/src/Network/GRPC/Unsafe/Slice.chs index c33e3ef..e69744f 100644 --- a/src/Network/GRPC/Unsafe/Slice.chs +++ b/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. diff --git a/src/Network/GRPC/Unsafe/Time.chs b/src/Network/GRPC/Unsafe/Time.chs index b36986e..2a2b21e 100644 --- a/src/Network/GRPC/Unsafe/Time.chs +++ b/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