Fix crash when minimizing inputs during optimization tests (#837)

* fix crash when minimizing inputs during optimization tests

* better reporting of optimization properties

* hlint fix

* correctly show list of transactions in optimization mode

lib/Echidna/Campaign.hs

@@ -100,12 +100,13 @@ updateTest _ vm Nothing test = do
       res = test ^. testResult
       x = test ^. testReproducer
       v = test ^. testValue
+      t = test ^. testType
   case test ^. testState of
     Large i | i >= sl -> pure $ test { _testState =  Solved, _testReproducer = x }
     Large i           -> if length x > 1 || any canShrinkTx x
                              then do (txs, val, evs, r) <- evalStateT (shrinkSeq (checkETest test) (v, es, res) x) vm
                                      pure $ test { _testState = Large (i + 1), _testReproducer = txs, _testEvents = evs, _testResult = r, _testValue = val}
-                             else pure $ test { _testState = Solved, _testReproducer = x}
+                             else pure $ test { _testState = if isOptimizationTest t then Large (i + 1) else Solved, _testReproducer = x}
     _                   -> pure test
 
 

lib/Echidna/Types/Test.hs

@@ -83,6 +83,10 @@ data EchidnaTest = EchidnaTest {
 
 makeLenses ''EchidnaTest
 
+isOptimizationTest :: TestType -> Bool
+isOptimizationTest (OptimizationTest _ _) = True
+isOptimizationTest _                      = False
+
 isOpen :: EchidnaTest -> Bool
 isOpen t = case t ^. testState of
             Open _ -> True

lib/Echidna/UI/Report.hs

@@ -90,19 +90,41 @@ ppTS Passed     _ _  = pure " passed! 🎉"
 ppTS (Open i)   es [] = do
   t <- view (hasLens .  testLimit)
   if i >= t then ppTS Passed es [] else pure $ " fuzzing " ++ progress i t
-ppTS (Open _)   es r = ppFail Nothing es r -- Only reachable with optimization
+ppTS (Open _)   es r = ppFail Nothing es r
 ppTS (Large n) es l  = do
   m <- view (hasLens . shrinkLimit)
   ppFail (if n < m then Just (n, m) else Nothing) es l
 
+
+ppOPT :: (MonadReader x m, Has CampaignConf x, Has Names x, Has TxConf x) => TestState -> Events -> [Tx] -> m String
+ppOPT (Failed e) _ _  = pure $ "could not evaluate ☣\n  " ++ show e
+ppOPT Solved     es l = ppOptimized Nothing es l
+ppOPT Passed     _ _  = pure " passed! 🎉"
+ppOPT (Open _)   es r = ppOptimized Nothing es r 
+ppOPT (Large n) es l  = do
+  m <- view (hasLens . shrinkLimit)
+  ppOptimized (if n < m then Just (n, m) else Nothing) es l
+
+
+-- | Pretty-print the status of a optimized test.
+ppOptimized :: (MonadReader x m, Has Names x, Has TxConf x) => Maybe (Int, Int) -> Events -> [Tx] -> m String
+ppOptimized _ _ []  = pure "Call sequence:\n(no transactions)"
+ppOptimized b es xs = let status = case b of
+                                Nothing    -> ""
+                                Just (n,m) -> ", shrinking " ++ progress n m
+                          pxs = mapM (ppTx $ length (nub $ view src <$> xs) /= 1) xs in
+ do s <- (("\n  Call sequence" ++ status ++ ":\n") ++) . unlines . fmap ("    " ++) <$> pxs
+    return (s ++ "\n" ++ ppEvents es)
+
+
 -- | Pretty-print the status of all 'SolTest's in a 'Campaign'.
 ppTests :: (MonadReader x m, Has CampaignConf x, Has Names x, Has TxConf x) => Campaign -> m String
 ppTests Campaign { _tests = ts } = unlines . catMaybes <$> mapM pp ts where
   pp t = case t ^. testType of
          PropertyTest n _      ->  Just . ((T.unpack n ++ ": ") ++) <$> ppTS (t ^. testState) (t ^. testEvents) (t ^. testReproducer)
          CallTest n _          ->  Just . ((T.unpack n ++ ": ") ++) <$> ppTS (t ^. testState) (t ^. testEvents) (t ^. testReproducer)
          AssertionTest _ s _   ->  Just . ((T.unpack (encodeSig s) ++ ": ") ++) <$> ppTS (t ^. testState) (t ^. testEvents) (t ^. testReproducer)
-         OptimizationTest n _  ->  Just . ((T.unpack n ++ ": max value: " ++ show (t ^. testValue)) ++) <$> ppTS (t ^. testState) (t ^. testEvents) (t ^. testReproducer)
+         OptimizationTest n _  ->  Just . ((T.unpack n ++ ": max value: " ++ show (t ^. testValue) ++ "\n") ++) <$> ppOPT (t ^. testState) (t ^. testEvents) (t ^. testReproducer)
          Exploration           ->  return Nothing
 
 ppCampaign :: (MonadReader x m, Has CampaignConf x, Has Names x, Has TxConf x) => Campaign -> m String