Polysemy and Persistent: transactions at business level

[sir4ur0n]

Hi,

I've been pulling my hair for the last couple of days on this issue, but I can't manage to find a solution, I would appreciate if anyone can help me!

Goal

Use together Polysemy and Persistent (actually there are many more layers involved like Servant, but I hope they are irrelevant to my problem), with granularity over Persistent (and thus SQL) transactions, that is, run several SQL calls in a single transaction.

What I currently have (simplified)

getPool :: IO SqlPool

main :: IO ()
main = do
  pool <- getPool
  runM . databaseToIO pool $ do
    foos <- findFoos
    traverse_ (saveFoo . updateFoo) foos
    foosAfterUpdate <- findFoos
    traverse (putStrLn . show) foosAfterUpdate
    
updateFoo :: Foo -> Foo

data Database m a where
  FindFoos :: Database m [Foo]
  SaveFoo :: Foo -> Database m ()

makeSem ''Database

databaseToIO :: Members '[Embed IO] r => SqlPool -> Sem (Database ': r) a -> Sem r a
databaseToIO pool =
  interpret \case
    FindFoos -> liftSqlPersistMPool (selectList [] []) pool
    SaveFoos foo -> liftSqlPersistMPool (repsert (makeKey foo) foo) pool

My problem is that findFoos and saveFoo don't run in the same transaction. AFAIU in Persistent, a transaction is a single execution of liftSqlPersistMPool, but my interpreter executes it for each Database action.

I would like my business code to decide what belongs in a single transaction (atomicity), not the interpreters.

What I wish I could write (not all code is repeated)

-- Maybe later I would like to also have granularity on the isolation level, but baby steps :D
data Transaction m a where
  InTransaction :: m a -> Transaction m a

makeSem ''Transaction

main :: IO ()
main = do
  pool <- getPool
  runM . transactionToIO pool . databaseToSqlPersistM $ do
    inTransaction $ do
      foos <- findFoos
      traverse_ (saveFoo . updateFoo) foos
    foosAfterUpdate <- findFoos
    traverse (putStrLn . show) foosAfterUpdate

databaseToSqlPersistM :: Members '[Embed SqlPersistM] r => Sem (Database ': r) a -> Sem r a
databaseToSqlPersistM =
  interpret \case
    FindFoos -> selectList [] []
    SaveFoos foo -> repsert (makeKey foo) foo

-- | I assume 'liftSqlPersistMPool' would be used here? Maybe also 'interpretH'?
transactionToIO :: SqlPool -> ????
transactionToIO pool = ????

But I can't manage to write a chain of interpreters that compiles/makes sense.

Note 1: I am aware of higher-order effects (we already have some in our codebase, e.g. to manage logging contexts) and I feel like this could be used, but again, I did not manage to wrap my head around it.

Note 2: I would be ok with being forced to run each Database action inside a Transaction, i.e. having to write as such:

main :: IO ()
main = do
  pool <- getPool
  runM . transactionToIO pool . databaseToSqlPersistM $ do
    inTransaction $ do
      foos <- findFoos
      traverse_ (saveFoo . updateFoo) foos
    foosAfterUpdate <- inTransaction findFoos
    traverse (putStrLn . show) foosAfterUpdate

Actually this might even be safer, to force the business code to specify what belongs in a transaction 🤔

Any help is appreciated 🙏

[tek]

as far as I can tell from the docs, it should be possible with something like

bracket (embed (runReaderT acquireSqlConnFromPool pool)) (release ???) (updateFoos =<< findFoos)

which you could build into the Transaction interpreter. no idea about the release part, it appears to use an Acquire construct from conduit.

As for the interpreter, it would look something like this:

interpretTransaction ::
  Members [Resource, Embed IO] r =>
  InterpreterFor Transaction r
interpretTransaction =
  interpretH \case
    InTransaction ma -> bracket (embed ...) (release ...) (\ _ -> raise . interpretTransaction =<< runT ma)

another approach would be using the forklift:

withLowerToIO \ unlift _ -> runReaderT acquireSqlConnFromPool pool >>= \ acq -> with acq (unlift (raise ... ma))

[sir4ur0n]

@tek Thank you for your answer!

It lead me on the right track (I think), eventually I managed to write this, and it seems to work:

interpretTransaction :: Members [Resource, Embed IO] r => SqlPool -> InterpreterFor Transaction r
interpretTransaction pool = interpretH \case
  InTransaction ma ->
    bracket
      (embed . runResourceT $ runReaderT acquireSqlConnFromPool pool >>= allocateAcquire)
      (\(releaseKey, _) -> embed $ release releaseKey)
      ( \(_, sqlBackend) -> do
          polysemyAction <- runT ma
          raise . interpretSqlPersistM sqlBackend . databaseToSqlPersistM . interpretTransaction pool . raiseUnder2 $ polysemyAction
      )

