diff --git a/configure.ac b/configure.ac
index 5beefdc13e13f3d926b3e034605eacd0a4244bc8..a10146133c921c50306e60d28935d3c4f9c7455a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -376,8 +376,8 @@ else
   AC_MSG_CHECKING([network])
   GHC_PKG_NETWORK=$($GHC_PKG latest network)
   AC_MSG_RESULT($GHC_PKG_NETWORK)
-  AC_MSG_CHECKING([QuickCheck 1.x])
-  GHC_PKG_QUICKCHECK=$($GHC_PKG --simple-output list 'QuickCheck-1.*')
+  AC_MSG_CHECKING([QuickCheck 2.x])
+  GHC_PKG_QUICKCHECK=$($GHC_PKG --simple-output list 'QuickCheck-2.*')
   AC_MSG_RESULT($GHC_PKG_QUICKCHECK)
   if test -z "$GHC_PKG_PARALLEL" || test -z "$GHC_PKG_JSON" || \
      test -z "$GHC_PKG_NETWORK"; then
@@ -390,7 +390,7 @@ else
     HTOOLS_MODULES="-package $GHC_PKG_PARALLEL"
   fi
   if test -z "$GHC_PKG_QUICKCHECK"; then
-     AC_MSG_WARN(m4_normalize([The QuickCheck 1.x module was not found,
+     AC_MSG_WARN(m4_normalize([The QuickCheck 2.x module was not found,
                                you won't be able to run Haskell unittests]))
   fi
 fi
diff --git a/doc/devnotes.rst b/doc/devnotes.rst
index ae36c60e5a562f3ce5f98959c2baa4108732c0e1..1e708d35e4e91331138ff28370b89324d35032de 100644
--- a/doc/devnotes.rst
+++ b/doc/devnotes.rst
@@ -37,7 +37,7 @@ document, plus:
 - `hlint <http://community.haskell.org/~ndm/hlint/>`_, a source code
   linter (equivalent to pylint for Python)
 - the `QuickCheck <http://hackage.haskell.org/package/QuickCheck>`_
-  library, version 1.x
+  library, version 2.x
 - ``hpc``, which comes with the compiler, so you should already have
   it
 
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index a2ed78bb48befb334299301c62a572111abbc677..e2b0e84769a54a27beffac95edaa63054190ff07 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -37,7 +37,6 @@ module Ganeti.HTools.QC
     ) where
 
 import Test.QuickCheck
-import Test.QuickCheck.Batch
 import Data.List (findIndex, intercalate, nub, isPrefixOf)
 import Data.Maybe
 import Control.Monad
@@ -66,6 +65,9 @@ import qualified Ganeti.HTools.Utils as Utils
 import qualified Ganeti.HTools.Version
 import qualified Ganeti.Constants as C
 
+run :: Testable prop => prop -> Args -> IO Result
+run = flip quickCheckWithResult
+
 -- * Constants
 
 -- | Maximum memory (1TiB, somewhat random value)
@@ -147,10 +149,6 @@ assignInstance nl il inst pdx sdx =
 
 -- * Arbitrary instances
 
--- copied from the introduction to quickcheck
-instance Arbitrary Char where
-    arbitrary = choose ('\32', '\128')
-
 newtype DNSChar = DNSChar { dnsGetChar::Char }
 instance Arbitrary DNSChar where
     arbitrary = do
@@ -500,8 +498,8 @@ prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx autobal =
 prop_Text_Load_InstanceFail ktn fields =
     length fields /= 9 ==>
     case Text.loadInst nl fields of
-      Right _ -> False
-      Left msg -> isPrefixOf "Invalid/incomplete instance data: '" msg
+      Types.Ok _ -> False
+      Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg
     where nl = Data.Map.fromList ktn
 
 prop_Text_Load_Node name tm nm fm td fd tc fo =
@@ -703,7 +701,8 @@ testNode =
 -- Cluster tests
 
 -- | Check that the cluster score is close to zero for a homogeneous cluster
-prop_Score_Zero node count =
+prop_Score_Zero node =
+    forAll (choose (1, 1024)) $ \count ->
     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
      (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
     let fn = Node.buildPeers node Container.empty
@@ -712,11 +711,12 @@ prop_Score_Zero node count =
         score = Cluster.compCV nl
     -- we can't say == 0 here as the floating point errors accumulate;
     -- this should be much lower than the default score in CLI.hs
-    in score <= 1e-15
+    in score <= 1e-12
 
 -- | Check that cluster stats are sane
-prop_CStats_sane node count =
-    (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
+prop_CStats_sane node =
+    forAll (choose (1, 1024)) $ \count ->
+    (not (Node.offline node) && not (Node.failN1 node) &&
      (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
     let fn = Node.buildPeers node Container.empty
         nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
diff --git a/htools/test.hs b/htools/test.hs
index 12aa50da52995cbcee49d333a85717e45e74cdec..d0708ee27c2284b4891b94fff8932ea743a56061 100644
--- a/htools/test.hs
+++ b/htools/test.hs
@@ -4,7 +4,7 @@
 
 {-
 
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2011 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -26,43 +26,68 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 module Main(main) where
 
 import Data.IORef
-import Test.QuickCheck.Batch
+import Test.QuickCheck
 import System.IO
 import System.Exit
 import System (getArgs)
+import Text.Printf
 
 import Ganeti.HTools.QC
 
-fast :: TestOptions
-fast = TestOptions
-              { no_of_tests         = 500
-              , length_of_tests     = 10
-              , debug_tests         = False }
+fast :: Args
+fast = stdArgs
+       { maxSuccess = 500
+       , chatty     = False
+       }
 
-slow :: TestOptions
-slow = TestOptions
-              { no_of_tests         = 50
-              , length_of_tests     = 100
-              , debug_tests         = False }
+slow :: Args
+slow = stdArgs
+       { maxSuccess = 50
+       , chatty     = False
+       }
 
 incIORef :: IORef Int -> IO ()
 incIORef ir = atomicModifyIORef ir (\x -> (x + 1, ()))
 
 -- | Wrapper over a test runner with error counting
 wrapTest :: IORef Int
-         -> (TestOptions -> IO TestResult)
-         -> TestOptions -> IO TestResult
-wrapTest ir t to = do
-    tr <- t to
-    case tr of
-      TestFailed _ _ -> incIORef ir
-      TestAborted e -> do
-        incIORef ir
-        putStrLn ("Failure during test: <" ++ show e ++ ">")
-      _ -> return ()
-    return tr
-
-allTests :: [(String, TestOptions, [TestOptions -> IO TestResult])]
+         -> (Args -> IO Result)
+         -> Args
+         -> IO (Result, Char)
+wrapTest ir test opts = do
+  r <- test opts
+  c <- case r of
+         Success {} -> return '.'
+         GaveUp  {} -> return '?'
+         Failure {} -> incIORef ir >> return '#'
+         NoExpectedFailure {} -> incIORef ir >> return '*'
+  return (r, c)
+
+runTests name opts tests max_count = do
+  _ <- printf "%25s : " name
+  hFlush stdout
+  results <- mapM (\t -> do
+                     (r, c) <- t opts
+                     putChar c
+                     hFlush stdout
+                     return r
+                  ) tests
+  let alldone = sum . map numTests $ results
+  _ <- printf "%*s(%d)\n" (max_count - length tests + 1) " " alldone
+  mapM_ (\(idx, r) ->
+             case r of
+               Failure { output = o, usedSeed = u, usedSize = size } ->
+                   printf "Test %d failed (seed was %s, test size %d): %s\n"
+                          idx (show u) size o
+               GaveUp { numTests = passed } ->
+                   printf "Test %d incomplete: gave up with only %d\
+                          \ passes after discarding %d tests\n"
+                          idx passed (maxDiscard opts)
+               _ -> return ()
+        ) $ zip ([1..]::[Int]) results
+  return results
+
+allTests :: [(String, Args, [Args -> IO Result])]
 allTests =
   [ ("Utils", fast, testUtils)
   , ("PeerMap", fast, testPeerMap)
@@ -84,7 +109,8 @@ main = do
   let tests = if null args
               then allTests
               else filter (\(name, _, _) -> name `elem` args) allTests
-  mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl)) tests
+      max_count = maximum $ map (\(_, _, t) -> length t) tests
+  mapM_ (\(name, opts, tl) -> runTests name opts (wrap tl) max_count) tests
   terr <- readIORef errs
   (if terr > 0
    then do