diff --git a/avers.cabal b/avers.cabal
--- a/avers.cabal
+++ b/avers.cabal
@@ -1,5 +1,5 @@
 name:                avers
-version:             0.0.9
+version:             0.0.10
 license:             GPL-3
 license-file:        LICENSE
 author:              Tomas Carnecky
@@ -72,7 +72,7 @@
       , cryptohash
       , inflections
       , resource-pool
-      , rethinkdb-client-driver >= 0.0.19
+      , rethinkdb-client-driver == 0.0.20
       , scrypt
 
 
@@ -93,7 +93,7 @@
       , mtl
       , criterion
       , resource-pool
-      , rethinkdb-client-driver >= 0.0.19
+      , rethinkdb-client-driver == 0.0.20
       , network-uri
       , text
 
@@ -119,7 +119,7 @@
       , inflections
       , mtl
       , resource-pool
-      , rethinkdb-client-driver >= 0.0.19
+      , rethinkdb-client-driver == 0.0.20
       , scrypt
       , stm
       , text
diff --git a/src/Avers.hs b/src/Avers.hs
--- a/src/Avers.hs
+++ b/src/Avers.hs
@@ -30,6 +30,9 @@
   , objectsOfType
   , allObjectsOfType
 
+  , createCheckpoint
+  , vacuumObject
+
     -- * Patch
   , Patch(..)
   , PatchError(..)
@@ -112,6 +115,7 @@
 
 import Avers.Patching
 import Avers.Storage
+import Avers.Storage.Expressions
 import Avers.Storage.Backend
 import Avers.Types
 import Avers.Views
