eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-26 21:19:43 +01:00
Code Issues Projects Releases Wiki Activity

More reuse between unregistered and registered LL server functions (#67)

Browse source
This commit is contained in:
Joel Stanley 2016-08-10 16:38:58 -05:00 committed by GitHub Enterprise
parent d7b00ac054
commit a5614befe3
2 changed files with 51 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

64
src/Network/GRPC/LowLevel/Server.hs
View file

@ -333,15 +333,23 @@ serverReader :: Server
-> MetadataMap -- ^ Initial server metadata -> MetadataMap -- ^ Initial server metadata
-> ServerReaderHandlerLL -> ServerReaderHandlerLL
-> IO (Either GRPCIOError ()) -> IO (Either GRPCIOError ())
serverReader s rm initMeta f = withServerCall s rm go serverReader s rm initMeta f =
where withServerCall s rm (\sc -> serverReader' s sc initMeta f)
go sc@ServerCall{ unsafeSC = c, callCQ = ccq } = runExceptT $ do
(mmsg, trailMeta, st, ds) <- liftIO $ f sc (streamRecvPrim c ccq) serverReader' :: Server
runOps' c ccq ( OpSendInitialMetadata initMeta -> ServerCall (MethodPayload 'ClientStreaming)
: OpSendStatusFromServer trailMeta st ds -> MetadataMap -- ^ Initial server metadata
: maybe [] ((:[]) . OpSendMessage) mmsg -> ServerReaderHandlerLL
) -> IO (Either GRPCIOError ())
return () 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) -- serverWriter (server side of server streaming mode)
@ -357,12 +365,19 @@ serverWriter :: Server
-> MetadataMap -- ^ Initial server metadata -> MetadataMap -- ^ Initial server metadata
-> ServerWriterHandlerLL -> ServerWriterHandlerLL
-> IO (Either GRPCIOError ()) -> IO (Either GRPCIOError ())
serverWriter s rm initMeta f = withServerCall s rm go serverWriter s rm initMeta f =
where withServerCall s rm (\sc -> serverWriter' s sc initMeta f)
go sc@ServerCall{ unsafeSC = c, callCQ = ccq } = runExceptT $ do
sendInitialMetadata c ccq initMeta serverWriter' :: Server
st <- liftIO $ f sc (streamSendPrim c ccq) -> ServerCall (MethodPayload 'ServerStreaming)
sendStatusFromServer c ccq st -> 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) -- serverRW (bidirectional streaming mode)
@ -378,12 +393,19 @@ serverRW :: Server
-> MetadataMap -- ^ initial server metadata -> MetadataMap -- ^ initial server metadata
-> ServerRWHandlerLL -> ServerRWHandlerLL
-> IO (Either GRPCIOError ()) -> IO (Either GRPCIOError ())
serverRW s rm initMeta f = withServerCall s rm go serverRW s rm initMeta f =
where withServerCall s rm (\sc -> serverRW' s sc initMeta f)
go sc@ServerCall{ unsafeSC = c, callCQ = ccq } = runExceptT $ do
sendInitialMetadata c ccq initMeta serverRW' :: Server
st <- liftIO $ f sc (streamRecvPrim c ccq) (streamSendPrim c ccq) -> ServerCall (MethodPayload 'BiDiStreaming)
sendStatusFromServer c ccq st -> 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) -- serverHandleNormalCall (server side of normal request/response)

26
src/Network/GRPC/LowLevel/Server/Unregistered.hs
View file

@ -16,7 +16,10 @@ import Network.GRPC.LowLevel.Server (Server (..)
ServerRWHandlerLL, ServerRWHandlerLL,
ServerReaderHandlerLL, ServerReaderHandlerLL,
ServerWriterHandlerLL, ServerWriterHandlerLL,
forkServer) forkServer,
serverReader',
serverWriter',
serverRW')
import qualified Network.GRPC.Unsafe.Op as C import qualified Network.GRPC.Unsafe.Op as C
serverCreateCall :: Server serverCreateCall :: Server
@ -118,34 +121,21 @@ serverReader :: Server
-> MetadataMap -- ^ Initial server metadata -> MetadataMap -- ^ Initial server metadata
-> ServerReaderHandlerLL -> ServerReaderHandlerLL
-> IO (Either GRPCIOError ()) -> IO (Either GRPCIOError ())
serverReader _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = serverReader s = serverReader' s . convertCall
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 ()
serverWriter :: Server serverWriter :: Server
-> ServerCall -> ServerCall
-> MetadataMap -- ^ Initial server metadata -> MetadataMap -- ^ Initial server metadata
-> ServerWriterHandlerLL -> ServerWriterHandlerLL
-> IO (Either GRPCIOError ()) -> IO (Either GRPCIOError ())
serverWriter _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = serverWriter s sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f =
runExceptT $ do runExceptT $ do
bs <- recvInitialMessage c ccq bs <- recvInitialMessage c ccq
sendInitialMetadata c ccq initMeta ExceptT (serverWriter' s (const bs <$> convertCall sc) initMeta f)
st <- liftIO $ f (const bs <$> convertCall sc) (streamSendPrim c ccq)
sendStatusFromServer c ccq st
serverRW :: Server serverRW :: Server
-> ServerCall -> ServerCall
-> MetadataMap -- ^ Initial server metadata -> MetadataMap -- ^ Initial server metadata
-> ServerRWHandlerLL -> ServerRWHandlerLL
-> IO (Either GRPCIOError ()) -> IO (Either GRPCIOError ())
serverRW _ sc@ServerCall{ unsafeSC = c, callCQ = ccq } initMeta f = serverRW s = serverRW' s . convertCall
runExceptT $ do
sendInitialMetadata c ccq initMeta
st <- liftIO $ f (convertCall sc) (streamRecvPrim c ccq) (streamSendPrim c ccq)
sendStatusFromServer c ccq st