Unlifting issue when using unliftio-pool

[fpringle]

Not sure if this is the right place to submit this. I'm also not sure whether this is an issue with my understanding of effectful and unlifiting, or an issue with unliftio-pool.

I'm trying to write a static effect ConnectionPool, which is effectively a Reader (Pool Connection). In practice, when I create a PoolConfig using defaultPoolConfig from resource-pool everything works as it should; however when I create it using unliftio-pool's mkDefaultPoolConfig I get issues. Here is a minimal repro:

module Main where

import qualified Data.Pool as P
import qualified Database.PostgreSQL.Simple as PSQL
import Effectful
import Effectful.Dispatch.Static
import Network.Wai.Handler.Warp
import qualified Servant.API as S
import qualified Servant.Server as S
import qualified UnliftIO.Pool as UP
import qualified "servant-effectful" Effectful.Servant as ES
import "base" Prelude

data ConnectionPool :: Effect

type instance DispatchOf ConnectionPool = Static WithSideEffects

newtype instance StaticRep ConnectionPool = MkConnectionPool (P.Pool PSQL.Connection)

runConnectionPoolConfig :: (IOE :> es) => P.PoolConfig PSQL.Connection -> Eff (ConnectionPool : es) a -> Eff es a
runConnectionPoolConfig cfg eff = do
  pool <- liftIO (P.newPool cfg)
  evalStaticRep (MkConnectionPool pool) eff

withConnection :: (IOE :> es, ConnectionPool :> es) => (PSQL.Connection -> Eff es a) -> Eff es a
withConnection f = do
  MkConnectionPool pool <- getStaticRep
  withRunInIO $ \unlift ->
    P.withResource pool (unlift . f)

type API = "health-check" S.:> S.Get '[S.JSON] Bool

apiHandler :: (IOE :> es, ConnectionPool :> es) => S.ServerT API (Eff es)
apiHandler = do
  _rows :: [PSQL.Only Int] <- withConnection $ \conn -> liftIO $ PSQL.query_ conn "select 1"
  pure True

working :: IO ()
working = runEff $ do
  let connStr = "dbname=postgres user=postgres"
      poolCfg =
        P.setNumStripes (Just 1) $
          P.defaultPoolConfig (liftIO $ PSQL.connectPostgreSQL connStr) (liftIO . PSQL.close) 5 10
  runConnectionPoolConfig poolCfg $ do
    let warpSettings = setPort 8080 defaultSettings
    ES.runWarpServerSettings @API warpSettings apiHandler

broken :: IO ()
broken = runEff $ do
  let connStr = "dbname=postgres user=postgres"
  poolCfg <-
    P.setNumStripes (Just 1)
      <$> UP.mkDefaultPoolConfig (liftIO $ PSQL.connectPostgreSQL connStr) (liftIO . PSQL.close) 5 10
  runConnectionPoolConfig poolCfg $ do
    let warpSettings = setPort 8080 defaultSettings
    ES.runWarpServerSettings @API warpSettings apiHandler

main :: IO ()
main = working

broken and working are identical, except that broken uses mkDefaultPoolConfig and working uses defaultPoolConfig.
When I run broken, and send requests to the server at port 8080, the following error is thrown:

If you want to use the unlifting function to run Eff computations in multiple threads, have a look at UnliftStrategy (ConcUnlift).
CallStack (from HasCallStack):
  error, called at src/Effectful/Internal/Monad.hs:234:12 in effectful-core-2.5.1.0-IUFmYwWPInILfVQ37rH7Eo:Effectful.Internal.Monad
  seqUnliftIO, called at src/Effectful/Internal/Monad.hs:201:40 in effectful-core-2.5.1.0-IUFmYwWPInILfVQ37rH7Eo:Effectful.Internal.Monad
  withEffToIO, called at src/Effectful/Internal/Monad.hs:376:39 in effectful-core-2.5.1.0-IUFmYwWPInILfVQ37rH7Eo:Effectful.Internal.Monad

The relevant error call is here.

Can anyone explain what this error messages means exactly?

[ocharles]

Replace your use of withRunInIO with withEffToIO and a ConcUnlift strategy and you should be good

[arybczak]

https://hackage.haskell.org/package/unliftio-pool-0.4.3.0/docs/src/UnliftIO.Pool.html#mkDefaultPoolConfig uses withRunInIO which is seqUnliftIO by default (it can be changed using withUnliftStrategy) and resources are destroyed in a different thread, hence the error. But since your create/destroy resource functions are in IO, the simplest solution is to not use unliftio-pool.

[fpringle]

Thanks both - replacing mkDefaultPoolConfig ... with withUnliftStrategy (ConcUnlift Persistent Unlimited) $ mkDefaultPoolConfig ... fixes the issue.

@arybczak in reality my resource functions use other Effects, I just wanted to simplify as much as possible for the demonstraion.

Side note - are Persistent and Unlimited the right options here?

[arybczak]

are Persistent and Unlimited the right options here?

Look right to me 🙂