mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-23 03:29:42 +01:00
More reuse between unregistered and registered LL server functions (#67)
This commit is contained in:
Joel Stanley
GitHub Enterprise
parent
d7b00ac054
commit
a5614befe3
2 changed files with 51 additions and 39 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue