Merge pull request #29 from brandonchinn178/transaction-monad

Separate Transaction monad

CHANGELOG.md

@@ -1,3 +1,10 @@
+# 0.2.0.0
+
+* Use a separate monad within `withTransaction` to prevent unsafe/arbitrary IO actions ([#7](https://github.com/brandonchinn178/persistent-mtl/issues/7), [#28](https://github.com/brandonchinn178/persistent-mtl/issues/28))
+* Add `MonadRerunnableIO` to support IO actions within `withTransaction` only if the IO action is determined to be rerunnable
+* Add built-in support for retrying transactions if a serialization error occurs
+* Remove `SqlQueryRep` as an export from `Database.Persist.Monad`. You shouldn't ever need it for normal usage. It is now re-exported by `Database.Persist.Monad.TestUtils`, since most of the usage of `SqlQueryRep` is in mocking queries. If you need it otherwise, you can import it directly from `Database.Persist.Monad.SqlQueryRep`.
+
 # 0.1.0.1
 
 Fix quickstart

README.md

@@ -54,12 +54,12 @@ newtype MyApp a = MyApp
 instance MonadUnliftIO MyApp where
   withRunInIO = wrappedWithRunInIO MyApp unMyApp
 
-getYoungPeople :: (MonadIO m, MonadSqlQuery m) => m [Entity Person]
+getYoungPeople :: MonadSqlQuery m => m [Entity Person]
 getYoungPeople = selectList [PersonAge <. 18] []
 
 main :: IO ()
-main = runStderrLoggingT $ withSqlitePool "db.sqlite" 5 $ \conn ->
-  liftIO $ runSqlQueryT conn $ unMyApp $ do
+main = runStderrLoggingT $ withSqlitePool "db.sqlite" 5 $ \pool ->
+  liftIO $ runSqlQueryT pool $ unMyApp $ do
     runMigration migrate
     insert_ $ Person "Alice" 25
     insert_ $ Person "Bob" 10
@@ -229,6 +229,59 @@ So what does `persistent-mtl` do differently?
 
 In summary, `persistent-mtl` takes all the good things about option 2, implements them out of the box (so you don't have to do it yourself), and makes your business logic functions composable with transactions behaving the way YOU want.
 
+### Easy transaction management
+
+Some databases will throw an error if two transactions conflict (e.g. [PostgreSQL](https://www.postgresql.org/docs/9.5/transaction-iso.html)). The client is expected to retry transactions if this error is thrown. `persistent` doesn't easily support this out of the box, but `persistent-mtl` does!
+
+```hs
+import Database.PostgreSQL.Simple.Errors (isSerializationError)
+
+main :: IO ()
+main = withPostgresqlPool "..." 5 $ \pool -> do
+  let env = mkSqlQueryEnv pool $ \env -> env
+        { retryIf = isSerializationError . fromException
+        , retryLimit = 100 -- defaults to 10
+        }
+
+  -- in any of the marked transactions below, if someone else is querying
+  -- the postgresql database at the same time with queries that conflict
+  -- with yours, your operations will automatically be retried
+  runSqlQueryTWith env $ do
+    -- transaction 1
+    insert_ $ ...
+
+    -- transaction 2
+    withTransaction $ do
+      insert_ $ ...
+
+      -- transaction 2.5: transaction-within-a-transaction is supported in PostgreSQL
+      withTransaction $ do
+        insert_ $ ...
+
+      insert_ $ ...
+
+    -- transaction 3
+    insert_ $ ...
+```
+
+Because of this built-in retry support, any IO actions inside `withTransaction` have to be explicitly marked with `rerunnableIO`. If you try to use a function with a `MonadIO m` constraint, you'll get a compile-time error!
+
+```
+.../Foo.hs:100:5: error:
+    • Cannot run arbitrary IO actions within a transaction. If the IO action is rerunnable, use rerunnableIO
+    • In a stmt of a 'do' block: arbitraryIO
+      In the second argument of ‘($)’, namely
+        ‘withTransaction
+           $ do insert_ record1
+                arbitraryIO
+                insert_ record2’
+    |
+100 |     arbitraryIO
+    |     ^^^^^^^^^^^
+```
+
+Note that this **only** applies for transactions, so `MonadIO` and `MonadSqlQuery` constraints can still co-exist (for a function with IO actions that are not rerunnable) as long as the function is never called within `withTransaction`.
+
 ### Testing functions that use `persistent` operations
 
 Generally, I would recommend someone using `persistent` in their application to make a monad type class containing the API for their domain, like

package.yaml

@@ -1,5 +1,5 @@
 name: persistent-mtl
-version: 0.1.0.1
+version: 0.2.0.0
 maintainer: Brandon Chinn <[email protected]>
 synopsis: Monad transformer for the persistent API
 description: |
@@ -29,6 +29,7 @@ library:
     - resourcet-pool >= 0.1.0.0 && < 0.2
     - text >= 1.2.3.0 && < 2
     - transformers >= 0.5.2.0 && < 0.6
+    - unliftio >= 0.2.7.0 && < 0.3
     - unliftio-core >= 0.1.2.0 && < 0.3
 
 tests:

persistent-mtl.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a6b1252a25af52e3ddd10e843b4818e0255c269dfbc6a399eb29e41093ef0408
+-- hash: 9c53e0610dea4ca814133d0596978b961b85fd54cb6df7a82eccb6d260824dde
 
 name:           persistent-mtl
-version:        0.1.0.1
+version:        0.2.0.0
 synopsis:       Monad transformer for the persistent API
 description:    A monad transformer and mtl-style type class for using the
                 persistent API directly in your monad transformer stack.
@@ -32,6 +32,7 @@ source-repository head
 
 library
   exposed-modules:
+      Control.Monad.IO.Rerunnable
       Database.Persist.Monad
       Database.Persist.Monad.Class
       Database.Persist.Monad.Shim
@@ -53,6 +54,7 @@ library
     , resourcet-pool >=0.1.0.0 && <0.2
     , text >=1.2.3.0 && <2
     , transformers >=0.5.2.0 && <0.6
+    , unliftio >=0.2.7.0 && <0.3
     , unliftio-core >=0.1.2.0 && <0.3
   default-language: Haskell2010
 

scripts/generate/templates/TestHelpers.mustache

@@ -12,9 +12,9 @@ import Data.Int (Int64)
 import Data.Map (Map)
 import Data.Text (Text)
 import Data.Void (Void)
-import Database.Persist.Sql hiding (pattern Update)
+import Database.Persist.Sql (CautiousMigration, Entity, Key, PersistValue, Sql)
 
-import Database.Persist.Monad
+import Database.Persist.Monad.TestUtils (SqlQueryRep(..))
 import Example
 
 {-# ANN module "HLint: ignore" #-}

src/Control/Monad/IO/Rerunnable.hs

@@ -0,0 +1,71 @@
+{-|
+Module: Control.Monad.IO.Rerunnable
+
+Defines the 'MonadRerunnableIO' type class that is functionally equivalent
+to 'Control.Monad.IO.Class.MonadIO', but use of it requires the user to
+explicitly acknowledge that the given IO operation can be rerun.
+-}
+
+module Control.Monad.IO.Rerunnable
+  ( MonadRerunnableIO(..)
+  ) where
+
+import Control.Monad.Trans.Class (lift)
+import qualified Control.Monad.Trans.Except as Except
+import qualified Control.Monad.Trans.Identity as Identity
+import qualified Control.Monad.Trans.Maybe as Maybe
+import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
+import qualified Control.Monad.Trans.Reader as Reader
+import qualified Control.Monad.Trans.Resource as Resource
+import qualified Control.Monad.Trans.State.Lazy as State.Lazy
+import qualified Control.Monad.Trans.State.Strict as State.Strict
+import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
+import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
+
+-- | A copy of 'Control.Monad.IO.Class.MonadIO' to explicitly allow only IO
+-- operations that are rerunnable, e.g. in the context of a SQL transaction.
+class Monad m => MonadRerunnableIO m where
+  -- | Lift the given IO operation to @m@.
+  --
+  -- The given IO operation may be rerun, so use of this function requires
+  -- manually verifying that the given IO operation is rerunnable.
+  rerunnableIO :: IO a -> m a
+
+instance MonadRerunnableIO IO where
+  rerunnableIO = id
+
+{- Instances for common monad transformers -}
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Reader.ReaderT r m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Except.ExceptT e m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Identity.IdentityT m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Maybe.MaybeT m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (RWS.Lazy.RWST r w s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (RWS.Strict.RWST r w s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (State.Lazy.StateT s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (State.Strict.StateT s m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (Writer.Lazy.WriterT w m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance (Monoid w, MonadRerunnableIO m) => MonadRerunnableIO (Writer.Strict.WriterT w m) where
+  rerunnableIO = lift . rerunnableIO
+
+instance MonadRerunnableIO m => MonadRerunnableIO (Resource.ResourceT m) where
+  rerunnableIO = lift . rerunnableIO