interpretSqlPersistM :: Members '[Embed IO] r => SqlBackend -> InterpreterFor (Embed SqlPersistM) r
interpretSqlPersistM sqlBackend = interpret \case
  Embed sqlAction -> embed . runResourceT . runNoLoggingT $ runReaderT sqlAction sqlBackend

databaseToSqlPersistM :: Members '[Embed SqlPersistM] r => Sem (Database ': r) a -> Sem r a
databaseToSqlPersistM =
  interpret \case
    FindFoos -> selectList [] []
    SaveFoos foo -> repsert (makeKey foo) foo

There is quite a lot of Polysemy machinery involved (don't get me started on that raiseUnder2 and the compilation errors I had to go through before finding I needed those) but it seems to work (at least it solves my issue of transaction and database corruption).

Thanks again 🙇

EDIT: This doesn't work, each database query is executed in its own transaction nonetheless 😞

[tek]

oh wow, didn't expect runResourceT to just work like that! glad I could provide some inspiration! 🙂

[googleson78]

@sir4ur0n
One thing I don't understand is - you use raiseUnder2 to introduce an Embed SqlPersistM, which is fine, but do you know how you get your Database actions to get run via this "same" Embed SqlPersistM when running them - you still have to dispatch your Database effect when you write inTransaction findFoos?

[tek]

it definitely looks like it's using a separate connection for each transaction

[sir4ur0n]

Yup, I forgot to come back to this issue, but overall this doesn't work as I expected.

I never managed to make it work, and because error messages are just too confusing/frustrating for higher order effects in Polysemy, I gave up (and so did my team) 😞

Feel free to reopen if others are interested in this kind of issues.

I feel like to be able to express this, one would need to be able to express additional information about the m of InTransaction :: m a -> Transaction m a though I may be completely wrong.

If somebody finds a way to make this work, I would be more than happy to switch my application code, but I spent already too much time trying to make this work in vain.

Good luck!

[googleson78]

I think something like this should work:

data Transaction conn m a where
  InTransaction :: (conn -> m a) -> Transaction conn m a

makeSem ''Transaction

data Foo

data Database conn m a where
  FindFoos :: conn -> Database conn m [Foo]
  SaveFoo :: conn -> Foo -> Database conn m ()

makeSem ''Database

runTransaction ::
  (Sem r conn) ->
  (conn -> Sem r ()) ->
  Sem (Transaction conn ': r) a ->
  Sem r a
runTransaction = <some-impl>

runDatabase :: <some-signature>
runDatabase ... = interpret \case
  FindFoos conn -> do
    ...
    runSqlConn <action> conn
    ...
  ...

businessLogic = 
  ...
  inTransaction \conn -> findFoos conn
  ...

it may not be as "clean" as what you originally wanted, as you are essentially passing the connection around, but I don't see a reason why it wouldn't work.

I'll try to do a concrete implementation later these days.

[googleson78]

Here's a proper solution, by @KingoftheHomeless, in which you don't have to link your Db and your Transaction effects with a type parameter.

[googleson78]

This should now be easier, by combining @KingoftheHomeless' solution, packaged here.

I also wrote a small adapter for my particular persistent use case, as one of the interfaces it exposes is Acquire based.

[leomayleomay]

I think something like this should work:

data Transaction conn m a where
  InTransaction :: (conn -> m a) -> Transaction conn m a

makeSem ''Transaction

data Foo

data Database conn m a where
  FindFoos :: conn -> Database conn m [Foo]
  SaveFoo :: conn -> Foo -> Database conn m ()

makeSem ''Database

runTransaction ::
  (Sem r conn) ->
  (conn -> Sem r ()) ->
  Sem (Transaction conn ': r) a ->
  Sem r a
runTransaction = <some-impl>

runDatabase :: <some-signature>
runDatabase ... = interpret \case
  FindFoos conn -> do
    ...
    runSqlConn <action> conn
    ...
  ...

businessLogic = 
  ...
  inTransaction \conn -> findFoos conn
  ...

it may not be as "clean" as what you originally wanted, as you are essentially passing the connection around, but I don't see a reason why it wouldn't work.

I reckon it's better to get the conn into a reader, so just asks it when you need it

I'll try to do a concrete implementation later these days.

[googleson78]

I gave up on using that, because the solution proposed by Love is cleaner:

• doesn't leak "implementation details" to your "db effect"
• you don't have to modify your db effect
• you don't have to pass around the argument to your db effect
• it's only at the interpreter level, from the POV of your db effect, so your pure/mock interpretation for your db effect remains unchanged and unconcerned with transactions (you can still check that of course with the Scoped effect, but you don't have to pass around some dummy value for the pure/mock db interpreter)

[solomon-b]

I gave up on using that, because the solution proposed by Love is cleaner:

@googleson78 which solution are you referring to here?

[tek]

FYI I demonstrated a complete implementation here