eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-23 03:29:42 +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
-> ServerReaderHandlerLL
-> IO (Either GRPCIOError ())
serverReader s rm initMeta f = withServerCall s rm go
where
go sc@ServerCall{ unsafeSC = c, callCQ = ccq } = runExceptT $ do
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
@ -343,6 +350,7 @@ serverReader s rm initMeta f = withServerCall s rm go
)
return ()
--------------------------------------------------------------------------------
-- serverWriter (server side of server streaming mode)
@ -357,9 +365,16 @@ 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
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
@ -378,9 +393,16 @@ 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
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

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