diff --git a/example/Main.hs b/example/Main.hs
--- a/example/Main.hs
+++ b/example/Main.hs
@@ -1,66 +1,136 @@
 module Main where
 
+import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (async, wait)
 import Control.Monad (void, replicateM)
+import Control.Monad.Catch (bracket_, finally)
 
-import Data.BTree.Impure (toList, insertTree)
+import Data.BTree.Impure (Tree, toList, insertTree)
 import Data.ByteString (ByteString)
 import Data.Int (Int32)
 import Data.Text.Encoding (encodeUtf8)
+import qualified Data.BTree.Impure as Tree
 import qualified Data.Text as Text
 
 import Database.Haskey.Alloc.Concurrent (ConcurrentDb,
                                          ConcurrentHandles,
                                          concurrentHandles,
+                                         lockConcurrentDb,
+                                         unlockConcurrentDb,
                                          openConcurrentDb,
                                          createConcurrentDb,
                                          transact_,
                                          transactReadOnly,
                                          commit_)
-import Database.Haskey.Store.File (FileStoreT, Files, newFileStore,
-                                   runFileStoreT, defFileStoreConfig)
+import Database.Haskey.Store.File (FileStoreT, runFileStoreT, defFileStoreConfig)
+import Database.Haskey.Store.InMemory (MemoryStoreT, MemoryFiles, newEmptyMemoryStore,
+                                       runMemoryStoreT, defMemoryStoreConfig)
 
+import System.Directory (removeDirectoryRecursive)
+import System.Random (randomIO)
+
+concurrency :: Integral a => a
+concurrency = 100
+
+type Root = Tree Int32 ByteString
+
 main :: IO ()
 main = do
-    store <- newFileStore
+    inMemoryMain root
+    fileMain root `finally` delRoot
+  where
+    root = "example-database.haskey"
+    delRoot = removeDirectoryRecursive root
+
+inMemoryMain :: FilePath -> IO ()
+inMemoryMain root = do
+    store <- newEmptyMemoryStore
     db    <- openOrCreate store
 
-    writers <- mapM (async . writer store db) [1..100]
-    readers <- replicateM 100 $ async (reader store db)
+    writers <- mapM (async . writer store db) [1..concurrency]
+    readers <- replicateM concurrency . async $ do
+        delay <- randomIO
+        reader store db (delay `rem` 5000)
     mapM_ wait writers
     mapM_ wait readers
-    putStrLn "Done"
+    putStrLn "InMemory: done"
+  where
+    writer :: MemoryFiles FilePath
+           -> ConcurrentDb Root
+           -> Int32
+           -> IO ()
+    writer store db i =
+        runDatabase store $ transact_ tx db
+      where
+        bs = encodeUtf8 $ Text.pack (show i)
 
+        tx tree = insertTree i bs tree >>= commit_
 
-writer :: Files FilePath
-       -> ConcurrentDb Int32 ByteString
-       -> Int32
-       -> IO ()
-writer store db i =
-    runDatabase store $ transact_ tx db
+    reader :: MemoryFiles FilePath
+           -> ConcurrentDb Root
+           -> Int
+           -> IO ()
+    reader files db delay = void $ replicateM 10 $ do
+        threadDelay delay
+        runDatabase files $ transactReadOnly toList db
+
+    openOrCreate :: MemoryFiles FilePath
+                 -> IO (ConcurrentDb Root)
+    openOrCreate store = runDatabase store $ do
+        maybeDb <- openConcurrentDb handles
+        case maybeDb of
+            Nothing -> createConcurrentDb handles Tree.empty
+            Just db -> return db
+
+    runDatabase :: MemoryFiles FilePath
+                -> MemoryStoreT FilePath m a
+                -> m a
+    runDatabase files action = runMemoryStoreT action defMemoryStoreConfig files
+
+    handles :: ConcurrentHandles
+    handles = concurrentHandles root
+
+fileMain :: FilePath -> IO ()
+fileMain root = bracket_ (runDatabase $ lockConcurrentDb handles)
+                         (runDatabase $ unlockConcurrentDb handles) $ do
+
+    db <- openOrCreate
+    writers <- mapM (async . writer db) [1..concurrency]
+    readers <- replicateM concurrency . async $ do
+        delay <- randomIO
+        reader db (delay `rem` 5000)
+    mapM_ wait writers
+    mapM_ wait readers
+    putStrLn "File: done"
   where
-    bs = encodeUtf8 $ Text.pack (show i)
+    writer :: ConcurrentDb Root
+           -> Int32
+           -> IO ()
+    writer db i =
+        runDatabase $ transact_ tx db
+      where
+        bs = encodeUtf8 $ Text.pack (show i)
 
-    tx tree = insertTree i bs tree >>= commit_
+        tx tree = insertTree i bs tree >>= commit_
 
-reader :: Files FilePath
-       -> ConcurrentDb Int32 ByteString
-       -> IO ()
-reader files db = void $ replicateM 100 $ runDatabase files $
-    transactReadOnly toList db
+    reader :: ConcurrentDb Root
+           -> Int
+           -> IO ()
+    reader db delay = void $ replicateM 10 $ do
+        threadDelay delay
+        runDatabase $ transactReadOnly toList db
 
-openOrCreate :: Files FilePath
-             -> IO (ConcurrentDb Int32 ByteString)
-openOrCreate store = runDatabase store $ do
-    maybeDb <- openConcurrentDb handles
-    case maybeDb of
-        Nothing -> createConcurrentDb handles
-        Just db -> return db
+    openOrCreate :: IO (ConcurrentDb Root)
+    openOrCreate = runDatabase $ do
+        maybeDb <- openConcurrentDb handles
+        case maybeDb of
+            Nothing -> createConcurrentDb handles Tree.empty
+            Just db -> return db
 
-runDatabase :: Files FilePath
-            -> FileStoreT FilePath m a
-            -> m a
-runDatabase files action = runFileStoreT action defFileStoreConfig files
+    runDatabase :: Monad m
+                => FileStoreT FilePath m a
+                -> m a
+    runDatabase action = runFileStoreT action defFileStoreConfig
 
-handles :: ConcurrentHandles
-handles = concurrentHandles "example-database.haskey"
+    handles :: ConcurrentHandles
+    handles = concurrentHandles root
diff --git a/haskey.cabal b/haskey.cabal
--- a/haskey.cabal
+++ b/haskey.cabal
@@ -1,6 +1,6 @@
 name:                haskey
-version:             0.1.0.1
-synopsis:            A transcatoinal, ACID compliant, embeddable key-value store.
+version:             0.2.0.0
+synopsis:            A transactional, ACID compliant, embeddable key-value store.
 description:
     Haskey is a transactional, ACID compliant, embeddable, scalable key-value
     store written entirely in Haskell.
@@ -65,7 +65,7 @@
     exceptions              >=0.8.3 && <0.9,
     filepath                >=1.4  && <2,
     focus                   >=0.1.2 && <0.2,
-    haskey-btree            >=0.1 && <1,
+    haskey-btree            >=0.2 && <1,
     list-t                  >=0.2  && <2,
     lz4                     >=0.2  && <1,
     mtl                     >=2.1  && <3,
@@ -101,7 +101,7 @@
     test-framework-hunit       >=0.3  && <1,
     test-framework-quickcheck2 >=0.3  && <1,
     haskey,
-    haskey-btree
+    haskey-btree               >=0.2  && <1
 
   default-language:    Haskell2010
   ghc-options:         -Wall
@@ -111,6 +111,7 @@
   main-is:             Integration.hs
   type:                exitcode-stdio-1.0
   other-modules:
+    Integration.CreateAndOpen
     Integration.WriteOpenRead.Concurrent
     Integration.WriteOpenRead.Transactions
 
@@ -126,17 +127,20 @@
     temporary     >=1.2  && <1.3,
     vector        >=0.10 && <1,
 
-    QuickCheck    >=2    && <3,
+    HUnit                      >=1.3  && <2,
+    QuickCheck                 >=2    && <3,
     test-framework             >=0.8  && <1,
+    test-framework-hunit       >=0.3  && <1,
     test-framework-quickcheck2 >=0.3  && <1,
     haskey,
-    haskey-btree
+    haskey-btree               >=0.2  && <1
 
   default-language:    Haskell2010
   ghc-options:         -Wall
   hs-source-dirs:      tests
 
-executable haskey-example
+test-suite haskey-example
+  type:                exitcode-stdio-1.0
   hs-source-dirs:      example
   main-is:             Main.hs
   build-depends:
@@ -145,6 +149,9 @@
     haskey-btree,
     async         >=2.1 && <3,
     bytestring    >=0.6 && <0.9 || >0.9 && <1,
+    directory     >=1.2  && <2,
+    exceptions    >=0.8.3 && <0.9,
+    random        >=1.1 && <2,
     text          >=1.2 && <2
 
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
diff --git a/src-unix/FileIO.hs b/src-unix/FileIO.hs
--- a/src-unix/FileIO.hs
+++ b/src-unix/FileIO.hs
@@ -11,9 +11,10 @@
   , seek
   , setFileSize
   , getFileSize
+  , PrefixLock
+  , prefixLockFromPrefix
   , obtainPrefixLock
   , releasePrefixLock
-  , PrefixLock
 ) where
 
 import Prelude hiding (read)
@@ -52,6 +53,9 @@
 
 newtype PrefixLock = PrefixLock FilePath
 
+prefixLockFromPrefix :: FilePath -> PrefixLock
+prefixLockFromPrefix = PrefixLock . (++ ".lock")
+
 newtype FHandle = FHandle Fd
 
 -- | Open the specified file in read-write mode.
@@ -99,8 +103,9 @@
 --    where flags = defaultFileFlags {exclusive = True, trunc = True}
 
 
-
-
+-- | Obtain a lock on a file.
+--
+-- Use 'releasePrefixLock' to release the prefix lock.
 obtainPrefixLock :: FilePath -> IO PrefixLock
 obtainPrefixLock prefix = checkLock fp >> takeLock fp
     where fp = prefix ++ ".lock"
