Skip to content

Commit

Permalink
Improve delay shrinking (#1196)
Browse files Browse the repository at this point in the history
  • Loading branch information
arcz authored Mar 4, 2024
1 parent 09a3c98 commit 2dc9328
Showing 1 changed file with 15 additions and 12 deletions.
27 changes: 15 additions & 12 deletions lib/Echidna/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -123,26 +123,29 @@ removeCallTx t = Tx NoCall t.src t.dst 0 0 0 t.delay
-- | Given a 'Transaction', generate a random \"smaller\" 'Transaction', preserving origin,
-- destination, value, and call signature.
shrinkTx :: MonadRandom m => Tx -> m Tx
shrinkTx tx' =
shrinkTx tx =
let
shrinkCall = case tx'.call of
shrinkCall = case tx.call of
SolCall sc -> SolCall <$> shrinkAbiCall sc
_ -> pure tx'.call
_ -> pure tx.call
lower 0 = pure 0
lower x = (getRandomR (0 :: Integer, fromIntegral x)
>>= (\r -> uniform [0, r]) . fromIntegral) -- try 0 quicker
possibilities =
[ do call' <- shrinkCall
pure tx' { call = call' }
, do value' <- lower tx'.value
pure tx' { Echidna.Types.Tx.value = value' }
, do gasprice' <- lower tx'.gasprice
pure tx' { Echidna.Types.Tx.gasprice = gasprice' }
, do let (time, blocks) = tx'.delay
delay' <- level <$> ((,) <$> lower time <*> lower blocks)
pure tx' { delay = delay' }
pure tx { call = call' }
, do value' <- lower tx.value
pure tx { Echidna.Types.Tx.value = value' }
, do gasprice' <- lower tx.gasprice
pure tx { Echidna.Types.Tx.gasprice = gasprice' }
, do let (time, blocks) = tx.delay
delay' <- join $ uniform [ (time,) <$> lower blocks
, (,blocks) <$> lower time
, (,) <$> lower time <*> lower blocks
]
pure tx { delay = level delay' }
]
in join $ usuallyRarely (join (uniform possibilities)) (pure $ removeCallTx tx')
in join $ usuallyRarely (join (uniform possibilities)) (pure $ removeCallTx tx)

mutateTx :: (MonadRandom m) => Tx -> m Tx
mutateTx tx@Tx{call = SolCall c} = do
Expand Down

0 comments on commit 2dc9328

Please sign in to comment.