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

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

@ -333,9 +333,16 @@ 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
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) (mmsg, trailMeta, st, ds) <- liftIO $ f sc (streamRecvPrim c ccq)
runOps' c ccq ( OpSendInitialMetadata initMeta runOps' c ccq ( OpSendInitialMetadata initMeta
: OpSendStatusFromServer trailMeta st ds : OpSendStatusFromServer trailMeta st ds
@ -343,6 +350,7 @@ serverReader s rm initMeta f = withServerCall s rm go
) )
return () return ()
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- serverWriter (server side of server streaming mode) -- serverWriter (server side of server streaming mode)
@ -357,9 +365,16 @@ 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
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 sendInitialMetadata c ccq initMeta
st <- liftIO $ f sc (streamSendPrim c ccq) st <- liftIO $ f sc (streamSendPrim c ccq)
sendStatusFromServer c ccq st sendStatusFromServer c ccq st
@ -378,9 +393,16 @@ 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
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 sendInitialMetadata c ccq initMeta
st <- liftIO $ f sc (streamRecvPrim c ccq) (streamSendPrim c ccq) st <- liftIO $ f sc (streamRecvPrim c ccq) (streamSendPrim c ccq)
sendStatusFromServer c ccq st sendStatusFromServer c ccq st

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