diff --git a/src/Database/Haskey/Alloc/Concurrent.hs b/src/Database/Haskey/Alloc/Concurrent.hs
--- a/src/Database/Haskey/Alloc/Concurrent.hs
+++ b/src/Database/Haskey/Alloc/Concurrent.hs
@@ -7,6 +7,8 @@
   -- * Open, close and create databases
 , ConcurrentHandles(..)
 , concurrentHandles
+, lockConcurrentDb
+, unlockConcurrentDb
 , createConcurrentDb
 , openConcurrentDb
 , closeConcurrentHandles
@@ -18,6 +20,7 @@
 , transactReadOnly
 
   -- * Storage requirements
+, Root
 , ConcurrentMeta(..)
 , ConcurrentMetaStoreM(..)
 ) where
diff --git a/src/Database/Haskey/Alloc/Concurrent/Database.hs b/src/Database/Haskey/Alloc/Concurrent/Database.hs
--- a/src/Database/Haskey/Alloc/Concurrent/Database.hs
+++ b/src/Database/Haskey/Alloc/Concurrent/Database.hs
@@ -10,14 +10,13 @@
 import Control.Monad (void, unless)
 import Control.Monad.IO.Class
 import Control.Monad.Catch (MonadCatch, MonadMask, SomeException,
-                            catch, mask, onException, bracket)
+                            catch, mask, onException, bracket, bracket_)
 import Control.Monad.State
 import Control.Monad.Trans (lift)
 
 import Data.Proxy (Proxy(..))
 import Data.List.NonEmpty (NonEmpty((:|)))
 import Data.Maybe (fromMaybe)
-import qualified Data.Set as S
 
 import STMContainers.Map (Map)
 import qualified STMContainers.Map as Map
@@ -39,15 +38,29 @@
 -- | An active concurrent database.
 --
 -- This can be shared amongst threads.
-data ConcurrentDb k v = ConcurrentDb
+data ConcurrentDb root = ConcurrentDb
     { concurrentDbHandles :: ConcurrentHandles
     , concurrentDbWriterLock :: RLock
     , concurrentDbCurrentMeta :: TVar CurrentMetaPage
-    , concurrentDbMeta1 :: TVar (ConcurrentMeta k v)
-    , concurrentDbMeta2 :: TVar (ConcurrentMeta k v)
+    , concurrentDbMeta1 :: TVar (ConcurrentMeta root)
+    , concurrentDbMeta2 :: TVar (ConcurrentMeta root)
     , concurrentDbReaders :: Map TxId Integer
     }
 
+-- | Lock the database.
+--
+-- This needs to be called manually, if you want exclusive access, before
+-- calling either 'createConcurrentDb' or 'openConcurrentDb'
+--
+-- Use 'unlockConcurrentDb' using the 'bracket' pattern to properly unlock the
+-- database.
+lockConcurrentDb :: ConcurrentMetaStoreM m => ConcurrentHandles -> m ()
+lockConcurrentDb = lockHandle . concurrentHandlesRoot
+
+-- | Unlock the database.
+unlockConcurrentDb :: ConcurrentMetaStoreM m => ConcurrentHandles -> m ()
+unlockConcurrentDb = releaseHandle . concurrentHandlesRoot
+
 -- | Open all concurrent handles.
 openConcurrentHandles :: ConcurrentMetaStoreM m
                       => ConcurrentHandles -> m ()
@@ -58,10 +71,14 @@
     openHandle concurrentHandlesMetadata2
 
 -- | Open a new concurrent database, with the given handles.
-createConcurrentDb :: (Key k, Value v, MonadIO m, ConcurrentMetaStoreM m)
-                   => ConcurrentHandles -> m (ConcurrentDb k v)
-createConcurrentDb hnds = do
-    openConcurrentHandles hnds
+createConcurrentDb :: (Root root, MonadIO m, MonadMask m, ConcurrentMetaStoreM m)
+                   => ConcurrentHandles
+                   -> root
+                   -> m (ConcurrentDb root)
+createConcurrentDb hnds root =
+    bracket_ (openConcurrentHandles hnds)
+             (closeConcurrentHandles hnds) $ do
+
     db <- newConcurrentDb hnds meta0
     setCurrentMeta meta0 db
     setCurrentMeta meta0 db
@@ -71,21 +88,24 @@
         concurrentMetaRevision = 0
       , concurrentMetaDataNumPages = DataState 0
       , concurrentMetaIndexNumPages = IndexState 0
-      , concurrentMetaTree = Tree zeroHeight Nothing
+      , concurrentMetaRoot = root
       , concurrentMetaDataFreeTree = DataState $ Tree zeroHeight Nothing
       , concurrentMetaIndexFreeTree = IndexState $ Tree zeroHeight Nothing
       , concurrentMetaOverflowTree = Tree zeroHeight Nothing
-      , concurrentMetaDataFreshUnusedPages = DataState S.empty
-      , concurrentMetaIndexFreshUnusedPages = IndexState S.empty
+      , concurrentMetaDataCachedFreePages = DataState []
+      , concurrentMetaIndexCachedFreePages = IndexState []
       }
 
 -- | Open the an existing database, with the given handles.
-openConcurrentDb :: (Key k, Value v, MonadIO m, MonadMask m, ConcurrentMetaStoreM m)
-                 => ConcurrentHandles -> m (Maybe (ConcurrentDb k v))
-openConcurrentDb hnds@ConcurrentHandles{..} = do
-    openConcurrentHandles hnds
-    m1 <- readConcurrentMeta concurrentHandlesMetadata1 Proxy Proxy
-    m2 <- readConcurrentMeta concurrentHandlesMetadata2 Proxy Proxy
+openConcurrentDb :: (Root root, MonadIO m, MonadMask m, ConcurrentMetaStoreM m)
+                 => ConcurrentHandles
+                 -> m (Maybe (ConcurrentDb root))
+openConcurrentDb hnds@ConcurrentHandles{..} =
+    bracket_ (openConcurrentHandles hnds)
+             (closeConcurrentHandles hnds) $ do
+
+    m1 <- readConcurrentMeta concurrentHandlesMetadata1 Proxy
+    m2 <- readConcurrentMeta concurrentHandlesMetadata2 Proxy
     maybeDb <- case (m1, m2) of
         (Nothing, Nothing) -> return Nothing
         (Just m , Nothing) -> Just <$> newConcurrentDb hnds m
@@ -111,10 +131,10 @@
     closeHandle concurrentHandlesMetadata2
 
 -- | Create a new concurrent database with handles and metadata provided.
-newConcurrentDb :: (Key k, Value v, MonadIO m)
+newConcurrentDb :: (Root root, MonadIO m)
                 => ConcurrentHandles
-                -> ConcurrentMeta k v
-                -> m (ConcurrentDb k v)
+                -> ConcurrentMeta root
+                -> m (ConcurrentDb root)
 newConcurrentDb hnds meta0 = do
     readers <- liftIO Map.newIO
     meta    <- liftIO $ newTVarIO Meta1
@@ -131,8 +151,9 @@
         }
 
 -- | Get the current meta data.
-getCurrentMeta :: (Key k, Value v)
-               => ConcurrentDb k v -> STM (ConcurrentMeta k v)
+getCurrentMeta :: Root root
+               => ConcurrentDb root
+               -> STM (ConcurrentMeta root)
 getCurrentMeta db
     | ConcurrentDb { concurrentDbCurrentMeta = v } <- db
     = readTVar v >>= \case
@@ -140,8 +161,10 @@
         Meta2 -> readTVar $ concurrentDbMeta2 db
 
 -- | Write the new metadata, and switch the pointer to the current one.
-setCurrentMeta :: (MonadIO m, ConcurrentMetaStoreM m, Key k, Value v)
-               => ConcurrentMeta k v -> ConcurrentDb k v -> m ()
+setCurrentMeta :: (Root root, MonadIO m, ConcurrentMetaStoreM m)
+               => ConcurrentMeta root
+               -> ConcurrentDb root
+               -> m ()
 setCurrentMeta new db
     | ConcurrentDb
       { concurrentDbCurrentMeta = v
@@ -166,9 +189,10 @@
                 writeTVar (concurrentDbMeta1 db) new
 
 -- | Execute a write transaction, with a result.
-transact :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Key key, Value val)
-         => (forall n. (AllocM n, MonadMask n) => Tree key val -> n (Transaction key val a))
-         -> ConcurrentDb key val -> m a
+transact :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Root root)
+         => (forall n. (AllocM n, MonadMask n) => root -> n (Transaction root a))
+         -> ConcurrentDb root
+         -> m a
 transact act db = withRLock (concurrentDbWriterLock db) $ do
     cleanup
     transactNow act db
@@ -183,32 +207,38 @@
                 return (Just meta', ())
 
 -- | Execute a write transaction, without cleaning up old overflow pages.
-transactNow :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Key k, Value v)
-            => (forall n. (AllocM n, MonadMask n) => Tree k v -> n (Transaction k v a))
-            -> ConcurrentDb k v -> m a
+transactNow :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Root root)
+            => (forall n. (AllocM n, MonadMask n) => root -> n (Transaction root a))
+            -> ConcurrentDb root
+            -> m a
 transactNow act db = withRLock (concurrentDbWriterLock db) $
     actAndCommit db $ \meta -> do
-        tx <- act (concurrentMetaTree meta)
+        tx <- act (concurrentMetaRoot meta)
         case tx of
             Abort v -> return (Nothing, v)
-            Commit tree v ->
-                let meta' = meta { concurrentMetaTree = tree } in
+            Commit root v ->
+                let meta' = meta { concurrentMetaRoot = root } in
                 return (Just meta', v)
 
 -- | Execute a write transaction, without a result.
-transact_ :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Key k, Value v)
-          => (forall n. (AllocM n, MonadMask n) => Tree k v -> n (Transaction k v ()))
-          -> ConcurrentDb k v -> m ()
+transact_ :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Root root)
+          => (forall n. (AllocM n, MonadMask n) => root -> n (Transaction root ()))
+          -> ConcurrentDb root
+          -> m ()
 transact_ act db = void $ transact act db
 
 -- | Execute a read-only transaction.
