TheDude
/
echidna
mirror of https://github.com/crytic/echidna
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

add some ABIv2 types

Browse Source
pull/284/head
Will Song 5 years ago
parent b2604fc0aa
commit 1205c60668
2 changed files with 292 additions and 1 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 202
      lib/Echidna/ABI.hs
  2. 91
      lib/Echidna/Transaction.hs

202
lib/Echidna/ABI.hs
Unescape View File

@ -1,4 +1,5 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
@ -15,6 +16,7 @@ import Control.Monad.Random.Strict
import Data.Bits (Bits(..))
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.DoubleWord (Word256, Int256, Word160)
import Data.Foldable (toList)
import Data.Has (Has(..))
import Data.Hashable (Hashable)
@ -24,6 +26,7 @@ import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.Text (Text)
import Data.Vector (Vector)
import Data.Word8 (Word8)
import GHC.Generics (Generic)
import EVM.ABI (AbiType(..), AbiValue(..), abiTypeSolidity, abiValueType)
import Numeric (showHex)
@ -32,6 +35,69 @@ import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified Data.Vector as V
-- types for EVM ABIv2
data AbiValue2 = AbiUInt2 Int Word256
| AbiInt2 Int Int256
| AbiAddress2 Word160
| AbiBool2 Bool
| AbiBytes2 Int BS.ByteString
| AbiBytesDynamic2 BS.ByteString
| AbiString2 BS.ByteString
| AbiArrayDynamic2 AbiType2 (Vector AbiValue2)
| AbiArray2 Int AbiType2 (Vector AbiValue2)
| AbiTuple2 [AbiValue2]
deriving (Show, Read, Eq, Ord, Generic)
data AbiType2 = AbiUIntType2 Int
| AbiIntType2 Int
| AbiAddressType2
| AbiBoolType2
| AbiBytesType2 Int
| AbiBytesDynamicType2
| AbiStringType2
| AbiArrayDynamicType2 AbiType2
| AbiArrayType2 Int AbiType2
| AbiTupleType2 [AbiType2]
deriving (Show, Read, Eq, Ord, Generic)
abiValueType2 :: AbiValue2 -> AbiType2
abiValueType2 = \case
AbiUInt2 n _ -> AbiUIntType2 n
AbiInt2 n _ -> AbiIntType2 n
AbiAddress2 _ -> AbiAddressType2
AbiBool2 _ -> AbiBoolType2
AbiBytes2 n _ -> AbiBytesType2 n
AbiBytesDynamic2 _ -> AbiBytesDynamicType2
AbiString2 _ -> AbiStringType2
AbiArrayDynamic2 t _ -> AbiArrayDynamicType2 t
AbiArray2 n t _ -> AbiArrayType2 n t
AbiTuple2 v -> AbiTupleType2 (abiValueType2 <$> v)
abiTypeSolidity2 :: AbiType2 -> Text
abiTypeSolidity2 = \case
AbiUIntType2 n -> "uint" <> T.pack (show n)
AbiIntType2 n -> "int" <> T.pack (show n)
AbiAddressType2 -> "address"
AbiBoolType2 -> "bool"
AbiBytesType2 n -> "bytes" <> T.pack (show n)
AbiBytesDynamicType2 -> "bytes"
AbiStringType2 -> "string"
AbiArrayDynamicType2 t -> abiTypeSolidity2 t <> "[]"
AbiArrayType2 n t -> abiTypeSolidity2 t <> "[" <> T.pack (show n) <> "]"
AbiTupleType2 v -> "(" <> (T.intercalate "," $ abiTypeSolidity2 <$> v) <> ")"
data AbiKind = Dynamic | Static
deriving (Show, Read, Eq, Ord)
abiKind2 :: AbiType2 -> AbiKind
abiKind2 = \case
AbiBytesDynamicType2 -> Dynamic
AbiStringType2 -> Dynamic
AbiArrayDynamicType2 _ -> Dynamic
AbiArrayType2 _ t -> abiKind2 t
AbiTupleType2 v -> if any (==Dynamic) (abiKind2 <$> v) then Dynamic else Static
_ -> Static
-- | Pretty-print some 'AbiValue'.
ppAbiValue :: AbiValue -> String
ppAbiValue (AbiUInt _ n) = show n
@ -46,6 +112,21 @@ ppAbiValue (AbiArrayDynamic _ v) =
ppAbiValue (AbiArray _ _ v) =
"[" ++ intercalate ", " (ppAbiValue <$> toList v) ++ "]"
ppAbiValue2 :: AbiValue2 -> String
ppAbiValue2 (AbiUInt2 _ n) = show n
ppAbiValue2 (AbiInt2 _ n) = show n
ppAbiValue2 (AbiAddress2 n) = showHex n ""
ppAbiValue2 (AbiBool2 b) = if b then "true" else "false"
ppAbiValue2 (AbiBytes2 _ b) = show b
ppAbiValue2 (AbiBytesDynamic2 b) = show b
ppAbiValue2 (AbiString2 s) = show s
ppAbiValue2 (AbiArrayDynamic2 _ v) =
"[" ++ intercalate ", " (ppAbiValue2 <$> toList v) ++ "]"
ppAbiValue2 (AbiArray2 _ _ v) =
"[" ++ intercalate ", " (ppAbiValue2 <$> toList v) ++ "]"
ppAbiValue2 (AbiTuple2 v) =
"(" ++ intercalate ", " (ppAbiValue2 <$> toList v) ++ ")"
-- Safe random element of a list
-- | Thrown when trying to pick a random element of an empty list. The 'String' describes the list.
@ -68,21 +149,25 @@ rElem _ l = (l !!) <$> getRandomR (0, length l - 1)
-- | Represents a call to a Solidity function.
-- A tuple of 'Text' for the name of the function, and then any 'AbiValue' arguments passed (as a list).
type SolCall = (Text, [AbiValue])
type SolCall2 = (Text, [AbiValue2])
-- | Represents the type of a Solidity function.
-- A tuple of 'Text' for the name of the function, and then the 'AbiType's of any arguments it expects.
type SolSignature = (Text, [AbiType])
type SolSignature2 = (Text, [AbiType2])
-- | Get the text signature of a solidity method (for later hashing)
encodeSig :: SolSignature -> Text
encodeSig (n, ts) = n <> "(" <> T.intercalate "," (abiTypeSolidity <$> ts) <> ")"
encodeSig2 :: SolSignature2 -> Text
encodeSig2 (n, ts) = n <> "(" <> T.intercalate "," (abiTypeSolidity2 <$> ts) <> ")"
-- | Configuration necessary for generating new 'SolCalls'. Don't construct this by hand! Use 'mkConf'.
data GenDict = GenDict { _pSynthA :: Float
-- ^ Fraction of time to use dictionary vs. synthesize
, _constants :: HashMap AbiType [AbiValue]
-- ^ Constants to use, sorted by type
, _wholeCalls :: HashMap SolSignature [SolCall]
, _wholeCalls :: HashMap SolSignature [SolCall]
-- ^ Whole calls to use, sorted by type
, _defSeed :: Int
-- ^ Default seed to use if one is not provided in EConfig
@ -92,22 +177,46 @@ data GenDict = GenDict { _pSynthA :: Float
makeLenses 'GenDict
data GenDict2 = GenDict2 { _pSynthA2 :: Float
-- ^ Fraction of time to use dictionary vs. synthesize
, _constants2 :: HashMap AbiType2 [AbiValue2]
-- ^ Constants to use, sorted by type
, _wholeCalls2 :: HashMap SolSignature2 [SolCall2]
-- ^ Whole calls to use, sorted by type
, _defSeed2 :: Int
-- ^ Default seed to use if one is not provided in EConfig
, _rTypes2 :: Text -> Maybe AbiType2
-- ^ Return types of any methods we scrape return values from
}
makeLenses 'GenDict2
hashMapBy :: (Hashable k, Eq k, Ord a) => (a -> k) -> [a] -> HashMap k [a]
hashMapBy f = M.fromListWith (++) . mapMaybe (liftM2 fmap (\l x -> (f x, l)) listToMaybe) . group . sort
gaddConstants :: [AbiValue] -> GenDict -> GenDict
gaddConstants l = constants <>~ hashMapBy abiValueType l
gaddConstants2 :: [AbiValue2] -> GenDict2 -> GenDict2
gaddConstants2 l = constants2 <>~ hashMapBy abiValueType2 l
gaddCalls :: [SolCall] -> GenDict -> GenDict
gaddCalls c = wholeCalls <>~ hashMapBy (fmap $ fmap abiValueType) c
gaddCalls2 :: [SolCall2] -> GenDict2 -> GenDict2
gaddCalls2 c = wholeCalls2 <>~ hashMapBy (fmap $ fmap abiValueType2) c
defaultDict :: GenDict
defaultDict = mkGenDict 0 [] [] 0 (const Nothing)
defaultDict2 :: GenDict2
defaultDict2 = mkGenDict2 0 [] [] 0 (const Nothing)
-- This instance is the only way for mkConf to work nicely, and is well-formed.
{-# ANN module ("HLint: ignore Unused LANGUAGE pragma" :: String) #-}
-- We need the above since hlint doesn't notice DeriveAnyClass in StandaloneDeriving.
deriving instance Hashable AbiType
deriving instance Hashable AbiType2
-- | Construct a 'GenDict' from some dictionaries, a 'Float', a default seed, and a typing rule for
-- return values
@ -119,6 +228,14 @@ mkGenDict :: Float -- ^ Percentage of time to mutate instead of synthesize.
-- ^ A return value typing rule
-> GenDict
mkGenDict p vs cs = GenDict p (hashMapBy abiValueType vs) (hashMapBy (fmap $ fmap abiValueType) cs)
mkGenDict2 :: Float -- ^ Percentage of time to mutate instead of synthesize. Should be in [0,1]
-> [AbiValue2] -- ^ A list of 'AbiValue' constants to use during dictionary-based generation
-> [SolCall2] -- ^ A list of complete 'SolCall's to mutate
-> Int -- ^ A default seed
-> (Text -> Maybe AbiType2)
-- ^ A return value typing rule
-> GenDict2
mkGenDict2 p vs cs = GenDict2 p (hashMapBy abiValueType2 vs) (hashMapBy (fmap $ fmap abiValueType2) cs)
-- Generation (synthesis)
@ -131,14 +248,23 @@ getRandomUint n = join $ fromList [(getRandomR (0, 1023), 1), (getRandomR (0, 2
genAbiValue :: MonadRandom m => AbiType -> m AbiValue
genAbiValue = flip evalStateT defaultDict . genAbiValueM
genAbiValue2 :: MonadRandom m => AbiType2 -> m AbiValue2
genAbiValue2 = flip evalStateT defaultDict2 . genAbiValueM2
-- | Synthesize a random 'SolCall' given its 'SolSignature'. Doesn't use a dictionary.
genAbiCall :: MonadRandom m => SolSignature -> m SolCall
genAbiCall = traverse $ traverse genAbiValue
genAbiCall2 :: MonadRandom m => SolSignature2 -> m SolCall2
genAbiCall2 = traverse $ traverse genAbiValue2
-- | Synthesize a random 'SolCall' given a list of 'SolSignature's (effectively, an ABI). Doesn't use a dictionary.
genInteractions :: (MonadThrow m, MonadRandom m) => [SolSignature] -> m SolCall
genInteractions l = genAbiCall =<< rElem "ABI" l
genInteractions2 :: (MonadThrow m, MonadRandom m) => [SolSignature2] -> m SolCall2
genInteractions2 l = genAbiCall2 =<< rElem "ABIv2" l
-- Mutation helper functions
-- | Given an 'Integral' number n, get a random number in [0,2n].
@ -200,6 +326,10 @@ mutateV :: MonadRandom m => AbiType -> Vector AbiValue -> m (Vector AbiValue)
mutateV t v = traverse mutateAbiValue =<< changeSize where
changeSize = bool (shrinkV v) (growWith (genAbiValue t) V.cons V.snoc V.length v) =<< getRandom
mutateV2 :: MonadRandom m => AbiType2 -> Vector AbiValue2 -> m (Vector AbiValue2)
mutateV2 t v = traverse mutateAbiValue2 =<< changeSize where
changeSize = bool (shrinkV v) (growWith (genAbiValue2 t) V.cons V.snoc V.length v) =<< getRandom
-- Mutation
-- | Check if an 'AbiValue' is as \"small\" (trivial) as possible (using ad-hoc heuristics).
@ -214,6 +344,18 @@ canShrinkAbiValue (AbiArray _ _ l) = any canShrinkAbiValue l
canShrinkAbiValue (AbiArrayDynamic _ l) = l /= mempty
canShrinkAbiValue _ = True
canShrinkAbiValue2 :: AbiValue2 -> Bool
canShrinkAbiValue2 (AbiUInt2 _ 0) = False
canShrinkAbiValue2 (AbiInt2 _ 0) = False
canShrinkAbiValue2 (AbiBool2 b) = b
canShrinkAbiValue2 (AbiBytes2 _ b) = BS.any (/= 0) b
canShrinkAbiValue2 (AbiBytesDynamic2 "") = False
canShrinkAbiValue2 (AbiString2 "") = False
canShrinkAbiValue2 (AbiArray2 _ _ l) = any canShrinkAbiValue2 l
canShrinkAbiValue2 (AbiArrayDynamic2 _ l) = l /= mempty
canShrinkAbiValue2 (AbiTuple2 v) = any canShrinkAbiValue2 v
canShrinkAbiValue2 _ = True
bounds :: forall a. (Bounded a, Integral a) => a -> (Integer, Integer)
bounds = const (fromIntegral (0 :: a), fromIntegral (maxBound :: a))
@ -234,10 +376,25 @@ shrinkAbiValue (AbiString b) = fmap AbiString $ addNulls =<< shrinkB
shrinkAbiValue (AbiArray n t l) = AbiArray n t <$> traverse shrinkAbiValue l
shrinkAbiValue (AbiArrayDynamic t l) = fmap (AbiArrayDynamic t) $ traverse shrinkAbiValue =<< shrinkV l
shrinkAbiValue2 :: MonadRandom m => AbiValue2 -> m AbiValue2
shrinkAbiValue2 (AbiUInt2 n m) = AbiUInt2 n <$> shrinkInt m
shrinkAbiValue2 (AbiInt2 n m) = AbiInt2 n <$> shrinkInt m
shrinkAbiValue2 x@AbiAddress2{} = pure x
shrinkAbiValue2 (AbiBool2 _) = pure $ AbiBool2 False
shrinkAbiValue2 (AbiBytes2 n b) = AbiBytes2 n <$> addNulls b
shrinkAbiValue2 (AbiBytesDynamic2 b) = fmap AbiBytesDynamic2 $ addNulls =<< shrinkBS b
shrinkAbiValue2 (AbiString2 b) = fmap AbiString2 $ addNulls =<< shrinkBS b
shrinkAbiValue2 (AbiArray2 n t l) = AbiArray2 n t <$> traverse shrinkAbiValue2 l
shrinkAbiValue2 (AbiArrayDynamic2 t l) = fmap (AbiArrayDynamic2 t) $ traverse shrinkAbiValue2 =<< shrinkV l
shrinkAbiValue2 (AbiTuple2 v) = AbiTuple2 <$> traverse shrinkAbiValue2 v
-- | Given a 'SolCall', generate a random \"smaller\" (simpler) call.
shrinkAbiCall :: MonadRandom m => SolCall -> m SolCall
shrinkAbiCall = traverse $ traverse shrinkAbiValue
shrinkAbiCall2 :: MonadRandom m => SolCall2 -> m SolCall2
shrinkAbiCall2 = traverse $ traverse shrinkAbiValue2
-- | Given an 'AbiValue', generate a random \"similar\" value of the same 'AbiType'.
mutateAbiValue :: MonadRandom m => AbiValue -> m AbiValue
mutateAbiValue (AbiUInt n x) = AbiUInt n <$> mutateNum x
@ -250,10 +407,25 @@ mutateAbiValue (AbiString b) = AbiString <$> mutateBS b
mutateAbiValue (AbiArray n t l) = AbiArray n t <$> traverse mutateAbiValue l
mutateAbiValue (AbiArrayDynamic t l) = AbiArrayDynamic t <$> mutateV t l
mutateAbiValue2 :: MonadRandom m => AbiValue2 -> m AbiValue2
mutateAbiValue2 (AbiUInt2 n x) = AbiUInt2 n <$> mutateNum x
mutateAbiValue2 (AbiInt2 n x) = AbiInt2 n <$> mutateNum x
mutateAbiValue2 (AbiAddress2 _) = genAbiValue2 AbiAddressType2
mutateAbiValue2 (AbiBool2 _) = genAbiValue2 AbiBoolType2
mutateAbiValue2 (AbiBytes2 n b) = AbiBytes2 n <$> addChars getRandom b
mutateAbiValue2 (AbiBytesDynamic2 b) = AbiBytesDynamic2 <$> mutateBS b
mutateAbiValue2 (AbiString2 b) = AbiString2 <$> mutateBS b
mutateAbiValue2 (AbiArray2 n t l) = AbiArray2 n t <$> traverse mutateAbiValue2 l
mutateAbiValue2 (AbiArrayDynamic2 t l) = AbiArrayDynamic2 t <$> mutateV2 t l
mutateAbiValue2 (AbiTuple2 v) = AbiTuple2 <$> traverse mutateAbiValue2 v
-- | Given a 'SolCall', generate a random \"similar\" call with the same 'SolSignature'.
mutateAbiCall :: MonadRandom m => SolCall -> m SolCall
mutateAbiCall = traverse $ traverse mutateAbiValue
mutateAbiCall2 :: MonadRandom m => SolCall2 -> m SolCall2
mutateAbiCall2 = traverse $ traverse mutateAbiValue2
-- Generation, with dictionary
-- | Given a generator taking an @a@ and returning a @b@ and a way to get @b@s associated with some
@ -264,6 +436,11 @@ genWithDict :: (Eq a, Hashable a, MonadState x m, Has GenDict x, MonadRandom m)
genWithDict f g t = let fromDict = uniformMay . M.lookupDefault [] t . f in gets getter >>= \c ->
fromMaybe <$> g t <*> (bool (pure Nothing) (fromDict c) . (c ^. pSynthA >=) =<< getRandom)
genWithDict2 :: (Eq a, Hashable a, MonadState x m, Has GenDict2 x, MonadRandom m)
=> (GenDict2 -> HashMap a [b]) -> (a -> m b) -> a -> m b
genWithDict2 f g t = let fromDict = uniformMay . M.lookupDefault [] t . f in gets getter >>= \c ->
fromMaybe <$> g t <*> (bool (pure Nothing) (fromDict c) . (c ^. pSynthA2 >=) =<< getRandom)
-- | Synthesize a random 'AbiValue' given its 'AbiType'. Requires a dictionary.
genAbiValueM :: (MonadState x m, Has GenDict x, MonadRandom m) => AbiType -> m AbiValue
genAbiValueM = genWithDict (view constants) $ \case
@ -280,11 +457,34 @@ genAbiValueM = genWithDict (view constants) $ \case
>>= flip V.replicateM (genAbiValueM t)
(AbiArrayType n t) -> AbiArray n t <$> V.replicateM n (genAbiValueM t)
genAbiValueM2 :: (MonadState x m, Has GenDict2 x, MonadRandom m) => AbiType2 -> m AbiValue2
genAbiValueM2 = genWithDict2 (view constants2) $ \case
(AbiUIntType2 n) -> AbiUInt2 n . fromInteger <$> getRandomUint n
(AbiIntType2 n) -> AbiInt2 n . fromInteger <$> getRandomR (-1 * 2 ^ n, 2 ^ (n - 1))
AbiAddressType2 -> AbiAddress2 . fromInteger <$> getRandomR (0, 2 ^ (160 :: Integer) - 1)
AbiBoolType2 -> AbiBool2 <$> getRandom
(AbiBytesType2 n) -> AbiBytes2 n . BS.pack . take n <$> getRandoms
AbiBytesDynamicType2 -> liftM2 (\n -> AbiBytesDynamic2 . BS.pack . take n)
(getRandomR (1, 32)) getRandoms
AbiStringType2 -> liftM2 (\n -> AbiString2 . BS.pack . take n)
(getRandomR (1, 32)) getRandoms
(AbiArrayDynamicType2 t) -> fmap (AbiArrayDynamic2 t) $ getRandomR (1, 32)
>>= flip V.replicateM (genAbiValueM2 t)
(AbiArrayType2 n t) -> AbiArray2 n t <$> V.replicateM n (genAbiValueM2 t)
(AbiTupleType2 v) -> AbiTuple2 <$> traverse genAbiValueM2 v
-- | Given a 'SolSignature', generate a random 'SolCalls' with that signature, possibly with a dictionary.
genAbiCallM :: (MonadState x m, Has GenDict x, MonadRandom m) => SolSignature -> m SolCall
genAbiCallM = genWithDict (view wholeCalls) (traverse $ traverse genAbiValueM)
genAbiCallM2 :: (MonadState x m, Has GenDict2 x, MonadRandom m) => SolSignature2 -> m SolCall2
genAbiCallM2 = genWithDict2 (view wholeCalls2) (traverse $ traverse genAbiValueM2)
-- | Given a list of 'SolSignature's, generate a random 'SolCall' for one, possibly with a dictionary.
genInteractionsM :: (MonadState x m, Has GenDict x, MonadRandom m, MonadThrow m)
=> [SolSignature] -> m SolCall
genInteractionsM l = genAbiCallM =<< rElem "ABI" l
genInteractionsM2 :: (MonadState x m, Has GenDict2 x, MonadRandom m, MonadThrow m)
=> [SolSignature2] -> m SolCall2
genInteractionsM2 l = genAbiCallM2 =<< rElem "ABI" l

91
lib/Echidna/Transaction.hs
Unescape View File

@ -15,17 +15,22 @@ import Control.Monad.Random.Strict (MonadRandom, getRandomR)
import Control.Monad.Reader.Class (MonadReader)
import Control.Monad.State.Strict (MonadState, State, runState)
import Data.Aeson (ToJSON(..), object)
import Data.Binary.Put (Put, runPut, putWord8, putWord32be)
import Data.ByteString (ByteString)
import Data.Either (either, lefts)
import Data.Has (Has(..))
import Data.List (intercalate)
import Data.Set (Set)
import Data.Text.Encoding (encodeUtf8)
import EVM
import EVM.ABI (abiCalldata, abiValueType)
import EVM.Concrete (Word(..), w256)
import EVM.Keccak (abiKeccak)
import EVM.Types (Addr)
import qualified Control.Monad.State.Strict as S (state)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSLazy
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Vector as V
@ -43,6 +48,15 @@ data Tx = Tx { _call :: Either SolCall ByteString -- | Either a call or code fo
makeLenses ''Tx
data Tx2 = Tx2 { _call2 :: Either SolCall2 ByteString -- | Either a call or code for a @CREATE@
, _src2 :: Addr -- | Origin
, _dst2 :: Addr -- | Destination
, _gas2' :: Word -- | Gas
, _value2 :: Word -- | Value
} deriving (Eq, Ord, Show)
makeLenses ''Tx2
data TxConf = TxConf { _propGas :: Word
-- ^ Gas to use evaluating echidna properties
, _txGas :: Word
@ -55,6 +69,9 @@ makeLenses 'TxConf
ppSolCall :: SolCall -> String
ppSolCall (t, vs) = (if t == "" then T.unpack "*fallback*" else T.unpack t) ++ "(" ++ intercalate "," (ppAbiValue <$> vs) ++ ")"
ppSolCall2 :: SolCall2 -> String
ppSolCall2 (t, vs) = (if t == "" then T.unpack "*fallback*" else T.unpack t) ++ "(" ++ intercalate "," (ppAbiValue2 <$> vs) ++ ")"
instance ToJSON Tx where
toJSON (Tx c s d g v) = object [ ("call", toJSON $ either ppSolCall (const "<CREATE>") c)
-- from/to are Strings, since JSON doesn't support hexadecimal notation
@ -64,13 +81,26 @@ instance ToJSON Tx where
, ("gas", toJSON $ show g)
]
instance ToJSON Tx2 where
toJSON (Tx2 c s d g v) = object [ ("call", toJSON $ either ppSolCall2 (const "<CREATE>") c)
-- from/to are Strings, since JSON doesn't support hexadecimal notation
, ("from", toJSON $ show s)
, ("to", toJSON $ show d)
, ("value", toJSON $ show v)
, ("gas", toJSON $ show g)
]
-- | A contract is just an address with an ABI (for our purposes).
type ContractA = (Addr, [SolSignature])
type ContractA2 = (Addr, [SolSignature2])
-- | The world is made our of humans with an address, and contracts with an address + ABI.
data World = World { _senders :: [Addr]
, _receivers :: [ContractA]
}
data World2 = World2 { _senders2 :: [Addr]
, _receivers2 :: [ContractA2]
}
makeLenses ''World
@ -87,15 +117,32 @@ genTxWith s r c g v = use hasLens >>=
\case (World ss rs) -> let s' = s ss; r' = r rs; c' = join $ liftM2 c s' r' in
liftM5 Tx (Left <$> c') s' (fst <$> r') g =<< liftM3 v s' r' c'
genTxWith2 :: (MonadRandom m, MonadState x m, Has World2 x, MonadThrow m)
=> ([Addr] -> m Addr) -- ^ Sender generator
-> ([ContractA2] -> m ContractA2) -- ^ Receiver generator
-> (Addr -> ContractA2 -> m SolCall2) -- ^ Call generator
-> m Word -- ^ Gas generator
-> (Addr -> ContractA2 -> SolCall2 -> m Word) -- ^ Value generator
-> m Tx2
genTxWith2 s r c g v = use hasLens >>=
\case (World2 ss rs) -> let s' = s ss; r' = r rs; c' = join $ liftM2 c s' r' in
liftM5 Tx2 (Left <$> c') s' (fst <$> r') g =<< liftM3 v s' r' c'
-- | Synthesize a random 'Transaction', not using a dictionary.
genTx :: (MonadRandom m, MonadReader x m, Has TxConf x, MonadState y m, Has World y, MonadThrow m) => m Tx
genTx = view (hasLens . txGas) >>= \g -> genTxWith (rElem "sender list") (rElem "recipient list")
(const $ genInteractions . snd) (pure g) (\_ _ _ -> pure 0)
genTx2 :: (MonadRandom m, MonadReader x m, Has TxConf x, MonadState y m, Has World2 y, MonadThrow m) => m Tx2
genTx2 = view (hasLens . txGas) >>= \g -> genTxWith2 (rElem "sender list") (rElem "recipient list")
(const $ genInteractions2 . snd) (pure g) (\_ _ _ -> pure 0)
-- | Generate a random 'Transaction' with either synthesis or mutation of dictionary entries.
genTxM :: (MonadRandom m, MonadReader x m, Has TxConf x, MonadState y m, Has GenDict y, Has World y, MonadThrow m) => m Tx
genTxM = view (hasLens . txGas) >>= \g -> genTxWith (rElem "sender list") (rElem "recipient list")
(const $ genInteractionsM . snd) (pure g) (\_ _ _ -> pure 0)
genTxM2 :: (MonadRandom m, MonadReader x m, Has TxConf x, MonadState y m, Has GenDict2 y, Has World2 y, MonadThrow m) => m Tx2
genTxM2 = view (hasLens . txGas) >>= \g -> genTxWith2 (rElem "sender list") (rElem "recipient list")
(const $ genInteractionsM2 . snd) (pure g) (\_ _ _ -> pure 0)
-- | Check if a 'Transaction' is as \"small\" (simple) as possible (using ad-hoc heuristics).
canShrinkTx :: Tx -> Bool
@ -103,12 +150,21 @@ canShrinkTx (Tx (Right _) _ _ _ 0) = False
canShrinkTx (Tx (Left (_,l)) _ _ _ 0) = any canShrinkAbiValue l
canShrinkTx _ = True
canShrinkTx2 :: Tx2 -> Bool
canShrinkTx2 (Tx2 (Right _) _ _ _ 0) = False
canShrinkTx2 (Tx2 (Left (_,l)) _ _ _ 0) = any canShrinkAbiValue2 l
canShrinkTx2 _ = 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 (C _ v)) = let c' = either (fmap Left . shrinkAbiCall) (fmap Right . pure) c in
liftM5 Tx c' (pure s) (pure d) (pure g) $ w256 . fromIntegral <$> getRandomR (0 :: Integer, fromIntegral v)
shrinkTx2 :: MonadRandom m => Tx2 -> m Tx2
shrinkTx2 (Tx2 c s d g (C _ v)) = let c' = either (fmap Left . shrinkAbiCall2) (fmap Right . pure) c in
liftM5 Tx2 c' (pure s) (pure d) (pure g) $ w256 . fromIntegral <$> getRandomR (0 :: Integer, fromIntegral v)
-- | Given a 'Set' of 'Transaction's, generate a similar 'Transaction' at random.
spliceTxs :: (MonadRandom m, MonadReader x m, Has TxConf x, MonadState y m, Has World y, MonadThrow m) => Set Tx -> m Tx
spliceTxs ts = let l = S.toList ts; (cs, ss) = unzip $ (\(Tx c s _ _ _) -> (c,s)) <$> l in
@ -118,6 +174,14 @@ spliceTxs ts = let l = S.toList ts; (cs, ss) = unzip $ (\(Tx c s _ _ _) -> (c,s)
(\ _ _ (n,_) -> let valOf (Tx c _ _ _ v) = if elem n $ c ^? _Left . _1 then v else 0
in rElem "values" $ valOf <$> l)
spliceTxs2 :: (MonadRandom m, MonadReader x m, Has TxConf x, MonadState y m, Has World2 y, MonadThrow m) => Set Tx2 -> m Tx2
spliceTxs2 ts = let l = S.toList ts; (cs, ss) = unzip $ (\(Tx2 c s _ _ _) -> (c,s)) <$> l in
view (hasLens . txGas) >>= \g ->
genTxWith2 (const . rElem "sender list" $ ss) (rElem "recipient list")
(\_ _ -> mutateAbiCall2 =<< rElem "past calls" (lefts cs)) (pure g)
(\ _ _ (n,_) -> let valOf (Tx2 c _ _ _ v) = if elem n $ c ^? _Left . _1 then v else 0
in rElem "values" $ valOf <$> l)
-- | Lift an action in the context of a component of some 'MonadState' to an action in the
-- 'MonadState' itself.
liftSH :: (MonadState a m, Has b a) => State b x -> m x
@ -134,3 +198,30 @@ setupTx (Tx c s r g v) = liftSH . sequence_ $
Right bc -> assign (env . contracts . at r) (Just $ initialContract (RuntimeCode bc) & set balance v) >> loadContract r
encode (n, vs) = abiCalldata
(encodeSig (n, abiValueType <$> vs)) $ V.fromList vs
setupTx2 :: (MonadState x m, Has VM x) => Tx2 -> m ()
setupTx2 (Tx2 c s r g v) = liftSH . sequence_ $
[ result .= Nothing, state . pc .= 0, state . stack .= mempty, state . memory .= mempty, state . gas .= g
, tx . origin .= s, state . caller .= s, state . callvalue .= v, setup] where
setup = case c of
Left cd -> loadContract r >> state . calldata .= encode cd
Right bc -> assign (env . contracts . at r) (Just $ initialContract (RuntimeCode bc) & set balance v) >> loadContract r
encode (n, vs) = abiCalldata2
(encodeSig2 (n, abiValueType2 <$> vs)) $ V.fromList vs
putAbiSeq :: V.Vector AbiValue2 -> Put
putAbiSeq xs =
do snd $ V.foldl' f (headSize, pure ()) (V.zip xs tailSizes)
V.sequence_ (V.map putAbiTail xs)
where
headSize = V.sum $ V.map abiHeadSize2 xs
tailSizes = V.map abiTailSize2 xs
f (i, m) (x, j) =
case abiKind2 (abiValueType2 x) of
Static -> (i, m >> putAbi2 x)
Dynamic -> (i + j, m >> putAbi2 (AbiUInt2 256 (fromIntegral i)))
abiCalldata2 :: T.Text -> V.Vector AbiValue2 -> BS.ByteString
abiCalldata2 s xs = BSLazy.toStrict . runPut $ do
putWord32be (abiKeccak (encodeUtf8 s))
putAbiSeq2 xs

Write Preview
Loading…
Cancel
Save