eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-06-29 07:58:35 +02: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
-> 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)

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

@ -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