-transactReadOnly :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Key key, Value val)
-                 => (forall n. (AllocReaderM n, MonadMask m) => Tree key val -> n a)
-                 -> ConcurrentDb key val -> m a
-transactReadOnly act db = withRLock (concurrentDbWriterLock db) $
+transactReadOnly :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Root root)
+                 => (forall n. (AllocReaderM n, MonadMask n) => root -> n a)
+                 -> ConcurrentDb root
+                 -> m a
+transactReadOnly act db =
+    bracket_ (openConcurrentHandles hnds)
+             (closeConcurrentHandles hnds) $
+
     bracket acquireMeta
             releaseMeta $
-            \meta -> evalConcurrentT (act $ concurrentMetaTree meta)
+            \meta -> evalConcurrentT (act $ concurrentMetaRoot meta)
                                      (ReaderEnv hnds)
   where
     hnds    = concurrentDbHandles db
@@ -235,11 +265,11 @@
 -- | Run a write action that takes the current meta-data and returns new
 -- meta-data to be commited, or 'Nothing' if the write transaction should be
 -- aborted.
-actAndCommit :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Key k, Value v)
-             => ConcurrentDb k v
+actAndCommit :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Root root)
+             => ConcurrentDb root
              -> (forall n. (MonadIO n, MonadMask n, ConcurrentMetaStoreM n)
-                 => ConcurrentMeta k v
-                 -> ConcurrentT WriterEnv ConcurrentHandles n (Maybe (ConcurrentMeta k v), a)
+                 => ConcurrentMeta root
+                 -> ConcurrentT WriterEnv ConcurrentHandles n (Maybe (ConcurrentMeta root), a)
                 )
              -> m a
 actAndCommit db act
@@ -248,7 +278,9 @@
       , concurrentDbWriterLock = lock
       , concurrentDbReaders = readers
       } <- db
-    = withRLock lock $ do
+    = withRLock lock $
+        bracket_ (openConcurrentHandles hnds)
+                 (closeConcurrentHandles hnds) $ do
 
     meta <- liftIO . atomically $ getCurrentMeta db
     let newRevision = concurrentMetaRevision meta + 1
@@ -259,8 +291,8 @@
                                              readers
                                              (concurrentMetaDataNumPages meta)
                                              (concurrentMetaIndexNumPages meta)
-                                             (concurrentMetaDataFreshUnusedPages meta)
-                                             (concurrentMetaIndexFreshUnusedPages meta)
+                                             (concurrentMetaDataCachedFreePages meta)
+                                             (concurrentMetaIndexCachedFreePages meta)
                                              (concurrentMetaDataFreeTree meta)
                                              (concurrentMetaIndexFreeTree meta)
 
@@ -281,7 +313,7 @@
                     saveFreePages' 0 IndexState
                                      writerIndexFileState
                                      (\e s -> e { writerIndexFileState = s })
-                    handleFreedDirtyPages
+                    handleCachedFreePages
 
                 -- Commit
                 setCurrentMeta (newMeta { concurrentMetaRevision = newRevision })
@@ -328,7 +360,7 @@
         removeHandle (getOverflowHandle root i)
 
 -- | Update the meta-data from a writer environment
-updateMeta :: WriterEnv ConcurrentHandles -> ConcurrentMeta k v -> ConcurrentMeta k v
+updateMeta :: WriterEnv ConcurrentHandles -> ConcurrentMeta root -> ConcurrentMeta root
 updateMeta env m = m {
     concurrentMetaDataFreeTree = fileStateFreeTree (writerDataFileState env)
   , concurrentMetaIndexFreeTree = fileStateFreeTree (writerIndexFileState env) }
@@ -336,7 +368,7 @@
 
 -- | Save the newly free'd overflow pages, for deletion on the next tx.
 saveOverflowIds :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m)
-                => StateT (ConcurrentMeta k v, WriterEnv ConcurrentHandles) m ()
+                => StateT (ConcurrentMeta root, WriterEnv ConcurrentHandles) m ()
 saveOverflowIds = do
     (meta, env) <- get
     case map (\(OldOverflow i) ->i) (writerRemovedOverflows env) of
@@ -356,43 +388,17 @@
                -> (forall a. a -> S t a)
                -> (forall hnds. WriterEnv hnds -> FileState t)
                -> (forall hnds. WriterEnv hnds -> FileState t -> WriterEnv hnds)
-               -> StateT (ConcurrentMeta k v, WriterEnv ConcurrentHandles) m ()
+               -> StateT (ConcurrentMeta root, WriterEnv ConcurrentHandles) m ()
 saveFreePages' paranoid cons getState setState
     {- paranoid >= 100 = error "paranoid: looping!"
     | otherwise-}
     = do
 
-    -- Saving the free pages
-    -- =====================
-    --
-    -- Saving free pages to the free database is a complicated task. At the
-    -- end of a transaction we have 3 types of free pages:
-    --
-    --  1. 'DirtyFree': Pages that were freshly allocated from the end of
-    --          the dabase file, but are no longer used. These are free'd
-    --          by saving them in the metadata. They can freely be used
-    --          during this routine.
-    --
-    --  2. 'NewlyFreed': Pages that were written by a previous transaction,
-    --          but free'd in this transaction. They might still be in use
-    --          by an older reader, and can thus not be used anyways.
-    --
-    --          Note that this list **may grow during this routine**, as
-    --          new pages can be free'd.
-    --
-    --  3. 'OldFree': Pages that were fetched from the free database while
-    --          executing the transaction. Technically, they can be used
-    --          during this routine, BUT that would mean the list of
-    --          'OldFree' pages can grow and shrink during the call, which
-    --          would complicate the convergence/termination conditions of
-    --          this routine. So currently, **we disable the use of these
-    --          pages in this routine.**
-
     (meta, env) <- get
     let tx = writerTxId env
     (tree', envWithoutTree) <- lift $
         runConcurrentT (saveFreePages tx (getState env)) $
-            env { writerReusablePagesOn = False }
+            env { writerQueryFreeTreeOn = False }
 
     let state' = (getState envWithoutTree) { fileStateFreeTree = cons tree' }
     let env'   = setState envWithoutTree state'
@@ -403,14 +409,14 @@
     unless (fileStateNewlyFreedPages state' == fileStateNewlyFreedPages (getState env)) $
        saveFreePages' (paranoid + 1) cons getState setState
 
--- | Handle the dirty pages.
+-- | Handle the cached free pages.
 --
--- Save the newly created free dirty pages to the metadata for later use.
+-- Save the cached free pages to the metadata for later use.
 --
 -- Update the database size.
-handleFreedDirtyPages :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m)
-                      => StateT (ConcurrentMeta k v, WriterEnv ConcurrentHandles) m ()
-handleFreedDirtyPages = do
+handleCachedFreePages :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m)
+                      => StateT (ConcurrentMeta root, WriterEnv ConcurrentHandles) m ()
+handleCachedFreePages = do
     (meta, env) <- get
 
     let dataEnv  = writerDataFileState env
@@ -420,15 +426,15 @@
                             fileStateNewNumPages dataEnv
                      , concurrentMetaDataFreeTree =
                             fileStateFreeTree dataEnv
-                     , concurrentMetaDataFreshUnusedPages =
-                            fileStateFreedDirtyPages dataEnv
+                     , concurrentMetaDataCachedFreePages =
+                            fileStateCachedFreePages dataEnv
 
                      , concurrentMetaIndexNumPages =
                             fileStateNewNumPages indexEnv
                      , concurrentMetaIndexFreeTree =
                             fileStateFreeTree indexEnv
-                     , concurrentMetaIndexFreshUnusedPages =
-                            fileStateFreedDirtyPages indexEnv
+                     , concurrentMetaIndexCachedFreePages =
+                            fileStateCachedFreePages indexEnv
                      }
     put (meta', env)
 
diff --git a/src/Database/Haskey/Alloc/Concurrent/Environment.hs b/src/Database/Haskey/Alloc/Concurrent/Environment.hs
--- a/src/Database/Haskey/Alloc/Concurrent/Environment.hs
+++ b/src/Database/Haskey/Alloc/Concurrent/Environment.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -15,6 +16,7 @@
 
 import Data.Binary (Binary)
 import Data.Set (Set)
+import Data.Typeable (Typeable)
 import Data.Word (Word32)
 import qualified Data.Binary as B
 import qualified Data.Set as S
@@ -33,6 +35,7 @@
 data S (t :: StateType) a where
     DataState  :: a -> S 'TypeData  a
     IndexState :: a -> S 'TypeIndex a
+    deriving (Typeable)
 
 deriving instance Show a => Show (S t a)
 
@@ -70,25 +73,15 @@
     -- 'fileStateNewNumPages' (excluding) are freshly allocated in the
     -- ongoing transaction.
 
-    , fileStateFreedDirtyPages :: !(S stateType (Set DirtyFree))
-    -- ^ Pages freshly allocated AND free'd in this transaction. Immediately
-    -- ready for reuse.
+    , fileStateDirtyPages :: !(Set PageId)
+    -- ^ Pages written to in this transaction.
 
     , fileStateFreeTree :: !(S stateType FreeTree)
     -- ^ The root of the free tree, might change during a transaction.
 
-    , fileStateDirtyReusablePages :: !(Set DirtyOldFree)
-    -- ^ All pages queried from the free page database for
-    -- 'fileStateReusablePagesTxId', and actually used once already.
-
-    , fileStateReusablePages :: ![OldFree]
-    -- ^ Pages queried from the free pages database and ready for immediate
-    -- reuse.
-
-    , fileStateReusablePagesTxId :: !(Maybe TxId)
-    -- ^ The 'TxId' of the pages in 'fileStateReusablePages', or 'Nothing' if no
-    -- pages were queried yet from the free database.
-
+    , fileStateCachedFreePages :: !(S stateType [FreePage])
+    -- ^ All pages that are immediately ready for reuse in this and any
+    -- subsequent transactions.
     }
 
 data WriterEnv hnds = WriterEnv
