haskellservant

Stream with Servant and mtl style

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.

Solution

  • 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: