From a5614befe3dc575724c33a06c46b82adeab4f5d0 Mon Sep 17 00:00:00 2001 From: Joel Stanley Date: Wed, 10 Aug 2016 16:38:58 -0500 Subject: [PATCH] More reuse between unregistered and registered LL server functions (#67) --- src/Network/GRPC/LowLevel/Server.hs | 64 +++++++++++++------ .../GRPC/LowLevel/Server/Unregistered.hs | 26 +++----- 2 files changed, 51 insertions(+), 39 deletions(-) diff --git a/src/Network/GRPC/LowLevel/Server.hs b/src/Network/GRPC/LowLevel/Server.hs index 3ced246..152b9b8 100644 --- a/src/Network/GRPC/LowLevel/Server.hs +++ b/src/Network/GRPC/LowLevel/Server.hs @@ -333,15 +333,23 @@ serverReader :: Server -> MetadataMap -- ^ Initial server metadata -> ServerReaderHandlerLL -> IO (Either GRPCIOError ()) -serverReader s rm initMeta f = withServerCall s rm go - where - go sc@ServerCall{ unsafeSC = c, callCQ = ccq } = runExceptT $ do - (mmsg, trailMeta, st, ds) <- liftIO $ f sc (streamRecvPrim c ccq) - runOps' c ccq ( OpSendInitialMetadata initMeta - : OpSendStatusFromServer trailMeta st ds - : maybe [] ((:[]) . OpSendMessage) mmsg - ) - return () +serverReader s rm initMeta f = + withServerCall s rm (\sc -> serverReader' s sc initMeta f) + +serverReader' :: Server + -> ServerCall (MethodPayload 'ClientStreaming) + -> MetadataMap -- ^ Initial server metadata + -> ServerReaderHandlerLL + -> IO (Either GRPCIOError ()) +serverReader' _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = + runExceptT $ do + (mmsg, trailMeta, st, ds) <- liftIO $ f sc (streamRecvPrim c ccq) + runOps' c ccq ( OpSendInitialMetadata initMeta + : OpSendStatusFromServer trailMeta st ds + : maybe [] ((:[]) . OpSendMessage) mmsg + ) + return () + -------------------------------------------------------------------------------- -- serverWriter (server side of server streaming mode) @@ -357,12 +365,19 @@ serverWriter :: Server -> MetadataMap -- ^ Initial server metadata -> ServerWriterHandlerLL -> IO (Either GRPCIOError ()) -serverWriter s rm initMeta f = withServerCall s rm go - where - go sc@ServerCall{ unsafeSC = c, callCQ = ccq } = runExceptT $ do - sendInitialMetadata c ccq initMeta - st <- liftIO $ f sc (streamSendPrim c ccq) - sendStatusFromServer c ccq st +serverWriter s rm initMeta f = + withServerCall s rm (\sc -> serverWriter' s sc initMeta f) + +serverWriter' :: Server + -> ServerCall (MethodPayload 'ServerStreaming) + -> MetadataMap + -> ServerWriterHandlerLL + -> IO (Either GRPCIOError ()) +serverWriter' _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = + runExceptT $ do + sendInitialMetadata c ccq initMeta + st <- liftIO $ f sc (streamSendPrim c ccq) + sendStatusFromServer c ccq st -------------------------------------------------------------------------------- -- serverRW (bidirectional streaming mode) @@ -378,12 +393,19 @@ serverRW :: Server -> MetadataMap -- ^ initial server metadata -> ServerRWHandlerLL -> IO (Either GRPCIOError ()) -serverRW s rm initMeta f = withServerCall s rm go - where - go sc@ServerCall{ unsafeSC = c, callCQ = ccq } = runExceptT $ do - sendInitialMetadata c ccq initMeta - st <- liftIO $ f sc (streamRecvPrim c ccq) (streamSendPrim c ccq) - sendStatusFromServer c ccq st +serverRW s rm initMeta f = + withServerCall s rm (\sc -> serverRW' s sc initMeta f) + +serverRW' :: Server + -> ServerCall (MethodPayload 'BiDiStreaming) + -> MetadataMap + -> ServerRWHandlerLL + -> IO (Either GRPCIOError ()) +serverRW' _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = + runExceptT $ do + sendInitialMetadata c ccq initMeta + st <- liftIO $ f sc (streamRecvPrim c ccq) (streamSendPrim c ccq) + sendStatusFromServer c ccq st -------------------------------------------------------------------------------- -- serverHandleNormalCall (server side of normal request/response) diff --git a/src/Network/GRPC/LowLevel/Server/Unregistered.hs b/src/Network/GRPC/LowLevel/Server/Unregistered.hs index 2f3876b..192453c 100644 --- a/src/Network/GRPC/LowLevel/Server/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Server/Unregistered.hs @@ -16,7 +16,10 @@ import Network.GRPC.LowLevel.Server (Server (..) ServerRWHandlerLL, ServerReaderHandlerLL, ServerWriterHandlerLL, - forkServer) + forkServer, + serverReader', + serverWriter', + serverRW') import qualified Network.GRPC.Unsafe.Op as C serverCreateCall :: Server @@ -118,34 +121,21 @@ serverReader :: Server -> MetadataMap -- ^ Initial server metadata -> ServerReaderHandlerLL -> IO (Either GRPCIOError ()) -serverReader _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = - runExceptT $ do - (mmsg, trailMeta, st, ds) <- liftIO $ f (convertCall sc) (streamRecvPrim c ccq) - runOps' c ccq ( OpSendInitialMetadata initMeta - : OpSendStatusFromServer trailMeta st ds - : maybe [] ((:[]) . OpSendMessage) mmsg - ) - return () +serverReader s = serverReader' s . convertCall serverWriter :: Server -> ServerCall -> MetadataMap -- ^ Initial server metadata -> ServerWriterHandlerLL -> IO (Either GRPCIOError ()) -serverWriter _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = +serverWriter s sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = runExceptT $ do bs <- recvInitialMessage c ccq - sendInitialMetadata c ccq initMeta - st <- liftIO $ f (const bs <$> convertCall sc) (streamSendPrim c ccq) - sendStatusFromServer c ccq st + ExceptT (serverWriter' s (const bs <$> convertCall sc) initMeta f) serverRW :: Server -> ServerCall -> MetadataMap -- ^ Initial server metadata -> ServerRWHandlerLL -> IO (Either GRPCIOError ()) -serverRW _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = - runExceptT $ do - sendInitialMetadata c ccq initMeta - st <- liftIO $ f (convertCall sc) (streamRecvPrim c ccq) (streamSendPrim c ccq) - sendStatusFromServer c ccq st +serverRW s = serverRW' s . convertCall