@@ -102,8 +95,8 @@
     , writerDataFileState :: FileState 'TypeData
     -- ^ State of the file with data/leaf nodes.
 
-    , writerReusablePagesOn :: !Bool
-    -- ^ Used to turn of querying the free page database for free pages.
+    , writerQueryFreeTreeOn :: !Bool
+    -- ^ Whether or not querying free pages from the free is enabled.
 
     , writerDirtyOverflows :: !(Set DirtyOverflow)
     -- ^ Newly allocated overflow pages in this transaction.
@@ -118,111 +111,81 @@
 
 -- | Create a new writer.
 newWriter :: hnd -> TxId -> Map TxId Integer
-          -> S 'TypeData PageId          -> S 'TypeIndex PageId
-          -> S 'TypeData (Set DirtyFree) -> S 'TypeIndex (Set DirtyFree)
-          -> S 'TypeData FreeTree        -> S 'TypeIndex FreeTree
+          -> S 'TypeData PageId     -> S 'TypeIndex PageId
+          -> S 'TypeData [FreePage] -> S 'TypeIndex [FreePage]
+          -> S 'TypeData FreeTree   -> S 'TypeIndex FreeTree
           -> WriterEnv hnd
 newWriter hnd tx readers
           numDataPages numIndexPages
-          dataDirtyFree indexDirtyFree
+          dataFreePages indexFreePages
           dataFreeTree indexFreeTree =
    WriterEnv {
      writerHnds = hnd
    , writerTxId = tx
    , writerReaders = readers
 
-   , writerIndexFileState = newFileState numIndexPages indexDirtyFree indexFreeTree
-   , writerDataFileState = newFileState numDataPages dataDirtyFree dataFreeTree
+   , writerIndexFileState = newFileState numIndexPages indexFreePages indexFreeTree
+   , writerDataFileState = newFileState numDataPages dataFreePages dataFreeTree
 
-   , writerReusablePagesOn = True
+   , writerQueryFreeTreeOn = True
    , writerDirtyOverflows = S.empty
    , writerOverflowCounter = 0
    , writerRemovedOverflows = []
    }
   where
