|
1 | 1 | module Echidna.ABI where |
2 | 2 |
|
3 | 3 | import Control.Monad (liftM2, liftM3, foldM, replicateM) |
4 | | -import Control.Monad.Random.Strict (MonadRandom, join, getRandom, getRandoms, getRandomR) |
| 4 | +import Control.Monad.Random.Strict (MonadRandom, join, getRandom, getRandoms, getRandomR, uniform, fromList) |
5 | 5 | import Control.Monad.Random.Strict qualified as Random |
6 | 6 | import Data.Binary.Put (runPut, putWord32be) |
7 | 7 | import Data.BinaryWord (unsignedWord) |
@@ -274,7 +274,30 @@ shrinkAbiValue = \case |
274 | 274 |
|
275 | 275 | -- | Given a 'SolCall', generate a random \"smaller\" (simpler) call. |
276 | 276 | shrinkAbiCall :: MonadRandom m => SolCall -> m SolCall |
277 | | -shrinkAbiCall = traverse $ traverse shrinkAbiValue |
| 277 | +shrinkAbiCall (name, vals) = do |
| 278 | + let numShrinkable = length $ filter canShrinkAbiValue vals |
| 279 | + |
| 280 | + halfwayVal <- getRandomR (0, numShrinkable) |
| 281 | + -- This list was made arbitrarily. Feel free to change |
| 282 | + let numToShrinkOptions = [1, 2, halfwayVal, numShrinkable] |
| 283 | + |
| 284 | + numToShrink <- min numShrinkable <$> uniform numToShrinkOptions |
| 285 | + shrunkVals <- shrinkVals (fromIntegral numShrinkable) (fromIntegral numToShrink) vals |
| 286 | + pure (name, shrunkVals) |
| 287 | + where |
| 288 | + shrinkVals _ 0 l = pure l |
| 289 | + shrinkVals _ _ [] = pure [] |
| 290 | + shrinkVals numShrinkable numToShrink (h:t) |
| 291 | + | not (canShrinkAbiValue h) = (h:) <$> shrinkVals numShrinkable numToShrink t |
| 292 | + | otherwise = do |
| 293 | + -- We want to pick which ones to shrink uniformly from the vals list. |
| 294 | + -- Odds of shrinking one element is numToShrink/numShrinkable. |
| 295 | + shouldShrink <- fromList [(True, numToShrink), (False, numShrinkable-numToShrink)] |
| 296 | + h' <- if shouldShrink then shrinkAbiValue h else pure h |
| 297 | + let |
| 298 | + numShrinkable' = numShrinkable-1 |
| 299 | + numToShrink' = if shouldShrink then numToShrink-1 else numToShrink |
| 300 | + (h':) <$> shrinkVals numShrinkable' numToShrink' t |
278 | 301 |
|
279 | 302 | -- | Given an 'AbiValue', generate a random \"similar\" value of the same 'AbiType'. |
280 | 303 | mutateAbiValue :: MonadRandom m => AbiValue -> m AbiValue |
|
0 commit comments