Home > Blockchain >  Stream with Servant and mtl style
Stream with Servant and mtl style

Time:11-25

I have the following endpoint defined using servant:

type ServiceAPI = "maintenance" :> Get '[PlainText] Text

myServer ::
     MonadIO m
  => MonadLog m
  => MonadMetrics m
  => MonadRandom m
  => Config
  -> Client
  -> ServerT ServiceAPI m
myServer cfg client = ...

The content is sometimes too big to be returned immediately and the HTTP request times out. I would like to transformed this service into some kind of stream-based response. Something similar to:

type ServiceAPI = "maintenance" :> StreamGet NewlineFraming PlainText (SourceIO Text) -- or SourceT m Text

However, I do not understand / figure out how to update the myServer to play nicely with the streaming SourceIO (SourceT m). I believe it cannot be with SourceIO because type SourceIO = SourceT IO and here we have some other monad stacks.

  • How can I stream the content of this response? (If Text makes things difficult, I can work also with [Text], but the MonadIO may complain that MonadIO does not have an instance for (MonadIO []) or similar). (Thanks!)

CodePudding user response:

It seems that you need a SourceT m Text. Looking in Servant.Types.SourceT, the definition is

newtype SourceT m a = SourceT
    { unSourceT :: forall b. (StepT m a -> m b) -> m b
    }

So, we are given a consumer function StepT m Text -> m b, and we need to pass a StepT m Text to it.

We may ask, why doesn't Servant require StepT m Text directly, instead of this continuation-passing definition? The answer is that the continuation-passing definition lets you insert bracket-like operations that, for example, open a file at the beginning and ensure the file is closed once streaming is finished.

A possible problem I see with your signature is that the constraints do not support bracket-like operations. You need something like MonadUnliftIO or MonadMask for that. MonadIO is not enough.

Assuming that your monad has an instance of MonadUnliftIO, then you could stream a Text file like this:

 {-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad.IO.Unlift -- from "unliftio-core"
import Data.Text
import Data.Text.IO
import Servant.API
import Servant.Server
import Servant.Types.SourceT
import System.FilePath
import System.IO

serveText :: forall m. MonadUnliftIO m => FilePath -> SourceT m Text
serveText filePath = SourceT $ \consumer ->
  withRunInIO $ \unlift ->
    withFile filePath ReadMode $ \handle -> do
      let steps :: StepT m Text
          steps =
            Effect
              ( do
                  eof <- liftIO $ hIsEOF handle
                  if eof
                    then pure Stop
                    else do
                      line <- liftIO $ Data.Text.IO.hGetLine handle
                      pure (Yield line steps) -- recurse for more lines
              )
      -- we get down to IO to satisfy the signature of withFile,
      -- the withRunInIO brings us back to m
      unlift (consumer steps)

(Be careful of a naive use of hGetLine because it uses the default encoding of the system. Something like streamDecodeUtf8 could be better in practice.)

Some notes:

  • Only monads isomorphic to ReaderT can be instances of MonadUnliftIO, and yours might not fit the pattern. Perhaps it's a MonadMask.
  • Perhaps, instead of using classic bracket, or withField, you could try using the resourcet package.
  • There are adapters for popular streaming libraries that free you from having to define the StepT directly.

CodePudding user response:

As always, the answer lies in how you are trying to type it. We want to return a stream, for which we update the type of the ServiceAPI as follows:

type ServiceAPI = "maintenance" :> StreamGet NewlineFraming PlainText (SourceIO Text)

The type of myServer stays exactly the same. Since I am new to servant, I didn't realise that what we want to return is a SourceT IO Text in whatever the body of myServer computes. To better see the types, let's assume that myServer body calls function myFunc as follows, where myFunc was before returning Text or [Text] (this solution works for both with minimal refactoring efforts).

myServer ::
     MonadIO m
  => MonadLog m
  => MonadMetrics m
  => MonadRandom m
  => Config
  -> ServerT ServiceAPI m
myServer cfg = myFunc cfg

myFunc ::
     MonadIO m
  => MonadLog m
  => Config
  -> m (SourceT IO Text)
myFunc cfg client = do
  ...
  let ls = _ :: [Text] -- some [Text]
  pure $ source ls

The realisation is that we do not want myFunc to return SourceT m Text but m (SourceT IO Text). One of the missing pieces is that source :: [a] -> SourceT n a and that we want n = IO, such that we can return SourceIO = SourceT IO.

(My mistake was in understanding the return type of myFunc as SourceT m Text, when it should have been m (SourceT IO Text), and quite correctly, the type checker was disallowing this)

  • Related