-    newFileState numPages dirtyFree freeTree = FileState {
+    newFileState numPages freePages freeTree = FileState {
         fileStateNewlyFreedPages = []
       , fileStateOriginalNumPages = numPages
       , fileStateNewNumPages = numPages
-      , fileStateFreedDirtyPages = dirtyFree
+      , fileStateDirtyPages = S.empty
+      , fileStateCachedFreePages = freePages
       , fileStateFreeTree = freeTree
-      , fileStateDirtyReusablePages = S.empty
-      , fileStateReusablePages = []
-      , fileStateReusablePagesTxId = Nothing
       }
 
--- | Wrapper around 'PageId' indicating it is a fresh page, allocated at the
--- end of the database.
-newtype Fresh = Fresh PageId deriving (Eq, Ord, Show)
-
 -- | Wrapper around 'PageId' indicating it is newly free'd and cannot be reused
 -- in the same transaction.
 newtype NewlyFreed = NewlyFreed PageId deriving (Eq, Ord, Show)
 
--- | Wrapper around 'PageId' indicating it is a dirty page.
-newtype Dirty = Dirty PageId deriving (Eq, Ord, Show)
-
--- | Wrapper around 'PageId' indicating the page is dirty and free for reuse.
-newtype DirtyFree = DirtyFree PageId deriving (Binary, Eq, Ord, Show)
-
--- | Wrapper around 'PageId' inidcating it was fetched from the free database
--- and is ready for reuse.
-newtype OldFree = OldFree PageId deriving (Eq, Ord, Show)
-
--- | Wrapper around 'PageId' indicating it wa fetched from the free database
--- and is actually dirty.
-newtype DirtyOldFree = DirtyOldFree PageId deriving (Eq, Ord, Show)
-
--- | A sum type repesenting any type of free page, that can immediately be used
--- to write something to.
-data SomeFreePage = FreshFreePage Fresh
-                  | DirtyFreePage DirtyFree
-                  | OldFreePage OldFree
+-- | Wrapper around 'PageId' indicating it is free and can be reused in any
+-- transaction.
+newtype FreePage = FreePage PageId deriving (Binary, Eq, Ord, Show)
 
-getSomeFreePageId :: SomeFreePage -> PageId
-getSomeFreePageId (FreshFreePage (Fresh     pid)) = pid
-getSomeFreePageId (DirtyFreePage (DirtyFree pid)) = pid
-getSomeFreePageId (OldFreePage   (OldFree   pid)) = pid
+-- | Wrapper around 'PageId' indicating that it is dirty, i.e. written to in
+-- this transaction.
+newtype Dirty = Dirty PageId deriving (Eq, Ord, Show)
 
 -- | Try to free a page, given a set of dirty pages.
 --
--- If the page was dirty, a 'DirtyFree' page is added to the environment, if
+-- If the page was dirty, a 'FreePage' page is added to the environment, if
 -- not a 'NewlyFreed' page is added to the environment.
 --
 -- Btw, give me lenses...
 freePage :: (Functor m, MonadState (WriterEnv hnd) m) => S stateType PageId -> m ()
 freePage pid@(DataState pid') = do
     dirty'        <- dirty pid
-    dirtyOldFree' <- dirtyOldFree pid
     modify' $ \e ->
         e { writerDataFileState =
                 updateFileState (writerDataFileState e) DataState
-                                dirty' dirtyOldFree' pid'
+                                dirty' pid'
           }
 
 freePage pid@(IndexState pid') = do
     dirty'        <- dirty pid
-    dirtyOldFree' <- dirtyOldFree pid
     modify' $ \e ->
         e { writerIndexFileState =
                 updateFileState (writerIndexFileState e) IndexState
-                                dirty' dirtyOldFree' pid'
+                                dirty' pid'
           }
 
 updateFileState :: FileState t
                 -> (forall a. a -> S t a)
                 -> Maybe Dirty
-                -> Maybe DirtyOldFree
                 -> PageId
                 -> FileState t
-updateFileState e cons dirty' dirtyOldFree' pid' =
+updateFileState e cons dirty' pid' =
   if | Just (Dirty p) <- dirty' ->
-          e { fileStateFreedDirtyPages =
-                cons $ S.insert (DirtyFree p) (getSValue $ fileStateFreedDirtyPages e) }
-
-     | Just (DirtyOldFree p) <- dirtyOldFree' ->
-          e { fileStateReusablePages =
-                OldFree p : fileStateReusablePages e }
+          e { fileStateCachedFreePages =
+                cons $ FreePage p : getSValue (fileStateCachedFreePages e) }
 
      | p <- pid' ->
           e { fileStateNewlyFreedPages =
@@ -231,58 +194,42 @@
 -- | Get a 'Dirty' page, by first proving it is in fact dirty.
 dirty :: (Functor m, MonadState (WriterEnv hnd) m) => S stateType PageId -> m (Maybe Dirty)
 dirty pid = case pid of
-    DataState p  -> (page p . fileStateOriginalNumPages . writerDataFileState) <$> get
-    IndexState p -> (page p . fileStateOriginalNumPages . writerIndexFileState) <$> get
-  where
-    page p origNumPages
-        | p >= getSValue origNumPages = Just (Dirty p)
-        | otherwise                   = Nothing
-
--- | Get a 'DirtyOldFree' page, by first proving it is in fact a dirty old free page.
-dirtyOldFree :: (Functor m, MonadState (WriterEnv hnd) m) => S stateType PageId -> m (Maybe DirtyOldFree)
-dirtyOldFree pid = case pid of
-    DataState p  -> (page p . fileStateDirtyReusablePages . writerDataFileState) <$> get
-    IndexState p -> (page p . fileStateDirtyReusablePages . writerIndexFileState) <$> get
+    DataState p  -> (page p . fileStateDirtyPages . writerDataFileState) <$> get
+    IndexState p -> (page p . fileStateDirtyPages . writerIndexFileState) <$> get
   where
-    page p dirty'
-        | S.member (DirtyOldFree p) dirty' = Just (DirtyOldFree p)
-        | otherwise                        = Nothing
-
+    page p dirtyPages
+        | p `S.member` dirtyPages = Just (Dirty p)
+        | otherwise                         = Nothing
 
 -- | Touch a fresh page, make it dirty.
 --
 -- We really need lenses...
-touchPage :: MonadState (WriterEnv hnd) m => S stateType SomeFreePage -> m ()
-touchPage (DataState (DirtyFreePage _)) = return()
-touchPage (IndexState (DirtyFreePage _)) = return ()
-
-touchPage (DataState (FreshFreePage (Fresh pid))) = modify' $ \e ->
-    case fileStateNewNumPages (writerDataFileState e) of
-        DataState numPages ->
-            if numPages < pid + 1
-                then e { writerDataFileState = (writerDataFileState e) {
-                            fileStateNewNumPages = DataState (pid + 1) }
-                       }
-                else e
-touchPage (IndexState (FreshFreePage (Fresh pid))) = modify' $ \e ->
-    case fileStateNewNumPages (writerIndexFileState e) of
-        IndexState numPages ->
-            if numPages < pid + 1
-                then e { writerIndexFileState = (writerIndexFileState e) {
-                            fileStateNewNumPages = IndexState (pid + 1) }
-                       }
-                else e
+touchPage :: MonadState (WriterEnv hnd) m => S stateType PageId -> m ()
+touchPage (DataState pid) = do
+    modify' $ \e ->
+        let dirtyPages = fileStateDirtyPages (writerDataFileState e) in
+        e { writerDataFileState = (writerDataFileState e) {
+            fileStateDirtyPages = S.insert pid dirtyPages }
+          }
+    modify' $ \e ->
+        let oldNum = getSValue $ fileStateNewNumPages (writerDataFileState e)
+            newNum = max oldNum (pid + 1)
+        in e { writerDataFileState = (writerDataFileState e) {
+                fileStateNewNumPages = DataState newNum }
+             }
 
-touchPage (DataState (OldFreePage (OldFree pid))) = modify' $ \e ->
-    let s = fileStateDirtyReusablePages (writerDataFileState e) in
-    e { writerDataFileState = (writerDataFileState e) {
-            fileStateDirtyReusablePages = S.insert (DirtyOldFree pid) s }
-      }
-touchPage (IndexState (OldFreePage (OldFree pid))) = modify' $ \e ->
-    let s = fileStateDirtyReusablePages (writerIndexFileState e) in
-    e { writerIndexFileState = (writerIndexFileState e) {
-            fileStateDirtyReusablePages = S.insert (DirtyOldFree pid) s }
-      }
+touchPage (IndexState pid) = do
+    modify' $ \e ->
+        let dirtyPages = fileStateDirtyPages (writerIndexFileState e) in
+        e { writerIndexFileState = (writerIndexFileState e) {
+            fileStateDirtyPages = S.insert pid dirtyPages }
+          }
+    modify' $ \e ->
+        let oldNum = getSValue $ fileStateNewNumPages (writerIndexFileState e)
+            newNum = max oldNum (pid + 1)
+        in e { writerIndexFileState = (writerIndexFileState e) {
+                fileStateNewNumPages = IndexState newNum }
+             }
 
 -- | Wrapper around 'OverflowId' indicating that it is dirty.
 newtype DirtyOverflow = DirtyOverflow OverflowId deriving (Eq, Ord, Show)
diff --git a/src/Database/Haskey/Alloc/Concurrent/FreePages/Query.hs b/src/Database/Haskey/Alloc/Concurrent/FreePages/Query.hs
--- a/src/Database/Haskey/Alloc/Concurrent/FreePages/Query.hs
+++ b/src/Database/Haskey/Alloc/Concurrent/FreePages/Query.hs
@@ -11,7 +11,6 @@
 
 import Data.List.NonEmpty (NonEmpty((:|)))
 import qualified Data.List.NonEmpty as NE
-import qualified Data.Set as S
 
 import Data.BTree.Alloc.Class
 import Data.BTree.Impure
@@ -26,87 +25,53 @@
 -- | Get a free page.
 --
 -- First try to get one from the in-memory dirty pages. Then try to get one
--- from the in-memory free page cache stored in 'writerReusablePages'. If that
--- one is empty, actually query one from the free database.
+-- from the in-memory free page cache stored in 'fileStateCachedFreePages'. If
+-- that one is empty, actually query one from the free database.
 getFreePageId :: (Functor m, AllocM m, MonadIO m, MonadState (WriterEnv hnd) m)
               => S stateType ()
-              -> m (Maybe SomeFreePage)
+              -> m (Maybe PageId)
 getFreePageId t =
-    runMaybeT $ (DirtyFreePage <$> MaybeT (getFreedDirtyPageId t))
-            <|> (OldFreePage   <$> MaybeT (getCachedFreePageId t))
-            <|> (OldFreePage   <$> MaybeT (queryNewFreePageIds t))
-
--- | Get a free'd dirty page.
---
--- Get a free'd dirty page, that is immediately suitable for reuse in the
--- current transaction.
-getFreedDirtyPageId :: (Functor m, MonadState (WriterEnv hnd) m)
-                    => S stateType ()
-                    -> m (Maybe DirtyFree)
-getFreedDirtyPageId stateType =
-    case stateType of
-        DataState () -> do
-            s <- writerDataFileState <$> get
-            let (pid, s') = query s DataState
-            modify' $ \env -> env { writerDataFileState = s' }
-            return pid
-        IndexState () -> do
-            s <- writerIndexFileState <$> get
-            let (pid, s') = query s IndexState
-            modify' $ \env -> env { writerIndexFileState = s' }
-            return pid
-  where
-    query :: FileState t
-          -> (forall a. a -> S t a)
-          -> (Maybe DirtyFree, FileState t)
-    query env cons =
-        case S.minView (getSValue $ fileStateFreedDirtyPages env) of
-            Nothing -> (Nothing, env)
-            Just (pid, s') ->
-                let env' = env { fileStateFreedDirtyPages = cons s' } in
-                (Just pid, env')
+    runMaybeT $ MaybeT (getCachedFreePageId t)
+            <|> MaybeT (queryNewFreePageIds t)
 
 -- | Get a cached free page.
 --
--- Get a free page from the free database cache stored in 'writerReusablePages'.
+-- Get a free page from the free database cache stored in
+-- 'fileStateCachedFreePages'.
 getCachedFreePageId :: (Functor m, MonadState (WriterEnv hnd) m)
                     => S stateType ()
-                    -> m (Maybe OldFree)
+                    -> m (Maybe PageId)
 getCachedFreePageId stateType =
-    ifM (not . writerReusablePagesOn <$> get) (return Nothing) $
     case stateType of
         DataState () -> do
             s <- writerDataFileState <$> get
-            let (pid, s') = query s
+            let (pid, s') = query DataState s
             modify' $ \env -> env { writerDataFileState = s' }
             return pid
         IndexState () -> do
             s <- writerIndexFileState <$> get
-            let (pid, s') = query s
+            let (pid, s') = query IndexState s
             modify' $ \env -> env { writerIndexFileState = s' }
             return pid
   where
-    query :: FileState t -> (Maybe OldFree, FileState t)
-    query env = case fileStateReusablePages env of
+    query :: (forall a. a -> S t a)
+          -> FileState t
+          -> (Maybe PageId, FileState t)
+    query cons env = case getSValue $ fileStateCachedFreePages env of
         [] -> (Nothing, env)
-        pid : pageIds ->
-            let env' = env { fileStateReusablePages = pageIds } in
+        FreePage pid : pageIds ->
+            let env' = env { fileStateCachedFreePages = cons pageIds } in
             (Just pid, env')
 
 -- | Try to get a list of free pages from the free page database, return the
 -- first free one for immediate use, and store the rest in the environment.
 --
--- This function will delete the lastly used entry from the free database,
--- query a new one, and then update the free page cache in the state.
---
--- This function only works when 'writerReusablePagesOn' is 'True'.
---
--- This function expects 'writerReusablePages' to be empty.
+-- Immediately remove the queried free pages from the free tree.
 queryNewFreePageIds :: (AllocM m, MonadIO m, MonadState (WriterEnv hnd) m)
                  => S stateType ()
-                 -> m (Maybe OldFree)
-queryNewFreePageIds stateType = ifM (not . writerReusablePagesOn <$> get) (return Nothing) $
-    case stateType of
+                 -> m (Maybe PageId)
+queryNewFreePageIds stateType = ifM (not . writerQueryFreeTreeOn <$> get) (return Nothing) $ do
+    flag <- case stateType of
         DataState () ->
             query DataState
                   writerDataFileState
@@ -116,39 +81,40 @@
             query IndexState
                   writerIndexFileState
                   (\e s -> e { writerIndexFileState = s })
+
+    if flag then getFreePageId stateType
+            else return Nothing
   where
     query :: (AllocM m, MonadIO m, MonadState (WriterEnv hnd) m)
           => (forall a. a -> S t a)
           -> (forall h. WriterEnv h -> FileState t)
           -> (forall h. WriterEnv h -> FileState t -> WriterEnv h)
-          -> m (Maybe OldFree)
+          -> m Bool
     query cons getState setState =  do
-        tree    <- gets $ getSValue . fileStateFreeTree . getState
-        oldTxId <- gets $ fileStateReusablePagesTxId . getState
+        tree <- gets $ getSValue . fileStateFreeTree . getState
 
-        -- Delete the previous used 'TxId' from the tree.
-        modify' $ \e -> e { writerReusablePagesOn = False }
-        tree' <- maybe (return tree) (`deleteSubtree` tree) oldTxId
-        modify' $ \e -> e { writerReusablePagesOn = True }
+        -- Lookup the oldest free page
+        lookupValidFreePageIds tree >>= \case
+            Nothing -> return False
+            Just (txId, x :| xs) -> do
+                -- Save them for reuse
+                modify' $ \e ->
+                    let s    = getState e
+                        pids = map FreePage (x:xs)
+                    in setState e $
+                    s { fileStateCachedFreePages =
+                            cons $ pids ++ getSValue (fileStateCachedFreePages s) }
 
-        -- Set the new free tree
-        modify' $ \e -> setState e $
-            (getState e) { fileStateFreeTree = cons tree' }
+                -- Remove the entry from the tree
+                modify' $ \e -> e { writerQueryFreeTreeOn = False }
+                tree' <- txId `deleteSubtree` tree
+                modify' $ \e -> e { writerQueryFreeTreeOn = True }
 
-        -- Lookup the oldest free page
-        lookupValidFreePageIds tree' >>= \case
-            Nothing -> do
-                modify' $ \e -> setState e $
-                    (getState e) { fileStateDirtyReusablePages = S.empty
-                                 , fileStateReusablePages = []
-                                 , fileStateReusablePagesTxId = Nothing }
-                return Nothing
-            Just (txId, pid :| pageIds) -> do
+                -- Update the tree
                 modify' $ \e -> setState e $
-                    (getState e) { fileStateDirtyReusablePages = S.empty
-                                 , fileStateReusablePages = map OldFree pageIds
-                                 , fileStateReusablePagesTxId = Just txId }
-                return (Just $ OldFree pid)
+                    (getState e) { fileStateFreeTree = cons tree' }
+
+                return True
 
 -- | Lookup a list of free pages from the free page database, guaranteed to be old enough.
 lookupValidFreePageIds :: (MonadIO m, AllocReaderM m, MonadState (WriterEnv hnd) m)
diff --git a/src/Database/Haskey/Alloc/Concurrent/FreePages/Save.hs b/src/Database/Haskey/Alloc/Concurrent/FreePages/Save.hs
--- a/src/Database/Haskey/Alloc/Concurrent/FreePages/Save.hs
+++ b/src/Database/Haskey/Alloc/Concurrent/FreePages/Save.hs
@@ -15,12 +15,11 @@
               -> FileState t
               -> m FreeTree
 saveFreePages tx env = saveNewlyFreedPages tx env tree
-                   >>= saveCachedFreePages env
   where
     tree = getSValue $ fileStateFreeTree env
 
 -- | Save the newly free pages of the current transaction, as stored by
--- 'writerNewlyFreedPages'.
+-- 'fileStateNewlyFreedPages'.
 saveNewlyFreedPages :: AllocM m
                     => TxId
                     -> FileState t
@@ -32,18 +31,3 @@
         x:xs -> replaceSubtree tx (x :| xs) tree
   where
     newlyFreed = map (\(NewlyFreed pid) -> pid) $ fileStateNewlyFreedPages env
-
--- | Save the free apges from the free page cache in
--- 'writerReusablePages' using 'writerReuseablePagesTxId'.
-saveCachedFreePages :: AllocM m
-                    => FileState t
-                    -> FreeTree
-                    -> m FreeTree
-saveCachedFreePages env tree = case fileStateReusablePagesTxId env of
-    Nothing -> return tree
-    Just k ->
-        case freePages of
-            [] -> deleteSubtree k tree
-            x:xs -> replaceSubtree k (x :| xs) tree
-  where
-    freePages = map (\(OldFree pid) -> pid) $ fileStateReusablePages env
diff --git a/src/Database/Haskey/Alloc/Concurrent/Meta.hs b/src/Database/Haskey/Alloc/Concurrent/Meta.hs
--- a/src/Database/Haskey/Alloc/Concurrent/Meta.hs
+++ b/src/Database/Haskey/Alloc/Concurrent/Meta.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -9,7 +10,7 @@
 
 import Data.Binary (Binary)
 import Data.Proxy (Proxy)
-import Data.Set as Set
+import Data.Typeable (Typeable)
 
 import GHC.Generics (Generic)
 
@@ -21,41 +22,52 @@
 import Database.Haskey.Alloc.Concurrent.Overflow
 import Database.Haskey.Store
 
+-- | User-defined data root stored inside 'ConcurrentMeta'.
+--
+-- This can be a user-defined collection of 'Tree' roots.
+class Value root => Root root where
+
+instance (Key k, Value v) => Root (Tree k v) where
+
 -- | Data type used to point to the most recent version of the meta data.
 data CurrentMetaPage = Meta1 | Meta2
 
 -- | Meta data of the page allocator.
-data ConcurrentMeta k v = ConcurrentMeta {
+--
+-- The @root@ type parameter should be a user-defined collection of 'Tree'
+-- roots, instantiating the 'Root' type class.
+--
+-- To store store a single tree, use @ConcurrentMeta (Tree k v)@.
+data ConcurrentMeta root = ConcurrentMeta {
     concurrentMetaRevision :: TxId
   , concurrentMetaDataNumPages :: S 'TypeData PageId
   , concurrentMetaIndexNumPages :: S 'TypeIndex PageId
-  , concurrentMetaTree :: Tree k v
+  , concurrentMetaRoot :: root
   , concurrentMetaDataFreeTree :: S 'TypeData FreeTree
   , concurrentMetaIndexFreeTree :: S 'TypeIndex FreeTree
   , concurrentMetaOverflowTree :: OverflowTree
-  , concurrentMetaDataFreshUnusedPages :: S 'TypeData (Set DirtyFree)
-  , concurrentMetaIndexFreshUnusedPages :: S 'TypeIndex (Set DirtyFree)
-  } deriving (Generic)
+  , concurrentMetaDataCachedFreePages :: S 'TypeData [FreePage]
+  , concurrentMetaIndexCachedFreePages :: S 'TypeIndex [FreePage]
+  } deriving (Generic, Typeable)
 
-deriving instance (Show k, Show v) => Show (ConcurrentMeta k v)
+deriving instance (Show root) => Show (ConcurrentMeta root)
 
-instance (Binary k, Binary v) => Binary (ConcurrentMeta k v) where
+instance (Binary root) => Binary (ConcurrentMeta root) where
 
 -- | A class representing the storage requirements of the page allocator.
 --
 -- A store supporting the page allocator should be an instance of this class.
 class StoreM FilePath m => ConcurrentMetaStoreM m where
     -- | Write the meta-data structure to a certain page.
-    putConcurrentMeta :: (Key k, Value v)
+    putConcurrentMeta :: Root root
                       => FilePath
-                      -> ConcurrentMeta k v
+                      -> ConcurrentMeta root
                       -> m ()
 
     -- | Try to read the meta-data structure from a handle, or return 'Nothing'
     -- if the handle doesn't contain a meta page.
-    readConcurrentMeta :: (Key k, Value v)
+    readConcurrentMeta :: Root root
                        => FilePath
-                       -> Proxy k
-                       -> Proxy v
-                       -> m (Maybe (ConcurrentMeta k v))
+                       -> Proxy root
+                       -> m (Maybe (ConcurrentMeta root))
 
diff --git a/src/Database/Haskey/Alloc/Concurrent/Monad.hs b/src/Database/Haskey/Alloc/Concurrent/Monad.hs
--- a/src/Database/Haskey/Alloc/Concurrent/Monad.hs
+++ b/src/Database/Haskey/Alloc/Concurrent/Monad.hs
@@ -31,7 +31,8 @@
 
 -- | All necessary database handles.
 data ConcurrentHandles = ConcurrentHandles {
-    concurrentHandlesData :: FilePath
+    concurrentHandlesRoot :: FilePath
+  , concurrentHandlesData :: FilePath
   , concurrentHandlesIndex :: FilePath
   , concurrentHandlesMetadata1 :: FilePath
   , concurrentHandlesMetadata2 :: FilePath
@@ -41,7 +42,8 @@
 -- | Construct a set of 'ConcurrentHandles' from a root directory.
 concurrentHandles :: FilePath -> ConcurrentHandles
 concurrentHandles fp = ConcurrentHandles {
-    concurrentHandlesData        = fp </> "data" </> "data"
+    concurrentHandlesRoot        = fp
+  , concurrentHandlesData        = fp </> "data" </> "data"
   , concurrentHandlesIndex       = fp </> "index" </> "index"
   , concurrentHandlesMetadata1   = fp </> "meta" </> "1"
   , concurrentHandlesMetadata2   = fp </> "meta" </> "2"
@@ -89,7 +91,7 @@
         hnd <- getWriterHnd height
         pid <- getAndTouchPid
 
-        let nid = pageIdToNodeId (getSomeFreePageId pid)
+        let nid = pageIdToNodeId pid
         lift $ putNodePage hnd height nid n
         return nid
       where
@@ -112,14 +114,12 @@
         newTouchedPid = case viewHeight height of
             UZero -> do
                 pid <- fileStateNewNumPages . writerDataFileState <$> get
-                let pid' = FreshFreePage . Fresh <$> pid
-                touchPage pid'
-                return $ getSValue pid'
+                touchPage pid
+                return $ getSValue pid
             USucc _ -> do
                 pid <- fileStateNewNumPages . writerIndexFileState <$> get
-                let pid'' = FreshFreePage . Fresh <$> pid
-                touchPage pid''
-                return $ getSValue pid''
+                touchPage pid
+                return $ getSValue pid
 
 
     freeNode height nid = case viewHeight height of
diff --git a/src/Database/Haskey/Alloc/Transaction.hs b/src/Database/Haskey/Alloc/Transaction.hs
--- a/src/Database/Haskey/Alloc/Transaction.hs
+++ b/src/Database/Haskey/Alloc/Transaction.hs
@@ -2,25 +2,24 @@
 module Database.Haskey.Alloc.Transaction where
 
 import Data.BTree.Alloc.Class
-import Data.BTree.Impure.Structures
 
 -- | A committed or aborted transaction, with a return value of type @a@.
-data Transaction key val a =
-      Commit (Tree key val) a
+data Transaction r a =
+      Commit r a
     | Abort a
 
 -- | Commit the new tree and return a computed value.
-commit :: AllocM n => a -> Tree key val -> n (Transaction key val a)
+commit :: AllocM n => a -> r -> n (Transaction r a)
 commit v t = return $ Commit t v
 
 -- | Commit the new tree, without return a computed value.
-commit_ :: AllocM n => Tree key val -> n (Transaction key val ())
+commit_ :: AllocM n => r -> n (Transaction r ())
 commit_ = commit ()
 
 -- | Abort the transaction and return a computed value.
-abort :: AllocM n => a -> n (Transaction key val a)
+abort :: AllocM n => a -> n (Transaction r a)
 abort = return . Abort
 
 -- | Abort the transaction, without returning a computed value.
-abort_ :: AllocM n => n (Transaction key val ())
+abort_ :: AllocM n => n (Transaction r ())
 abort_ = return $ Abort ()
diff --git a/src/Database/Haskey/Store/Class.hs b/src/Database/Haskey/Store/Class.hs
--- a/src/Database/Haskey/Store/Class.hs
+++ b/src/Database/Haskey/Store/Class.hs
@@ -40,6 +40,12 @@
     -- | Open a database handle for reading and writing.
     openHandle :: hnd -> m ()
 
+    -- | Obtain a lock on the given handle, so no other process can access it.
+    lockHandle :: hnd -> m ()
+
+    -- | Release the lock on the given handle, so other processes can access it.
+    releaseHandle :: hnd -> m ()
+
     -- | Flush the contents of a handle to disk (or other storage).
     flushHandle :: hnd -> m ()
 
@@ -118,6 +124,8 @@
 
 instance StoreM hnd m => StoreM hnd (StateT s m) where
     openHandle    = lift.             openHandle
+    lockHandle    = lift.             lockHandle
+    releaseHandle = lift.             releaseHandle
     flushHandle   = lift.             flushHandle
     closeHandle   = lift.             closeHandle
     removeHandle  = lift.             closeHandle
@@ -133,6 +141,8 @@
 
 instance StoreM hnd m => StoreM hnd (ReaderT s m) where
     openHandle    = lift.             openHandle
+    lockHandle    = lift.             lockHandle
+    releaseHandle = lift.             releaseHandle
     flushHandle   = lift.             flushHandle
     closeHandle   = lift.             closeHandle
     removeHandle  = lift.             closeHandle
diff --git a/src/Database/Haskey/Store/File.hs b/src/Database/Haskey/Store/File.hs
--- a/src/Database/Haskey/Store/File.hs
+++ b/src/Database/Haskey/Store/File.hs
@@ -13,13 +13,11 @@
 module Database.Haskey.Store.File (
   -- * Storage
   Page(..)
-, Files
 , FileStoreConfig(..)
 , defFileStoreConfig
 , fileStoreConfigWithPageSize
 , FileStoreT
 , runFileStoreT
-, newFileStore
 
   -- * Binary encoding
 , encodeAndPad
@@ -36,13 +34,13 @@
 import Control.Monad.Catch
 import Control.Monad.IO.Class
 import Control.Monad.Reader
+import Control.Monad.State.Class
+import Control.Monad.Trans.State.Strict ( StateT, evalStateT)
 
-import Data.Coerce (coerce)
 import Data.Map (Map)
 import Data.Maybe (fromJust)
 import Data.Monoid ((<>))
-import Data.IORef
-import Data.Typeable (Typeable)
+import Data.Typeable (Typeable, cast)
 import Data.Word (Word64)
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Map as M
@@ -85,22 +83,10 @@
 --
 -- Each file is a 'Handle' opened in 'System.IO.ReadWriteMode' and contains a
 -- collection of physical pages.
---
--- These files can be safely shared between threads.
-type Files fp = IORef (Map fp IO.FHandle)
-
--- | Access the files.
-get :: MonadIO m => FileStoreT fp m (Map fp IO.FHandle)
-get = FileStoreT . lift $ ask >>= liftIO . readIORef
-
--- | Modify the files.
-modify' :: MonadIO m
-        => (Map fp IO.FHandle -> Map fp IO.FHandle)
-        -> FileStoreT fp m ()
-modify' f = FileStoreT . lift $ ask >>= liftIO . flip modifyIORef' f
+type Files fp = Map fp IO.FHandle
 
 lookupHandle :: (Functor m, MonadThrow m, Ord fp, Show fp, Typeable fp)
-             => fp -> Map fp IO.FHandle -> m IO.FHandle
+             => fp -> Files fp -> m IO.FHandle
 lookupHandle fp m = justErrM (FileNotFoundError fp) $ M.lookup fp m
 
 -- | Monad in which on-disk storage operations can take place.
@@ -109,10 +95,10 @@
 -- 'ConcurrentMetaStoreM' making it a storage back-end compatible with the
 -- concurrent page allocator.
 newtype FileStoreT fp m a = FileStoreT
-    { fromFileStoreT :: ReaderT FileStoreConfig (ReaderT (Files fp) m) a
+    { fromFileStoreT :: ReaderT FileStoreConfig (StateT (Files fp) m) a
     } deriving (Applicative, Functor, Monad,
                 MonadIO, MonadThrow, MonadCatch, MonadMask,
-                MonadReader FileStoreConfig)
+                MonadReader FileStoreConfig, MonadState (Files fp))
 
 -- | File store configuration.
 --
@@ -152,15 +138,11 @@
 
 -- | Run the storage operations in the 'FileStoreT' monad, given a collection of
 -- open files.
-runFileStoreT :: FileStoreT fp m a -- ^ Action
+runFileStoreT :: Monad m
+              => FileStoreT FilePath m a -- ^ Action
               -> FileStoreConfig   -- ^ Configuration
-              -> Files fp          -- ^ Open files
               -> m a
-runFileStoreT m config = runReaderT (runReaderT (fromFileStoreT m) config)
-
--- | An empty file store, with no open files.
-newFileStore :: IO (Files fp)
-newFileStore = newIORef M.empty
+runFileStoreT m config = evalStateT (runReaderT (fromFileStoreT m) config) M.empty
 
 --------------------------------------------------------------------------------
 
@@ -172,8 +154,12 @@
         unless alreadyOpen $ do
             liftIO $ createDirectoryIfMissing True (takeDirectory fp)
             fh <- liftIO $ IO.openReadWrite fp
-            modify' $ M.insert fp fh
+            modify $ M.insert fp fh
 
+    lockHandle = void . liftIO . IO.obtainPrefixLock
+
+    releaseHandle = liftIO . IO.releasePrefixLock . IO.prefixLockFromPrefix
+
     flushHandle fp = do
         fh <- get >>= lookupHandle fp
         liftIO $ IO.flush fh
@@ -182,7 +168,7 @@
         fh <- get >>= lookupHandle fp
         liftIO $ IO.flush fh
         liftIO $ IO.close fh
-        modify' (M.delete fp)
+        modify (M.delete fp)
 
     removeHandle fp =
         liftIO $ removeFile fp `catchIOError` \e ->
@@ -264,14 +250,14 @@
         liftIO $ IO.seek h 0
         liftIO $ writeLazyByteString h bs
 
-    readConcurrentMeta fp k v = do
+    readConcurrentMeta fp root = do
         fh <- get >>=  lookupHandle fp
 
         len <- liftIO $ IO.getFileSize fh
         liftIO $ IO.seek fh 0
         bs <- liftIO $ readByteString fh (fromIntegral len)
-        handle handle' (Just <$> decodeM (concurrentMetaPage k v) bs) >>= \case
-            Just (ConcurrentMetaPage meta) -> return $ Just (coerce meta)
+        handle handle' (Just <$> decodeM (concurrentMetaPage root) bs) >>= \case
+            Just (ConcurrentMetaPage meta) -> return $! cast meta
             Nothing -> return Nothing
       where
         handle' (DecodeError _) = return Nothing
diff --git a/src/Database/Haskey/Store/InMemory.hs b/src/Database/Haskey/Store/InMemory.hs
--- a/src/Database/Haskey/Store/InMemory.hs
+++ b/src/Database/Haskey/Store/InMemory.hs
@@ -30,6 +30,7 @@
 ) where
 
 import Control.Applicative (Applicative, (<$>))
+import Control.Concurrent.MVar
 import Control.Monad
 import Control.Monad.Catch
 import Control.Monad.IO.Class
@@ -37,11 +38,9 @@
 
 import Data.ByteString (ByteString)
 import Data.ByteString.Lazy (toStrict)
-import Data.Coerce
-import Data.IORef
 import Data.Map (Map)
 import Data.Maybe (fromJust)
-import Data.Typeable (Typeable)
+import Data.Typeable (Typeable, cast)
 import Data.Word (Word64)
 import qualified Data.Map as M
 
@@ -61,11 +60,11 @@
 -- | A collection of 'File's, each associated with a certain @fp@ handle.
 --
 -- This is shareable amongst multiple threads.
-type MemoryFiles fp = IORef (Map fp MemoryFile)
+type MemoryFiles fp = MVar (Map fp MemoryFile)
 
 -- | Access the files.
 get :: MonadIO m => MemoryStoreT fp m (Map fp MemoryFile)
-get = MemoryStoreT . lift $ ask >>= liftIO . readIORef
+get = MemoryStoreT . lift $ ask >>= liftIO . readMVar
 
 -- | Access the files.
 gets :: (Functor m, MonadIO m)
@@ -77,7 +76,7 @@
 modify' :: MonadIO m =>
         (Map fp MemoryFile -> Map fp MemoryFile)
         -> MemoryStoreT fp m ()
-modify' f = MemoryStoreT . lift $ ask >>= liftIO . flip modifyIORef' f
+modify' f = MemoryStoreT . lift $ ask >>= liftIO . flip modifyMVar_ (return . f)
 
 lookupFile :: (MonadThrow m, Ord fp, Show fp, Typeable fp)
            => fp -> Map fp MemoryFile -> m MemoryFile
@@ -145,7 +144,7 @@
 
 -- | Construct a store with an empty database with name of type @hnd@.
 newEmptyMemoryStore :: IO (MemoryFiles hnd)
-newEmptyMemoryStore = newIORef M.empty
+newEmptyMemoryStore = newMVar M.empty
 
 --------------------------------------------------------------------------------
 
@@ -154,8 +153,12 @@
     StoreM fp (MemoryStoreT fp m)
   where
     openHandle fp =
-        modify' $ M.insertWith (flip const) fp M.empty
+        modify' $ M.insertWith (\_new old -> old) fp M.empty
 
+    lockHandle _ = return ()
+
+    releaseHandle _ = return ()
+
     flushHandle _ = return ()
 
     closeHandle _ = return ()
@@ -207,11 +210,14 @@
       where
         pg = toStrict . encode $ ConcurrentMetaPage meta
 
-    readConcurrentMeta hnd k v = do
-        Just bs <- gets (M.lookup hnd >=> M.lookup 0)
-        handle handle' (Just <$> decodeM (concurrentMetaPage k v) bs) >>= \case
-            Just (ConcurrentMetaPage meta) -> return . Just $! coerce meta
+    readConcurrentMeta hnd root = do
+        maybeBs <- gets (M.lookup hnd >=> M.lookup 0)
+        case maybeBs of
             Nothing -> return Nothing
+            Just bs ->
+                handle handle' (Just <$> decodeM (concurrentMetaPage root) bs) >>= \case
+                    Just (ConcurrentMetaPage meta) -> return $! cast meta
+                    Nothing -> return Nothing
       where
         handle' (DecodeError _) = return Nothing
 
diff --git a/src/Database/Haskey/Store/Page.hs b/src/Database/Haskey/Store/Page.hs
--- a/src/Database/Haskey/Store/Page.hs
+++ b/src/Database/Haskey/Store/Page.hs
@@ -70,8 +70,8 @@
 -- | A decoded page, of a certain type @t@ of kind 'PageType'.
 data Page (t :: PageType) where
     EmptyPage :: Page 'TypeEmpty
-    ConcurrentMetaPage :: (Key k, Value v)
-                       => ConcurrentMeta k v
+    ConcurrentMetaPage :: Root root
+                       => ConcurrentMeta root
                        -> Page 'TypeConcurrentMeta
     OverflowPage :: (Value v)
                  => v
@@ -230,16 +230,15 @@
     get' :: (Value v) => Proxy v -> Get v
     get' _ = get
 
-concurrentMetaPage :: (Key k, Value v)
-                   => Proxy k
-                   -> Proxy v
+concurrentMetaPage :: Root root
+                   => Proxy root
                    -> SGet 'TypeConcurrentMeta
-concurrentMetaPage k v = SGet STypeConcurrentMeta $ get >>= \ case
-    TypeConcurrentMeta -> ConcurrentMetaPage <$> get' k v
+concurrentMetaPage root = SGet STypeConcurrentMeta $ get >>= \ case
+    TypeConcurrentMeta -> ConcurrentMetaPage <$> get' root
     x -> fail $ "unexpected " ++ show x ++ " while decoding TypeConcurrentMeta"
   where
-    get' :: (Key k, Value v) => Proxy k -> Proxy v -> Get (ConcurrentMeta k v)
-    get' _ _ = get
+    get' :: Root root => Proxy root -> Get (ConcurrentMeta root)
+    get' _ = get
 
 -- | Exception thrown when decoding of a page fails.
 newtype DecodeError = DecodeError String deriving (Show, Typeable)
diff --git a/tests/Integration.hs b/tests/Integration.hs
--- a/tests/Integration.hs
+++ b/tests/Integration.hs
@@ -4,11 +4,13 @@
 
 import Test.Framework (Test, defaultMain)
 
+import qualified Integration.CreateAndOpen
 import qualified Integration.WriteOpenRead.Concurrent
 
 tests :: [Test]
 tests =
-    [ Integration.WriteOpenRead.Concurrent.tests
+    [ Integration.CreateAndOpen.tests
+    , Integration.WriteOpenRead.Concurrent.tests
     ]
 
 main :: IO ()
diff --git a/tests/Integration/CreateAndOpen.hs b/tests/Integration/CreateAndOpen.hs
new file mode 100644
--- /dev/null
+++ b/tests/Integration/CreateAndOpen.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Integration.CreateAndOpen where
+
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit hiding (Test, Node)
+
+import Control.Applicative ((<$>))
+
+import Data.Binary (Binary)
+import Data.Maybe (fromJust)
+import Data.Typeable (Typeable)
+
+import System.Directory (removeDirectoryRecursive,
+                         getTemporaryDirectory, doesDirectoryExist,
+                         writable, getPermissions)
+import System.IO.Temp (createTempDirectory)
+
+import Data.BTree.Primitives (Value)
+
+import Database.Haskey.Alloc.Concurrent
+import Database.Haskey.Store.File
+
+tests :: Test
+tests = testGroup "CreateAndOpen"
+    [ testCase "file backend" case_file_backend
+    ]
+
+case_file_backend :: Assertion
+case_file_backend = do
+    exists <- doesDirectoryExist "/var/run/shm"
+    w      <- if exists then writable <$> getPermissions "/var/run/shm"
+                        else return False
+    tmpDir <- if w then return "/var/run/shm"
+                   else getTemporaryDirectory
+    fp     <- createTempDirectory tmpDir "db.haskey"
+    let hnds = concurrentHandles fp
+
+    _     <- create hnds
+    root' <- open hnds
+
+    removeDirectoryRecursive fp
+
+    assertEqual "should've read back initial root" (Just root) root'
+  where
+    create :: ConcurrentHandles -> IO (ConcurrentDb TestRoot)
+    create hnds = runFileStoreT (createConcurrentDb hnds root) config
+
+    open :: ConcurrentHandles -> IO (Maybe TestRoot)
+    open hnds = do
+        maybeDb <- runFileStoreT (openConcurrentDb hnds) config
+        case maybeDb of
+            Nothing -> return Nothing
+            Just db -> Just <$> runFileStoreT (transactReadOnly return db) config
+
+    config = fromJust $ fileStoreConfigWithPageSize 256
+
+    root = TestRoot "Hello World!"
+
+newtype TestRoot = TestRoot String deriving (Binary, Eq, Value, Show, Typeable)
+
+instance Root TestRoot where
diff --git a/tests/Integration/WriteOpenRead/Concurrent.hs b/tests/Integration/WriteOpenRead/Concurrent.hs
--- a/tests/Integration/WriteOpenRead/Concurrent.hs
+++ b/tests/Integration/WriteOpenRead/Concurrent.hs
@@ -61,6 +61,8 @@
     gen = (mkQCGen seed, seed)
     args = stdArgs { replay = Just gen }
 
+type Root' = Tree Integer TestValue
+
 prop_memory_backend :: PropertyM IO ()
 prop_memory_backend = forAllM (genTestSequence False) $ \(TestSequence txs) -> do
     files <- run newEmptyMemoryStore
@@ -71,7 +73,7 @@
     return ()
   where
 
-    writeReadTest :: ConcurrentDb Integer TestValue
+    writeReadTest :: ConcurrentDb Root'
                   -> MemoryFiles String
                   -> Map Integer TestValue
                   -> TestTransaction Integer TestValue
@@ -87,8 +89,8 @@
                     ++ "\n    expectd: " ++ show (M.toList expected)
                     ++ "\n    got:     " ++ show read'
 
-    create :: MemoryFiles String -> IO (ConcurrentDb Integer TestValue)
-    create = runMemoryStoreT (createConcurrentDb hnds) config
+    create :: MemoryFiles String -> IO (ConcurrentDb Root')
+    create = runMemoryStoreT (createConcurrentDb hnds Tree.empty) config
       where
         hnds = concurrentHandles ""
 
@@ -109,29 +111,25 @@
     tmpDir <- if w then return "/var/run/shm"
                    else run getTemporaryDirectory
     fp     <- run $ createTempDirectory tmpDir "db.haskey"
-
     let hnds = concurrentHandles fp
-    files  <- run newFileStore
-    db     <- run $ create files hnds
-    result <- run . runMaybeT $ foldM (writeReadTest db files)
+
+    db     <- run $ create hnds
+    result <- run . runMaybeT $ foldM (writeReadTest db)
                                       M.empty
                                       txs
 
-    _ <- run $ runFileStoreT (closeConcurrentHandles hnds) config files
-
     run $ removeDirectoryRecursive fp
 
     assert $ isJust result
   where
-    writeReadTest :: ConcurrentDb Integer TestValue
-                  -> Files FilePath
+    writeReadTest :: ConcurrentDb Root'
                   -> Map Integer TestValue
                   -> TestTransaction Integer TestValue
                   -> MaybeT IO (Map Integer TestValue)
-    writeReadTest db files m tx = do
-        _     <- lift $ void (openAndWrite db files tx) `catch`
+    writeReadTest db m tx = do
+        _     <- lift $ void (openAndWrite db tx) `catch`
                             \TestException -> return ()
-        read' <- lift $ openAndRead db files
+        read' <- lift $ openAndRead db
         let expected = fromMaybe m $ testTransactionResult m tx
         if read' == M.toList expected
             then return expected
@@ -140,22 +138,20 @@
                     ++ "\n    expectd: " ++ show (M.toList expected)
                     ++ "\n    got:     " ++ show read'
 
-    create :: Files FilePath
-           -> ConcurrentHandles
-           -> IO (ConcurrentDb Integer TestValue)
-    create files hnds = runFileStoreT (createConcurrentDb hnds) config files
+    create :: ConcurrentHandles
+           -> IO (ConcurrentDb Root')
+    create hnds = runFileStoreT (createConcurrentDb hnds Tree.empty) config
 
-    openAndRead :: ConcurrentDb Integer TestValue
-                -> Files FilePath
+
+    openAndRead :: ConcurrentDb Root'
                 -> IO [(Integer, TestValue)]
     openAndRead db = runFileStoreT (readAll db) config
 
-    openAndWrite :: ConcurrentDb Integer TestValue
-                 -> Files FilePath
+    openAndWrite :: ConcurrentDb Root'
                  -> TestTransaction Integer TestValue
                  -> IO ()
-    openAndWrite db files tx =
-        runFileStoreT (void $ writeTransaction tx db) config files
+    openAndWrite db tx =
+        runFileStoreT (void $ writeTransaction tx db) config
 
     config = fromJust $ fileStoreConfigWithPageSize 256
 
@@ -163,7 +159,7 @@
 
 writeTransaction :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Key k, Value v)
                  => TestTransaction k v
-                 -> ConcurrentDb k v
+                 -> ConcurrentDb (Tree k v)
                  -> m ()
 writeTransaction (TestTransaction txType actions) =
     transaction
@@ -177,13 +173,13 @@
         foldl (>=>) return (map writeAction actions)
         >=> commitOrAbort
 
-    commitOrAbort :: (AllocM n, MonadMask n) => Tree key val -> n (Transaction key val ())
+    commitOrAbort :: (AllocM n, MonadMask n) => root -> n (Transaction root ())
     commitOrAbort
         | TxAbort  <- txType = const abort_
         | TxCommit <- txType = commit_
 
 readAll :: (MonadIO m, MonadMask m, ConcurrentMetaStoreM m, Key k, Value v)
-        => ConcurrentDb k v
+        => ConcurrentDb (Tree k v)
         -> m [(k, v)]
 readAll = transactReadOnly Tree.toList