From cf0039e010e0d7292eff817654e15631349d7429 Mon Sep 17 00:00:00 2001
From: Artur Cygan <arczicygan@gmail.com>
Date: Sun, 6 Oct 2019 23:58:14 +0200
Subject: [PATCH] Improve transaction shrinking

---
 lib/Echidna/Transaction.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/lib/Echidna/Transaction.hs b/lib/Echidna/Transaction.hs
index 47b129e3..d1a2a417 100644
--- a/lib/Echidna/Transaction.hs
+++ b/lib/Echidna/Transaction.hs
@@ -14,7 +14,7 @@ import Prelude hiding (Word)
 import Control.Lens
 import Control.Monad (join, liftM2, liftM3, liftM5)
 import Control.Monad.Catch (MonadThrow)
-import Control.Monad.Random.Strict (MonadRandom, getRandomR)
+import Control.Monad.Random.Strict (MonadRandom, getRandomR, uniform)
 import Control.Monad.Reader.Class (MonadReader)
 import Control.Monad.State.Strict (MonadState, State, evalStateT, runState)
 import Data.Aeson (ToJSON(..), object)
@@ -22,7 +22,7 @@ import Data.ByteString (ByteString)
 import Data.Either (either)
 import Data.Has (Has(..))
 import Data.List (intercalate)
-import EVM
+import EVM hiding (_value)
 import EVM.ABI (abiCalldata, abiValueType)
 import EVM.Concrete (Word(..), w256)
 import EVM.Types (Addr)
@@ -129,10 +129,15 @@ canShrinkTx _                                = True
 -- | Given a 'Transaction', generate a random \"smaller\" 'Transaction', preserving origin,
 -- destination, value, and call signature.
 shrinkTx :: MonadRandom m => Tx -> m Tx
-shrinkTx (Tx c s d g gp (C _ v) (C _ t, C _ b)) = let
+shrinkTx tx'@(Tx c _ _ _ gp (C _ v) (C _ t, C _ b)) = let
   c' = either (fmap Left . shrinkAbiCall) (fmap Right . pure) c
   lower x = w256 . fromIntegral <$> getRandomR (0 :: Integer, fromIntegral x) in
-    liftM5 Tx c' (pure s) (pure d) (pure g) (lower gp) <*> lower v <*> fmap level (liftM2 (,) (lower t) (lower b))
+  sequence
+    [ (\x -> pure $ tx' { _call  = x }) =<< c'
+    , (\x -> pure $ tx' { _value = x }) =<< lower v
+    , (\x -> pure $ tx' { _gasprice' = x }) =<< lower gp
+    , (\x -> pure $ tx' { _delay = x }) =<< fmap level (liftM2 (,) (lower t) (lower b))
+    ] >>= uniform
 
 -- | Lift an action in the context of a component of some 'MonadState' to an action in the
 -- 'MonadState' itself.