[database-devel] (Postgresql-simple) transparently using Transactions/Savepoints

[tsuraan]

One problem that I've noticed in the postgresql-simple API (and
probably the other -simple APIs) is that the programmer needs to be
careful when using "withTransaction".  If you have some function that
uses it, then that function must not be called from within some other
withTransaction context.  This is sort of a SQL issue; calling BEGIN
from within a BEGIN doesn't work well (postgres just gives a warning
when you do this, which is downright scary).  However, from within a
transaction, one can use the SAVEPOINT calls; these create
mini-transactions that may be rolled back or released without rolling
back or committing the surrounding transaction.  Moreover, if an error
occurs from within a savepoint (such as attempting to violate a
uniqueness constraint), one can simply undo the savepoint instead of
having to roll back the entire transaction.

I've written a small wrapper around postgresql-simple that
transparently uses transactions and savepoints where appropriate.  The
code lives at https://github.com/tsuraan/postgresql-transactions .
I'm not thrilled with the API; I think that having transactions be a
StateT wrapping IO would be let me use Connections again instead of
making my own crappy data type wrapping them, but whenever I try to do
that I get confused :(  This approach was easy to write, despite the
unfortunate API that is exposes.  If anybody could show me how to make
this API nice, I would be very appreciative.  The github README has an
example of why I think this transaction/savepoint abstraction is
worthwhile; for those who don't like visiting links, I'll paste my
example below so that everybody can easily see and critique my
motivation.  All input will be appreciated!

{-# LANGUAGE OverloadedStrings #-}
{-|
  This is a simple motivating example for why postgresql-transactions may be
  a useful thing to have.  Prepare the database with the following:

  BEGIN;
  CREATE TABLE Users( userid SERIAL NOT NULL PRIMARY KEY
                    , username TEXT NOT NULL UNIQUE);

  CREATE TABLE Messages( msgid SERIAL NOT NULL PRIMARY KEY
                       , msg TEXT NOT NULL UNIQUE);

  CREATE TABLE Logs( logid SERIAL NOT NULL PRIMARY KEY
                   , logged TIMESTAMP NOT NULL DEFAULT now()
                   , userid INT NOT NULL REFERENCES Users
                   , msgid INT NOT NULL REFERENCES Messages
                   );
  COMMIT;
-}

import Database.PostgreSQL.Simple.Transactions
import Data.ByteString ( ByteString )
import Control.Exception

getOrCreate :: PgTx -> Query -> Query -> ByteString -> IO Int
getOrCreate pg get create value = readRow
  where
  readRow :: IO Int
  readRow = do
    rows <- query pg get (Only value)
    case rows of
      []           -> withTransaction pg mkRow `onException` readRow
      [Only rowid] -> return rowid

  mkRow :: PgTx -> IO Int
  mkRow pg' = do
    [Only r] <- query pg' create (Only value)
    return r

getUserId :: PgTx -> ByteString -> IO Int
getUserId pg =
  getOrCreate pg
              "SELECT userid FROM Users WHERE username=?"
              "INSERT INTO Users(username) VALUES(?) RETURNING userid"

getMsgId :: PgTx -> ByteString -> IO Int
getMsgId pg =
  getOrCreate pg
              "SELECT msgid FROM Messages where msg=?"
              "INSERT INTO Messages(msg) VALUES(?) RETURNING msgid"

logMsg :: PgTx -> ByteString -> ByteString -> IO Int
logMsg pg username msg = withTransaction pg go
  where
  go :: PgTx -> IO Int
  go pg' = do
    userid <- getUserId pg' username
    msgid  <- getMsgId pg' msg
    [Only logid] <- query pg' "INSERT INTO Logs(userid, msgid) VALUES(?, ?) \
                              \RETURNING logid"
                              (userid, msgid)
    return logid

main = do
  c <- connect "host=localhost"
  getUserId c "jim" >>= \jimid -> putStrLn ("jim id is " ++ (show jimid))
  logMsg c "al" "login" >>= print
  logMsg c "bob" "login" >>= print
  logMsg c "al" "read email" >>= print
  logMsg c "al" "logout" >>= print
  logMsg c "bob" "logout" >>= print