diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,28 @@
+Copyright 2017, Mark Hibberd, All Rights Reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+  1. Redistributions of source code must retain the above copyright
+     notice, this list of conditions and the following disclaimer.
+
+  2. Redistributions in binary form must reproduce the above copyright
+     notice, this list of conditions and the following disclaimer in the
+     documentation and/or other materials provided with the distribution.
+
+  3. Neither the name of the copyright holder nor the names of
+     its contributors may be used to endorse or promote products derived
+     from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/src/Traction/Control.hs b/src/Traction/Control.hs
--- a/src/Traction/Control.hs
+++ b/src/Traction/Control.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
 module Traction.Control (
     Db (..)
   , DbError (..)
@@ -10,8 +11,12 @@
   , DbPoolConfiguration (..)
   , defaultDbPoolConfiguration
   , MonadDb (..)
+  , transaction
+  , transactionT
   , runDb
   , runDbT
+  , runDbWith
+  , runDbWithT
   , newPool
   , newPoolWith
   , newRollbackPool
@@ -44,9 +49,18 @@
 
 newtype DbPool =
   DbPool {
-      runDbPool :: forall a. Db a -> EitherT DbError IO a
+      runDbPool :: forall a. (Postgresql.Connection -> EitherT DbError IO a) -> EitherT DbError IO a
     }
 
+data TransactionContext =
+    InTransaction Postgresql.Connection
+  | NotInTransaction DbPool
+
+newtype Db a =
+  Db {
+      _runDb :: ReaderT TransactionContext (EitherT DbError IO) a
+    }  deriving (Functor, Applicative, Monad, MonadIO)
+
 data DbError =
     DbSqlError Postgresql.Query Postgresql.SqlError
   | DbQueryError Postgresql.Query Postgresql.QueryError
@@ -75,11 +89,6 @@
     DbEncodingInvariant q field encoding ->
       mconcat ["Query could not decode results, expected to be able to decode [", Text.unpack field, "], to type, [", Text.unpack encoding, "], for query: ", show q]
 
-newtype Db a =
-  Db {
-      _runDb :: ReaderT Postgresql.Connection (EitherT DbError IO) a
-    }  deriving (Functor, Applicative, Monad, MonadIO)
-
 class MonadIO m => MonadDb m where
   liftDb :: Db a -> m a
 
@@ -89,18 +98,56 @@
 instance MonadDb m => MonadDb (ExceptT e m) where
   liftDb = lift . liftDb
 
+data WithTransaction =
+    WithTransaction
+  | WithoutTransaction
+
 failWith :: DbError -> Db a
 failWith =
   Db . lift . left
 
 runDb :: DbPool -> Db a -> EitherT DbError IO a
 runDb pool db =
-  runDbPool pool db
+  runDbWith pool WithTransaction db
 
 runDbT :: DbPool -> (DbError -> e) -> EitherT e Db a -> EitherT e IO a
 runDbT pool handler db =
-  squash $ mapEitherT (firstEitherT handler . runDb pool) db
+  runDbWithT pool WithTransaction handler db
 
+runDbWith :: DbPool -> WithTransaction -> Db a -> EitherT DbError IO a
+runDbWith pool tx db =
+  runReaderT (_runDb $ case tx of
+    WithTransaction ->
+      transaction db
+    WithoutTransaction ->
+      db) $ NotInTransaction pool
+
+runDbWithT :: DbPool -> WithTransaction -> (DbError -> e) -> EitherT e Db a -> EitherT e IO a
+runDbWithT pool tx handler db =
+  squash $ mapEitherT (firstEitherT handler . runDbWith pool tx) db
+
+transaction :: Db a -> Db a
+transaction db =
+  Db $ ask >>= \cc -> lift $ case cc of
+    InTransaction c ->
+      runReaderT (_runDb db) (InTransaction c)
+    NotInTransaction pool ->
+      runDbPool pool $ \c ->
+        runReaderT (_runDb db) (InTransaction c)
+
+transactionT :: EitherT e Db a -> EitherT e Db a
+transactionT =
+  transactional runEitherT newEitherT
+
+transactional :: (Monad m, Monad n) => (m a -> Db (n a)) -> (Db (n a) -> m a) -> m a -> m a
+transactional sifter lifter db =
+  lifter . Db $ ask >>= \cc -> lift $ case cc of
+    InTransaction c ->
+      runReaderT (_runDb $ sifter db) (InTransaction c)
+    NotInTransaction pool ->
+      runDbPool pool $ \c ->
+        runReaderT (_runDb $ sifter db) (InTransaction c)
+
 data DbPoolConfiguration =
   DbPoolConfiguration {
       dbPoolStripes :: Int
@@ -137,7 +184,9 @@
   pure $ DbPool $ \db ->
     newEitherT $ Pool.withResource pool $ \c ->
       handle (\(RollbackException e) -> pure $ Left e) $ Postgresql.withTransaction c $ do
-        r <- runEitherT $ flip runReaderT c $ _runDb (initializer >> db)
+        r <- runEitherT $ do
+          runReaderT (_runDb initializer) (InTransaction c)
+          db c
         case r of
           Left e -> do
             throwM $ RollbackException e
@@ -159,19 +208,23 @@
   pure $ DbPool $ \db ->
     newEitherT $ Pool.withResource pool $ \c ->
       bracket_ (Postgresql.begin c) (Postgresql.rollback c)  $ do
-        runEitherT $ flip runReaderT c $ _runDb (initializer >> db)
+        runEitherT $ do
+          runReaderT (_runDb initializer) (InTransaction c)
+          db c
 
 withRollbackSingletonPool :: (MonadMask m, MonadIO m) => ByteString -> (DbPool -> m a) -> m a
 withRollbackSingletonPool connection action = do
   c <- liftIO . Postgresql.connectPostgreSQL $ connection
   bracket_ (liftIO $ Postgresql.begin c) (liftIO $ Postgresql.rollback c) $
-    action $ DbPool $ \db ->
-      newEitherT $
-        runEitherT $ flip runReaderT c $ _runDb db
+    action $ DbPool $ \db -> db c
 
 withConnection :: Postgresql.Query -> (Postgresql.Connection -> IO a) -> Db a
 withConnection query f =
-  Db $ ask >>= lift . safely query . f
+  Db $ ask >>= \cc -> case cc of
+    InTransaction c ->
+      lift . safely query . f $ c
+    NotInTransaction pool ->
+      lift . runDbPool pool $ \c -> (safely query . f $ c)
 
 safely :: Postgresql.Query -> IO a -> EitherT DbError IO a
 safely query action =
diff --git a/src/Traction/Sql.hs b/src/Traction/Sql.hs
--- a/src/Traction/Sql.hs
+++ b/src/Traction/Sql.hs
@@ -6,6 +6,7 @@
 module Traction.Sql (
     Only (..)
   , Binary (..)
+  , PGArray (..)
   , mandatory
   , mandatory_
   , unique
@@ -46,6 +47,7 @@
 
 import           Database.PostgreSQL.Simple.SqlQQ (sql)
 import           Database.PostgreSQL.Simple (ToRow, FromRow, Only (..), Binary (..))
+import           Database.PostgreSQL.Simple.Types (PGArray (..))
 import qualified Database.PostgreSQL.Simple as Postgresql
 import qualified Database.PostgreSQL.Simple.ToField as Postgresql
 
diff --git a/test/Test/Traction.hs b/test/Test/Traction.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Traction.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Test.Traction where
+
+import           Control.Monad.IO.Class (MonadIO (..))
+import           Control.Monad.Morph (hoist, lift)
+
+import           Data.Text (Text)
+
+import           Traction.Prelude
+import           Traction.Control
+import           Traction.Migration
+import           Traction.Sql
+import           Traction.QQ (sql)
+
+import           Hedgehog
+import qualified Hedgehog.Gen as Gen
+
+import           System.IO (IO)
+
+prop_insert_unique :: Property
+prop_insert_unique =
+  property $ do
+    organisation <- forAll genOrganisation
+    r <- db $ do
+      o1 <- withUniqueCheck $ oinsert organisation
+      o2 <- withUniqueCheck $ oinsert organisation
+      pure (isUnique o1, isDuplicate o2)
+    (True, True) === r
+
+prop_insert_exists :: Property
+prop_insert_exists =
+  property $ do
+    organisation <- forAll genOrganisation
+    r <- db $ do
+      void $ oinsert organisation
+      oexists organisation
+    assert r
+
+prop_insert_not_exists :: Property
+prop_insert_not_exists =
+  property $ do
+    organisation <- forAll genOrganisation
+    r <- db $ do
+      oexists organisation
+    assert (not r)
+
+prop_rollback :: Property
+prop_rollback =
+  property $ do
+    pool <- liftIO $ mkPool
+    x <- liftIO . runEitherT . runDb pool $ do
+      -- NOTE: intentional syntax error
+      fmap (== Just True) . values $ unique [sql|
+          SELECT_FAUX_PAUX TRUE
+            FROM organisation o
+           WHERE o.name = ?
+        |] (Only True)
+    case x of
+      Left _ ->
+        pure ()
+      Right _ ->
+        failure
+
+prop_schema :: Property
+prop_schema =
+  property $ do
+    pool <- liftIO $ mkPool
+    evalExceptT . hoist lift . runDb pool $ do
+      void $ migrate schema
+      void $ migrate schema
+
+oexists :: MonadDb m => Text -> m Bool
+oexists o =
+  fmap (== Just True) . values $ unique [sql|
+      SELECT TRUE
+        FROM organisation o
+       WHERE o.name = ?
+    |] (Only o)
+
+oinsert :: MonadDb m => Text -> m Int
+oinsert o =
+  value $ mandatory [sql|
+      INSERT INTO organisation (name)
+           VALUES (?)
+        RETURNING id
+    |] (Only o)
+
+schema :: [Migration]
+schema = [
+    Migration "create-organisation" [sql|
+      CREATE TABLE organisation (
+          id serial PRIMARY KEY
+        , name text NOT NULL UNIQUE
+        )
+    |]
+  , Migration "create-account" [sql|
+      CREATE TABLE account (
+          id SERIAL PRIMARY KEY
+        , organisation BIGINT NOT NULL REFERENCES organisation(id)
+        , email TEXT NOT NULL UNIQUE
+        , name TEXT NOT NULL
+        , crypted TEXT NOT NULL
+        )
+    |]
+  ]
+
+db :: Db a -> PropertyT IO a
+db x = do
+  pool <- liftIO mkPool
+  evalExceptT . hoist lift . runDb pool $ migrate schema >> x
+
+mkPool :: IO DbPool
+mkPool =
+  newRollbackPool "dbname=traction_test host=localhost user=traction_test password=traction_test port=5432"
+
+checkDb :: MonadIO m => Group -> m Bool
+checkDb group =
+  case group of
+    Group name properties ->
+      checkSequential (Group name ((fmap . fmap) (withTests 5) properties))
+
+genOrganisation :: Gen Text
+genOrganisation = do
+  cooking <- Gen.element [
+      "fried"
+    , "diced"
+    , "stewed"
+    , "broiled"
+    ]
+  muppet <- Gen.element [
+      "kermet"
+    , "gonzo"
+    , "beaker"
+    , "statler"
+    , "waldorf"
+    ]
+  pure $ cooking <> "-" <> muppet
+
+tests :: IO Bool
+tests =
+  checkDb $$(discover)
diff --git a/traction.cabal b/traction.cabal
--- a/traction.cabal
+++ b/traction.cabal
@@ -1,13 +1,19 @@
 name: traction
-version: 0.0.1
+version: 0.1.0
 license: BSD3
+license-file: LICENSE
 author: Mark Hibberd <mark@hibberd.id.au>
 maintainer: Mark Hibberd <mark@hibberd.id.au>
 copyright: (c) 2017 Mark Hibberd
 cabal-version: >= 1.24
 build-type: Simple
+category: Database
+synopsis: Tools for postgresql-simple.
 description:
   A few tools for using postgresql-simple.
+source-repository head
+  type: git
+  location: https://github.com/markhibberd/traction
 
 library
   default-language: Haskell2010
@@ -54,7 +60,9 @@
     , text == 1.2.*
     , traction
 
+  other-modules:
+    Test.Traction
+
   ghc-options:
     -Wall
     -threaded
-    -O2