how to call withClientM - Polysemy

Welcome to the Functional Programming Zulip Chat Archive. You can join the chat here.

Alex Chapman

I am trying to wrap a call to withClientM from servant-client inside a
Polysemy effect.

withClientM :: ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b

I want my effect to look something like this:

data ServantClient m a where
  RunClient :: ClientM o -> ServantClient m o

runServantClient
  :: Members
    '[ Embed IO
     , Error ClientError
     ] r
  => BaseUrl -> Sem (ServantClient ': r) a -> Sem r a

Now I could do this with an implementation like this:

runServantClient server m = do
  manager <- embed $ newManager tlsManagerSettings
  let env = mkClientEnv manager server
  interpret (\case
    RunClient client ->
      fromEitherM $ withClientM client env pure
    ) m

But this doesn't work for streaming client responses, which is what I need. I can't just return the response, and resume the rest of my program with it. The rest of my program needs to run inside withClientM, otherwise the stream closes before the program can consume it.

I have tried the following, using Polysemy.Cont from polysemy-zoo:

runServantClientStreaming
  :: Members
    '[ Cont ref
     , Embed IO
     , Error ClientError
     ] r
  => BaseUrl -> (forall b. Sem r o -> IO o) -> Sem (ServantClient ': r) a -> Sem r a
runServantClientStreaming server runIt m = do
  manager <- embed $ newManager tlsManagerSettings
  let env = mkClientEnv manager server
  interpret (\case
    RunClient client -> do
      result <- callCC (\continue ->
        embed $ withClientM client env (runIt . continue)
        )
      fromEither result
    ) m

But it's nasty, and I can't quite get it to typecheck. I'm just about out of ideas. Can anyone suggest how I might make this work?

Sandy Maguire

i'd call withClientM in main and yolo

Georgi Lyubenov // googleson78

isn't that effect "too specific", i.e. instead have an effect that gives you the data you actually need, and then when you want to run that effect you can use all the ClientM as generated by servant?
the annoying bit here is you're effectively re-describing the API as an effect, but if you work directly with ClientM o it seems to me like you're effectively restricting yourself to only running the effect with servant-client (no pure interpretation)

Georgi Lyubenov // googleson78

I don't understand what @Sandy Maguire means by "yolo calling it in main" - you still need to get the info to the "inside" of your effects world somehow (?)

Alex Chapman

Yes, it is a very specific effect. I do actually have the more general effect which produces the data I need, but my interpreter for that effect leaves this ServantClient effect behind. I think if I move my withClientM call into the general effect then I'll still be left with this problem though, because it still produces a stream as its output, which necessarily escapes the scope of withClientM.

Alex Chapman

re streaming, yes I saw Polysemy.Input.Streaming. I'm actually using machines for my streaming though, so I have another pair of interpreters for working with this:

runInputFromSourceT
  :: Member (Embed m) r
  => SourceT m o
  -> Sem (Input (Maybe o) ': r) a
  -> Sem r a
runInputFromSourceT source = fmap snd . runState source . reinterpret
  (\case
      Input -> do
        stream <- get
        step <- embed $ runMachineT stream
        case step of
          Stop -> pure Nothing
          Yield o rest -> do
            put rest
            pure (Just o)
          Await{} -> pure Nothing -- Shouldn't be possible in a SourceT?
  )

inputToSourceT
  :: Member (Input (Maybe o)) r
  => SourceT (Sem r) o
inputToSourceT = construct (exhaust input)
Torsten Schmits

@Alex Chapman I implemented http response streaming, with http-client, by passing a consumer to the effect (your ServantClient). It's basically Resource.

Alex Chapman

@Torsten Schmits can you elaborate, or share any code? I've tried to use Resource for this, but couldn't work out how to get alloc/dealloc arguments for bracket out of withClientM. I've been starting to think that I need to write my own Polysemy version of ClientM to make this work, but I had been hoping that Polysemy would be powerful enough to wrap any API, regardless of its form.

Torsten Schmits

@Alex Chapman With http-client, it's pretty simple, since it has an API for this purpose (Response values contain an IO ByteString that produces the next chunk). I'd happily share some code but I doubt it will help with your issue.

Torsten Schmits

since Servant has hardcoded ReaderT for both server and client, it's quite impossible to integrate with Polysemy, I think. I encountered the same problem when trying to run a server in my effect stack.

Torsten Schmits

@Alex Chapman there's a function performWithStreamingRequest, that should do it

Torsten Schmits

my effect looks like this:

data Http c m a where
    Stream :: Request -> (Response c -> m (Either HttpError a)) -> Http c m (Either HttpError a)

interpretHttpNativeWith ::
  Members [Embed IO, Log, Resource] r =>
  Manager ->
  InterpreterFor (Http BodyReader) r
interpretHttpNativeWith manager =
  interpretH $ \case
    Http.Stream request handler ->
      bracket acquire release use
      where
        acquire =
          embed $ responseOpen (nativeRequest request) manager
        release response =
          embed $ responseClose response
        use response = do
          raise . interpretHttpNativeWith manager =<< runT (handler (convertResponse response))

so you'd have to run the servant client perform function where I run handler

Alex Chapman

Ah, thanks a lot. I'll give that a try when I get a chance.

Torsten Schmits

although now I see that since the perform... function takes a handler producing IO you can't run a Sem in there. You'll have to dissect and rewrite that part

Alex Chapman

That's what I was afraid of :D

Torsten Schmits

wonder if anyone has a suggestion for an http framework that goes well with polysemy

Torsten Schmits

(server, that is. http-client is working out fine for me)

Torsten Schmits

and that perform function doesn't even run the client, you'd still need to call runClientM, so forget that

Torsten Schmits

would be worth the try to just replace IO with m in all of servant and see what needs to be fixed :slight_smile:

Georgi Lyubenov // googleson78

I'm using polysemy "under" servant-server, i.e. servant-server still handles spawning threads and such, but my handlers run in a Sem by using hoistServer in the end, before trying to serve

Torsten Schmits

yeah same. it's not optimal

Georgi Lyubenov // googleson78

what problems did you encounter with this approach?

Georgi Lyubenov // googleson78

I don't feel the need to also have effects for the functionality servant-server is providing, because I don't think I need to test it? after all it's a library

Torsten Schmits

well mainly that I cannot share interpreters across requests

Torsten Schmits

for example, a kafka connection

Georgi Lyubenov // googleson78

I have a mysql connection pool that's shared, would it be something similar?

Georgi Lyubenov // googleson78

I have some state-esque custom effect that I run with an interpreter that takes the connection pool and executes in IO (via Embed) - runDb let's say
I do runDb, discharge all my other effects, at which point I'm left with a combination of Either and IO, which is basically Handler, so I lift into it

would the same thing not work with your kafka connection?

Georgi Lyubenov // googleson78

and that's the only place where I have to pass in the connection

Georgi Lyubenov // googleson78

maybe I'm misunderstanding something :/

Torsten Schmits

you're passing the connection into the warp main function and feeding it into an interpreter?

Georgi Lyubenov // googleson78
main = do
  ....
      let runServer :: (MonadIO m, MonadUnliftIO m, MonadLogger m) => m ()
          runServer = withMySQLPool info 100 \backend -> liftIO do
            run 3000 $ serverDb backend
            putStrLn "server exited."

      runStdoutLoggingT runServer


-- the handler for my entire api
handler :: Members <all-my-direct-effects> r => ServerT API (Sem r)
handler = ...

api :: Proxy API
api = ...


serverDb :: Pool SqlBackend -> Application
serverDb backend = serve api $ hoistServer api (runServerIO backend) handler
  where
    runServerIO :: Pool SqlBackend -> Sem <all-my-effects> a -> Handler a
    runServerIO backend' = ...
Georgi Lyubenov // googleson78

serverDb is the bit I was referencing

Torsten Schmits

yeah so you have to handle the pool manually, that's what I meant with "not optimal"

Georgi Lyubenov // googleson78

well I only create it once and pass it in immediately, I guess it would be annoying if it weren't like that

Torsten Schmits

so how would the signature of an http server have to look in order to work well with polysemy?

Torsten Schmits

would it be sufficient to parameterize the IO?

Torsten Schmits

could one use Embed HandlerT?

Alex Chapman

So, for my withClientM problem, I have found a solution, albeit a slightly ugly one:

runServantClientStreaming
  :: Members
    '[ Cont ref
     , Embed IO
     , Error ClientError
     ] r
  => BaseUrl -> Sem (ServantClientStreaming ': r) a -> Sem r a
runServantClientStreaming server m = do
  manager <- embed $ newManager tlsManagerSettings
  let env = mkClientEnv manager server
  interpret (\case
    RunClientStreaming client ->
      subst (\continue ->
        withLowerToIO $ \unliftIO _ ->
          withClientM client env (unliftIO . jump continue)
        ) fromEither
    ) m

It uses subst from Cont to pack all of the future computations up, and then withLowerToIO (which runs in a new thread!) to run the client, and the rest of the future computations, in IO. And by some miracle it works! I haven't tested it with two long-running servant client sessions though...

Torsten Schmits

I will have to try that for the server

Torsten Schmits

I was wondering whether "lower to IO" is a concept that applies here, though I haven't understood it yet

Alex Chapman

Yeah, I was stuck with an Either ClientError a -> Sem r a, but I needed an Either ClientError a -> IO a, so withLowerToIO was the solution. It's very similar to UnliftIO (https://hackage.haskell.org/package/unliftio).

Torsten Schmits

yeah that was my reference as well

Alex Chapman

I can't figure out how to use this and errorToIOFinal though. Because using runContM seems to exclude the use of Final IO, and contToFinal comes with a scary warning that I don't understand.

Alex Chapman

Oh, and there's no instance for MonadCont IO

Alex Chapman

and errorToFinal forces use of Final IO, so I can't use Final (ContT IO)

Torsten Schmits

can't you just Embed IO, then embedToFinal, then errorToIOFinal?

Alex Chapman

I think not, because runContM produces a fixed effect list: Sem '[Embed m] a

Torsten Schmits

so maybe first runError, then fromEither after?

Torsten Schmits

this probably breaks something though

Alex Chapman

Yeah, runError works, dealing with the Either and finishing with & runContM & runM

Torsten Schmits

I can't believe it but this just fucking works™:

type Route =
  Get '[JSON] NoContent

server ::
  Members [Embed IO, State [Int]] r =>
  ServerT Route (Sem r)
server = do
  NoContent <$ (put =<< change =<< get)
  where
    change is =
      (1 : is) <$ embed (print is)

run ::
  Members [Embed IO, State [Int]] r =>
  ServerT Route (Sem r) ->
  Sem r ()
run srv =
  withLowerToIO $ \unliftIO _ ->
    Warp.run 10000 (logStdout (serve (Proxy @Route) (hoistServer (Proxy @Route) (Handler . lift . unliftIO) srv)))

main :: IO ()
main =
    liftIO $
    runFinal $
    embedToFinal $
    evalState [] $
    run server

Polysemy is so great