diff --git a/src/Avers/Patching.hs b/src/Avers/Patching.hs
--- a/src/Avers/Patching.hs
+++ b/src/Avers/Patching.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards   #-}
 
 module Avers.Patching
     ( applyOperation
@@ -28,8 +28,10 @@
 -- | Apply the given op on the value. Can throw an exception if the operation
 --   is invalid.
 applyOperation :: Value -> Operation -> PatchM Value
-applyOperation value Set{..} = changeObject value opPath $ \key ->
-    maybe (M.delete key) (M.insert key) opValue
+applyOperation value Set{..}
+    | opPath == "", Just val <- opValue = return val
+    | otherwise = changeObject value opPath $ \key ->
+        maybe (M.delete key) (M.insert key) opValue
 
 applyOperation value Splice{..} = changeArray value opPath $ \a -> do
 
diff --git a/src/Avers/Storage.hs b/src/Avers/Storage.hs
--- a/src/Avers/Storage.hs
+++ b/src/Avers/Storage.hs
@@ -67,16 +67,7 @@
 requireResult _   (Just v) = return v
 
 
--- All the tables which this storage engine uses.
-objectsTable, sessionsTable, snapshotsTable, patchesTable, secretsTable, blobsTable :: R.Exp R.Table
-blobsTable     = R.Table Nothing $ R.lift ("blobs" :: Text)
-objectsTable   = R.Table Nothing $ R.lift ("objects" :: Text)
-patchesTable   = R.Table Nothing $ R.lift ("patches" :: Text)
-secretsTable   = R.Table Nothing $ R.lift ("secrets" :: Text)
-sessionsTable  = R.Table Nothing $ R.lift ("sessions" :: Text)
-snapshotsTable = R.Table Nothing $ R.lift ("snapshots" :: Text)
 
-
 -- | True if the object exists.
 exists :: ObjId -> Avers Bool
 exists objId = measureDuration M_avers_storage_exists_duration $
@@ -108,13 +99,15 @@
 createObject' :: (ToJSON a) => ObjId -> UTCTime -> ObjectType a -> ObjId -> a -> Avers ()
 createObject' objId now ot@ObjectType{..} createdBy content = do
     insertDocument objectsTable object
-    insertDocument snapshotsTable snapshot
+    insertDocument patchesTable patch
+
     updateObjectViews ot objId (Just content)
 
   where
-    object   = Object objId otType now createdBy Nothing
-    boId     = BaseObjectId objId
-    snapshot = Snapshot boId zeroRevId (toJSON content)
+    object = Object objId otType now createdBy Nothing
+    boId   = BaseObjectId objId
+    op     = Set rootPath (Just $ toJSON content)
+    patch  = Patch boId zeroRevId objId now op
 
 
 
@@ -132,6 +125,8 @@
 -- | Prune the object from the database. This is only allowed if the object is
 -- marked as deleted. Note that this is a very dangerous operation, it can not
 -- be undone.
+--
+-- TODO: Prune related Release and Authoriation objects.
 pruneObject :: ObjId -> Avers ()
 pruneObject objId = do
     obj <- lookupObject objId
@@ -140,22 +135,11 @@
     unless (objectDeleted obj == Just True) $
         strErr $ "pruneObject: object " ++ show objId ++ " is not deleted"
 
-    -- Drop all related patches. Note that there will never be a patch with
-    -- revision zero, so it's safe to use 'patchesAfterRevision'.
-    patches <- patchesAfterRevision (BaseObjectId objId) zeroRevId
-    void $ mapM (deleteDocument patchesTable) patches
-
-    -- Drop all related snapshots.
-    snapshotDatums <- runQueryCollect $
-        R.BetweenIndexed
-            "objectSnapshotSequence"
-            ( R.Closed $ R.Array $ V.fromList [R.String $ toPk objId, R.Number $ fromIntegral (0 :: Int)]
-            , R.Open $ R.Array $ V.fromList [R.String $ toPk objId, R.Number $ fromIntegral (99999999 :: Int)]
-            )
-
-        snapshotsTable
-    snapshots <- V.mapM parseDatum snapshotDatums :: Avers (Vector Snapshot)
-    void $ V.mapM (deleteDocument snapshotsTable) snapshots
+    -- Drop all base object patches and snapshots.
+    void $ runQuery $ R.Delete $
+        objectPatchSequenceE (BaseObjectId objId) 0 maxBound
+    void $ runQuery $ R.Delete $
+        objectSnapshotSequenceE (BaseObjectId objId) 0 maxBound
 
     -- Remove related entries from all views.
     forM_ (otViews objType) $ \(SomeView view) -> do
@@ -166,6 +150,60 @@
 
 
 
+-- | Create a checkpoint for for the given object. All patches (and of course
+-- snapshots) before the checkpoint can be dropped. Use 'vacuumObject' to do
+-- that.
+createCheckpoint :: ObjectId -> ObjId -> Avers RevId
+createCheckpoint objId createdBy = do
+    now <- liftIO $ getCurrentTime
+    Snapshot{..} <- lookupLatestSnapshot objId
+
+    let op    = Set rootPath (Just $ toJSON snapshotContent)
+        revId = succ snapshotRevisionId
+
+    savePatch $ Patch objId revId createdBy now op
+    saveSnapshot $ Snapshot snapshotObjectId revId snapshotContent
+
+    return revId
+
+
+
+isCheckpointPatch :: Patch -> Bool
+isCheckpointPatch Patch{..} = case patchOperation of
+    Set{..} -> opPath == rootPath
+    _       -> False
+
+
+-- This function is rather inefficient when the object has many patches,
+-- because it fetches *all* patches to the client and does the search in
+-- Haskell. A more efficient version would filter the patches on the server.
+latestCheckpointPatch :: ObjectId -> Avers (Maybe Patch)
+latestCheckpointPatch objId = do
+    patches <- objectPatches objId
+    return $ find isCheckpointPatch (reverse patches)
+
+
+
+-- | Drop all patches and snapshots before the most recent checkpoint. This
+-- effectively drops the object's history, and frees space in the database.
+vacuumObject :: ObjectId -> Avers ()
+vacuumObject objId = do
+    mbPatch <- latestCheckpointPatch objId
+    case mbPatch of
+        Nothing -> return ()
+        Just Patch{..} -> do
+            -- This is the revision up to which we can drop snapshots and
+            -- patches.
+            let revId = unRevId patchRevisionId - 1
+
+            -- Delete all snapshots and patches before the checkpoint.
+            void $ runQuery $ R.Delete $
+                objectSnapshotSequenceE objId 0 revId
+            void $ runQuery $ R.Delete $
+                objectPatchSequenceE objId 0 revId
+
+
+
 -----------------------------------------------------------------------------
 -- | Fetch the content of the object and try to parse it.
 --
@@ -217,8 +255,22 @@
         M.insertWith max objId revId
 
 
+-- | Lookup the latest snapshot within the given range. The bounds are
+-- inclusive.
+latestSnapshotBetween :: ObjectId -> Int -> Int -> Avers Snapshot
+latestSnapshotBetween objId lo hi = do
+    snapshots <- runQueryCollect $ limitE 1 $
+        R.OrderByIndexed (R.Descending "objectSnapshotSequence") $
+        objectSnapshotSequenceE objId lo hi
 
+    snapshot <- case V.headM snapshots of
+        Just x  -> parseDatum x
+        Nothing -> return $ initialSnapshot objId
 
+    updateRecentRevision objId (snapshotRevisionId snapshot)
+    return snapshot
+
+
 -----------------------------------------------------------------------------
 -- | Get the newest snapshot which is stored in the database. The object may
 -- be at a higher revision if the later snapshots are missing from the
@@ -230,40 +282,23 @@
 newestSnapshot :: ObjectId -> Avers Snapshot
 newestSnapshot objId = measureDuration M_avers_storage_newestSnapshot_duration $ do
     (RevId revId) <- fromMaybe zeroRevId <$> lookupRecentRevision objId
-    snapshot <- runQueryDatum $ headE $
-        R.OrderByIndexed (R.Descending "objectSnapshotSequence") $
-        R.BetweenIndexed "objectSnapshotSequence" ((lowerBound revId), upperBound) $
-        snapshotsTable
-
-    updateRecentRevision objId (snapshotRevisionId snapshot)
-    return snapshot
-
-  where
-    lowerBound revId = R.Closed $ R.Array $ V.fromList [R.String $ toPk objId, R.Number $ fromIntegral revId]
-    upperBound = R.Open $ R.Array $ V.fromList [R.String $ toPk objId, R.Number $ fromIntegral (99999999 :: Int)]
-
+    latestSnapshotBetween objId revId maxBound
 
 
+-- | Lookup the snapshot at a particular revision.
 lookupSnapshot :: ObjectId -> RevId -> Avers Snapshot
 lookupSnapshot objId (RevId revId) = measureDuration M_avers_storage_lookupSnapshot_duration $ do
-    snapshot <- runQueryDatum $ headE $
-        R.OrderByIndexed (R.Descending "objectSnapshotSequence") $
-        R.BetweenIndexed "objectSnapshotSequence" (lowerBound, upperBound) $
-        snapshotsTable
+    snapshot <- latestSnapshotBetween objId 0 revId
 
     -- Get all patches which we need to apply on top of the snapshot to
     -- arrive at the desired revision.
-    patches0 <- patchesAfterRevision objId (snapshotRevisionId snapshot)
-    let patches = filter (\Patch{..} -> patchRevisionId <= RevId revId) patches0
+    patches <- patchesAfterRevision objId (snapshotRevisionId snapshot)
 
+    -- Apply those patches to the snapshot.
     foldM applyPatchToSnapshot snapshot patches
 
-  where
-    lowerBound = R.Closed $ R.Array $ V.fromList [R.String $ toPk objId, R.Number 0]
-    upperBound = R.Closed $ R.Array $ V.fromList [R.String $ toPk objId, R.Number $ fromIntegral revId]
 
 
-
 savePatch :: Patch -> Avers ()
 savePatch = insertDocument patchesTable
 
@@ -316,20 +351,17 @@
    upsertDocument secretsTable $ Secret secId $ T.decodeUtf8 x
 
 
+objectPatches :: ObjectId -> Avers [Patch]
+objectPatches objId = patchesAfterRevision objId (RevId (-1))
 
 
 patchesAfterRevision :: ObjectId -> RevId -> Avers [Patch]
 patchesAfterRevision objId (RevId revId) = measureDuration M_avers_storage_patchesAfterRevision_duration $ do
-    res <- runQuery $
+    res <- runQueryCollect $
         R.OrderBy [R.Ascending "revisionId"] $
-        R.BetweenIndexed "objectPatchSequence" (lowerBound, upperBound) $
-        patchesTable
+        objectPatchSequenceE objId revId maxBound
 
     V.toList <$> V.mapM parseDatum res
-
-  where
-    lowerBound = R.Open $ R.Array $ V.fromList [R.String $ toPk objId, R.Number $ fromIntegral revId]
-    upperBound = R.Open $ R.Array $ V.fromList [R.String $ toPk objId, R.Number $ fromIntegral (revId + 999999)]
 
 
 lookupPatch :: ObjectId -> RevId -> Avers Patch
diff --git a/src/Avers/Storage/Expressions.hs b/src/Avers/Storage/Expressions.hs
--- a/src/Avers/Storage/Expressions.hs
+++ b/src/Avers/Storage/Expressions.hs
@@ -14,12 +14,27 @@
 module Avers.Storage.Expressions where
 
 
-import           Prelude hiding (lookup)
+import qualified Data.Vector        as V
 
 import           Data.Text (Text)
 import           Database.RethinkDB as R
 
+import           Avers.Types hiding (Object)
 
+import           Prelude hiding (lookup)
+
+
+
+-- All the tables which this storage engine uses.
+objectsTable, sessionsTable, snapshotsTable, patchesTable, secretsTable, blobsTable :: Exp Table
+blobsTable     = Table Nothing $ lift ("blobs" :: Text)
+objectsTable   = Table Nothing $ lift ("objects" :: Text)
+patchesTable   = Table Nothing $ lift ("patches" :: Text)
+secretsTable   = Table Nothing $ lift ("secrets" :: Text)
+sessionsTable  = Table Nothing $ lift ("sessions" :: Text)
+snapshotsTable = Table Nothing $ lift ("snapshots" :: Text)
+
+
 -- | The primary key in all our documents is the default "id".
 primaryKeyField :: Text
 primaryKeyField = "id"
@@ -47,6 +62,32 @@
 primaryKeyEqE = objectFieldEqE primaryKeyField
 
 
--- | Take the first item out of a sequence.
+-- | Take the first item out of a sequence. Beware that this throws an error
+-- when the sequence is empty.
 headE :: (IsSequence a, IsDatum r) => Exp a -> Exp r
 headE = Nth 0
+
+
+-- | Limit a sequence to the first 'n' items.
+limitE :: (IsSequence s) => Int -> Exp s -> Exp s
+limitE n s = Limit (fromIntegral n) s
+
+
+mkBounds :: ObjectId -> Int -> Int -> (Bound, Bound)
+mkBounds objId lo hi = (mkBound objId lo, mkBound objId hi)
+
+mkBound :: ObjectId -> Int -> Bound
+mkBound objId revId = Closed $ Array $ V.fromList
+    [String $ toPk objId, Number $ fromIntegral revId]
+
+
+objectSnapshotSequenceE :: ObjectId -> Int -> Int -> Exp Table
+objectSnapshotSequenceE objId lo hi =
+    BetweenIndexed "objectSnapshotSequence" (mkBounds objId lo hi) $
+    snapshotsTable
+
+
+objectPatchSequenceE :: ObjectId -> Int -> Int -> Exp Table
+objectPatchSequenceE objId lo hi =
+    BetweenIndexed "objectPatchSequence" (mkBounds objId lo hi) $
+    patchesTable
diff --git a/src/Avers/Types.hs b/src/Avers/Types.hs
--- a/src/Avers/Types.hs
+++ b/src/Avers/Types.hs
@@ -86,7 +86,13 @@
     toDatum = R.toDatum . unPath
 
 
+-- | This path refers to the root of an object. It is only used in 'Set'
+-- operations.
+rootPath :: Path
+rootPath = Path ""
 
+
+
 -----------------------------------------------------------------------------
 -- | ObjId
 
@@ -302,7 +308,12 @@
 $(deriveEncoding (deriveJSONOptions "snapshot") ''Snapshot)
 
 
+-- | The initial snapshot on top of which all future patches are applied.
+initialSnapshot :: ObjectId -> Snapshot
+initialSnapshot objId = Snapshot objId (RevId (-1)) Aeson.emptyObject
 
+
+
 -----------------------------------------------------------------------------
 -- | Release
 
@@ -534,7 +545,9 @@
 databasePort :: Config -> Int
 databasePort Config{..} = fromMaybe R.defaultPort $ do
     auth <- uriAuthority databaseURI
-    readMay $ uriPort auth
+    case uriPort auth of
+        []  -> Nothing
+        _:x -> readMay x
 
 databaseAuth :: Config -> Maybe Text
 databaseAuth Config{..} = do
@@ -575,6 +588,7 @@
         putStrLn $ mconcat
             [ "Creating a new RethinkDB handle to "
             , T.unpack host
+            , ":"
             , show port
             , " database "
             , T.unpack db
diff --git a/test/Test.hs b/test/Test.hs
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -75,6 +75,9 @@
                 applyOperation obj (Splice "array" 0 1 ["elem"]) `shouldSatisfy` isFailure
 
         describe "Set" $ do
+            it "should replace the whole object if path is the root" $ do
+                let (Right a) = applyOperation emptyObject $ Set "" (Just objA)
+                a `shouldBe` objA
             it "should create a new key if the key doesn't exist yet" $ do
                 let (Right a) = applyOperation emptyObject $ Set "foo" (Just Null)
                 resolvePathIn "foo" a `shouldBe` Just Null