grpc-haskell-core 0.0.0.0 → 0.1.0
raw patch · 6 files changed
+76/−86 lines, 6 files
Files
- cbits/grpc_haskell.c +3/−28
- grpc-haskell-core.cabal +1/−1
- src/Network/GRPC/LowLevel/Server/Unregistered.hs +1/−1
- src/Network/GRPC/Unsafe.chs +0/−3
- src/Network/GRPC/Unsafe/Op.chs +0/−5
- tests/LowLevelTests/Op.hs +71/−48
cbits/grpc_haskell.c view
@@ -210,33 +210,8 @@ #ifdef GRPC_HASKELL_DEBUG printf("C wrapper: entered op_array_destroy\n"); #endif- for(int i = 0; i < n; i++){- grpc_op* op = op_array + i;- switch (op->op) {- case GRPC_OP_SEND_INITIAL_METADATA:- metadata_free(op->data.send_initial_metadata.metadata);- break;- case GRPC_OP_SEND_MESSAGE:- grpc_byte_buffer_destroy(op->data.send_message.send_message);- break;- case GRPC_OP_SEND_CLOSE_FROM_CLIENT:- break;- case GRPC_OP_SEND_STATUS_FROM_SERVER:- grpc_haskell_free("op_array_destroy: GRPC_OP_SEND_STATUS_FROM_SERVER",- op->data.send_status_from_server.trailing_metadata);- grpc_haskell_free("op_array_destroy: GRPC_OP_SEND_STATUS_FROM_SERVER",- (char*)(op->data.send_status_from_server.status_details));- break;- case GRPC_OP_RECV_INITIAL_METADATA:- break;- case GRPC_OP_RECV_MESSAGE:- break;- case GRPC_OP_RECV_STATUS_ON_CLIENT:- break;- case GRPC_OP_RECV_CLOSE_ON_SERVER:- break;- }- }+ // This only destroys the array, the values in the array+ // are freed in freeOpContext grpc_haskell_free("op_array_destroy", op_array); } @@ -530,7 +505,7 @@ 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.
grpc-haskell-core.cabal view
@@ -1,5 +1,5 @@ name: grpc-haskell-core-version: 0.0.0.0+version: 0.1.0 synopsis: Haskell implementation of gRPC layered on shared C library. homepage: https://github.com/awakenetworks/gRPC-haskell license: Apache-2.0
src/Network/GRPC/LowLevel/Server/Unregistered.hs view
@@ -48,7 +48,7 @@ -> (ServerCall -> IO ()) -> IO () withServerCallAsync s f = mask $ \unmask ->- serverCreateCall s >>= \case+ unmask (serverCreateCall s) >>= \case Left e -> do grpcDebug $ "withServerCallAsync: call error: " ++ show e return () Right c -> do wasForkSuccess <- forkServer s handler
src/Network/GRPC/Unsafe.chs view
@@ -219,9 +219,6 @@ 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.
src/Network/GRPC/Unsafe/Op.chs view
@@ -4,7 +4,6 @@ {#import Network.GRPC.Unsafe.Slice#} -import Control.Exception import Foreign.C.Types import Foreign.Ptr {#import Network.GRPC.Unsafe.ByteBuffer#}@@ -46,10 +45,6 @@ -- | Destroys an 'OpArray' of the given size. {#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-withOpArray n f = bracket (opArrayCreate n) (flip opArrayDestroy n) f -- | Creates an op of type GRPC_OP_SEND_INITIAL_METADATA at the specified -- index of the given 'OpArray', containing the given
tests/LowLevelTests/Op.hs view
@@ -1,60 +1,77 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards #-} module LowLevelTests.Op where -import Data.ByteString (ByteString)-import Test.Tasty-import Test.Tasty.HUnit as HU (testCase, (@?=))--import Network.GRPC.LowLevel-import Network.GRPC.LowLevel.Call-import Network.GRPC.LowLevel.Client-import Network.GRPC.LowLevel.Server-import Network.GRPC.LowLevel.Op+import Control.Concurrent+import Control.Exception+import Control.Monad+import Data.ByteString (ByteString)+import Network.GRPC.LowLevel+import Network.GRPC.LowLevel.Call+import Network.GRPC.LowLevel.Client+import Network.GRPC.LowLevel.Op+import Network.GRPC.LowLevel.Server+import Test.Tasty+import Test.Tasty.HUnit as HU (testCase, (@?=)) lowLevelOpTests :: TestTree-lowLevelOpTests = testGroup "Synchronous unit tests of low-level Op interface"- [testCancelFromServer]+lowLevelOpTests =+ testGroup+ "Synchronous unit tests of low-level Op interface"+ [testCancelFromServer] testCancelFromServer :: TestTree testCancelFromServer = testCase "Client/Server - client receives server cancellation" $- runSerialTest $ \grpc ->- withClientServerUnaryCall grpc $- \(Client{..}, Server{..}, ClientCall{..}, sc@ServerCall{..}) -> do- serverCallCancel sc StatusPermissionDenied "TestStatus"- clientRes <- runOps unsafeCC clientCQ clientRecvOps- case clientRes of- Left x -> error $ "Client recv error: " ++ show x- Right [_,_,OpRecvStatusOnClientResult _ code _details] -> do- code @?= StatusPermissionDenied- return $ Right ()- wrong -> error $ "Unexpected op results: " ++ show wrong-+ runSerialTest $ \grpc ->+ withClientServerUnaryCall grpc $+ \(Client {..}, Server {..}, ClientCall {..}, sc@ServerCall {..}) -> do+ serverCallCancel sc StatusPermissionDenied "TestStatus"+ clientRes <- runOps unsafeCC clientCQ clientRecvOps+ case clientRes of+ Left x -> error $ "Client recv error: " ++ show x+ Right [_, _, OpRecvStatusOnClientResult _ code _details] -> do+ code @?= StatusPermissionDenied+ return $ Right ()+ wrong -> error $ "Unexpected op results: " ++ show wrong runSerialTest :: (GRPC -> IO (Either GRPCIOError ())) -> IO () runSerialTest f =- withGRPC f >>= \case Left x -> error $ show x- Right () -> return ()+ withGRPC f >>= \case+ Left x -> error $ show x+ Right () -> return () -withClientServerUnaryCall :: GRPC- -> ((Client, Server, ClientCall,- ServerCall ByteString)- -> IO (Either GRPCIOError a))- -> IO (Either GRPCIOError a)+withClientServerUnaryCall ::+ GRPC ->+ ( ( Client,+ Server,+ ClientCall,+ ServerCall ByteString+ ) ->+ IO (Either GRPCIOError a)+ ) ->+ IO (Either GRPCIOError a) 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) @@ -65,16 +82,22 @@ clientConf = ClientConfig "localhost" 50051 [] Nothing Nothing clientEmptySendOps :: [Op]-clientEmptySendOps = [OpSendInitialMetadata mempty,- OpSendMessage "",- OpSendCloseFromClient]+clientEmptySendOps =+ [ OpSendInitialMetadata mempty,+ OpSendMessage "",+ OpSendCloseFromClient+ ] clientRecvOps :: [Op]-clientRecvOps = [OpRecvInitialMetadata,- OpRecvMessage,- OpRecvStatusOnClient]+clientRecvOps =+ [ OpRecvInitialMetadata,+ OpRecvMessage,+ OpRecvStatusOnClient+ ] serverEmptyRecvOps :: [Op]-serverEmptyRecvOps = [OpSendInitialMetadata mempty,- OpRecvMessage,- OpRecvCloseOnServer]+serverEmptyRecvOps =+ [ OpSendInitialMetadata mempty,+ OpRecvMessage,+ OpRecvCloseOnServer+ ]