How to use your own Monad in servant-websocket's conduit endpoint?-CodePudding

I'm trying to figure out how to use a custom monad in the ConduitT definition of the WebSocketConduit endpoint provided by the servant-websocket library.

Say that I have this API:

type MyAPI = "ws" :> WebSocketConduit Value Value

if I try to define a handler for that endpoint that just copies input but I specify a Monad different from the parametric m:

ws :: ConduitT Value Value (Reader String) ()
ws _ = CL.map id

I get this error:

    • Couldn't match type: transformers-0.5.6.2:Control.Monad.Trans.Reader.ReaderT
                             String Data.Functor.Identity.Identity
                     with: resourcet-1.2.5:Control.Monad.Trans.Resource.Internal.ResourceT
                             IO

I faced this problem because the monad I want to use is one created with Polysemy with lots of effects, but I wanted to keep the example simple using the Reader monad.

So the general question is, how do you use a custom monad in a Conduit Websocket endpoint?

Solution

Thanks to the tips from fghibellini this is the full solution to a toy example:

#!/usr/bin/env stack
{-
 stack --resolver lts-19.07 script --package servant --package servant-server
       --package servant-websockets --package polysemy --package aeson --package mtl
       --package wai --package warp --package conduit
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Conduit
import qualified Data.Conduit.List as CL
import Control.Monad.Except (ExceptT(ExceptT))
import Data.Aeson (ToJSON, FromJSON)
import Data.Char (toUpper)
import Data.Function ((&))
import GHC.Generics ( Generic )
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
import Polysemy ( runM, Sem, Members, Embed )
import Polysemy.Error ( runError, Error )
import Polysemy.Trace ( trace, traceToStdout, Trace )
import Servant
import Servant.API.WebSocketConduit (WebSocketConduit)
import Servant.Server

-- Dummy message
newtype Message = Message { content :: String } deriving (Show, Generic)

instance ToJSON Message
instance FromJSON Message

type MyApi = "toupper" :> ReqBody '[JSON] Message :> Post '[JSON] Message
            :<|> "ws-toupper" :> WebSocketConduit Message Message
            :<|> "ws-toupper-sem" :> WebSocketConduit Message Message


server :: Members '[Trace, Embed IO] r => ServerT MyApi (Sem r)
server = toupper :<|> wstoupper :<|> wstoupperWithSem

toupper :: Members '[Trace, Embed IO] r => Message -> Sem r Message
toupper (Message msg) = do
  trace $ "Received msg in the REST endpoint: "    msg
  return (Message . map toUpper $ msg)

wstoupper :: Monad m => ConduitT Message Message m ()
wstoupper = CL.map (\(Message msg) -> Message . map toUpper $ msg)

wstoupperWithSem :: ConduitT Message Message (ResourceT IO) ()
wstoupperWithSem = transPipe (liftIO . interpreter) semConduit
  where
    interpreter :: Sem '[Trace , Embed IO] a -> IO a
    interpreter sem = sem
      & traceToStdout
      & runM

    semConduit :: Members '[Trace, Embed IO] r => ConduitT Message Message (Sem r) ()
    semConduit = mapMC effect

    effect :: Members '[Trace] r => Message -> Sem r Message
    effect (Message msg) = do
      trace $ "Received msg through the WS: "    msg
      return (Message . map toUpper $ msg)

liftServer :: ServerT MyApi Handler
liftServer = hoistServer api interpreter server
  where
    interpreter :: Sem '[Trace, Error ServerError , Embed IO] a -> Handler a
    interpreter sem = sem
      & traceToStdout
      & runError
      & runM
      & liftHandler

    liftHandler = Handler . ExceptT


api :: Proxy MyApi
api = Proxy

app :: Application
app = serve api liftServer


main :: IO ()
main = do
  putStrLn "Starting server on http://localhost:8080"
  run 8080 app

CodePudding user response：

The HasServer instance of WebSocketConduit starts with:

instance (FromJSON i, ToJSON o) => HasServer (WebSocketConduit i o) ctx where

  type ServerT (WebSocketConduit i o) m = Conduit i (ResourceT IO) o

link to source code

as you can see the monad is fixed to ResourceT IO. That's why your example won't compile.

You can ignore the ResourceT part as you can trivially lift an IO into it. So your task boils down to evaluating your monad stack until you get a simple IO operation.

To evaluate the ReaderT String layer in your example we would use runReaderC :: Monad m => r -> ConduitT i o (ReaderT r m) res -> ConduitT i o m res. But generally you'd use whatever "runs/evaluates" your Monad into IO.

The following code compiles fine:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Servant
import Data.Conduit
import Data.Aeson (Value)
import qualified Data.Conduit.List as CL
import Servant.API.WebSocketConduit
import Control.Monad.Reader
import Data.Conduit.Lift (runReaderC)


type WebSocketApi = "echo" :> WebSocketConduit Value Value

server :: Server WebSocketApi
server = transPipe lift $ runReaderC "your-reader-state" echo
 where
  echo :: Conduit Value (ReaderT String IO) Value
  echo = CL.map id

there's a warning about using monad transformeres with conduit under transPipe, which you probably better read.

Correction

I just realized you used Reader String and not ReaderT String IO. I'm gonna leave the answer as it is as it illustrates a more common scenario, but for Reader String you'd just replace lift with (pure . runIdentity) to rewrap from Identity to IO.