hevm-0.58.0: src/EVM/ABI.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE StrictData #-}
{-
The ABI encoding is mostly straightforward.
Definition: an int-like value is an uint, int, boolean, or address.
Basic encoding:
* Int-likes and length prefixes are big-endian.
* All values are right-0-padded to multiples of 256 bits.
- Bytestrings are padded as a whole; e.g., bytes[33] takes 64 bytes.
* Dynamic-length sequences are prefixed with their length.
Sequences are encoded as a head followed by a tail, thus:
* the tail is the concatenation of encodings of non-int-like items.
* the head has 256 bits per sequence item, thus:
- int-likes are stored directly;
- non-int-likes are stored as byte offsets into the tail,
starting from the beginning of the head.
Nested sequences are encoded recursively with no special treatment.
Calldata args are encoded as heterogeneous sequences sans length prefix.
-}
module EVM.ABI
( AbiValue (..)
, AbiType (..)
, AbiKind (..)
, AbiVals(..)
, abiKind
, Event (..)
, SolError (..)
, Anonymity (..)
, Indexed (..)
, Sig(..)
, callSig
, putAbi
, getAbi
, getAbiSeq
, genAbiValue
, abiValueType
, abiTypeSolidity
, abiMethod
, emptyAbi
, encodeAbiValue
, decodeAbiValue
, decodeBuf
, decodeStaticArgs
, formatString
, parseTypeName
, makeAbiValue
, parseAbiValue
, selector
, showAlter
) where
import Prelude hiding (Foldable(..))
import EVM.Expr (readWord, readByte, isLitWord, simplify)
import EVM.Types
import EVM.Expr (maybeLitWordSimp, maybeLitByteSimp)
import Control.Applicative ((<|>))
import Control.Monad (replicateM, replicateM_, forM_, void)
import Data.Binary.Get (Get, runGet, runGetOrFail, label, getWord8, getWord32be, skip)
import Data.Binary.Put (Put, runPut, putWord8, putWord32be)
import Data.Bits (shiftL, shiftR, (.&.), testBit, bit, complement, (.|.))
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.DoubleWord (Word160(..), Word128(..))
import Data.Serialize qualified as Cereal
import Data.ByteString.Base16 qualified as BS16
import Data.ByteString.Char8 qualified as Char8
import Data.ByteString.Lazy qualified as BSLazy
import Data.Char (isHexDigit)
import Data.Data (Data)
import Data.DoubleWord (Word256, Int256, signedWord)
import Data.Foldable (Foldable(..))
import Data.Functor (($>))
import Data.List (intercalate)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word32)
import GHC.Generics (Generic)
import Test.QuickCheck hiding ((.&.), label)
import Numeric (showHex)
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char qualified as P
import Text.ParserCombinators.ReadP
import Witch (unsafeInto, into)
-- | A method name, and the (ordered) types of it's arguments
data Sig = Sig Text [AbiType]
deriving (Show, Eq)
data AbiValue
= AbiUInt Int Word256
| AbiInt Int Int256
| AbiAddress Addr
| AbiBool Bool
| AbiBytes Int BS.ByteString
| AbiBytesDynamic BS.ByteString
| AbiString BS.ByteString
| AbiArrayDynamic AbiType (Vector AbiValue)
| AbiArray Int AbiType (Vector AbiValue)
| AbiTuple (Vector AbiValue)
| AbiFunction Addr FunctionSelector
deriving (Read, Eq, Ord, Generic)
class ShowAlter a where
showAlter :: a -> String
-- | Pretty-print some 'AbiValue'.
instance Show AbiValue where
show (AbiUInt _ n) = show n
show (AbiInt _ n) = show n
show (AbiAddress n) = show n
show (AbiBool b) = if b then "true" else "false"
show (AbiBytes _ b) = show (ByteStringS b)
show (AbiBytesDynamic b) = show (ByteStringS b)
show (AbiString s) = formatString s
show (AbiArrayDynamic _ v) =
"[" ++ intercalate ", " (show <$> Vector.toList v) ++ "]"
show (AbiArray _ _ v) =
"[" ++ intercalate ", " (show <$> Vector.toList v) ++ "]"
show (AbiTuple v) =
"(" ++ intercalate ", " (show <$> Vector.toList v) ++ ")"
show (AbiFunction addr sel) = show (ByteStringS (word160Bytes addr <> word32Bytes sel))
-- | Pretty-print some 'AbiValue'.
instance ShowAlter AbiValue where
showAlter (AbiUInt _ n) = "AbiUint " <> showHex n ""
showAlter (AbiInt _ n) = if n < 0 then "AbiInt- " <> showHex (-n) ""
else "AbiInt+ " <> showHex n ""
showAlter (AbiAddress n) = "AbiAddress " <> show n
showAlter (AbiBool b) = "AbiBool " <> if b then "true" else "false"
showAlter (AbiBytes _ b) = "AbiBytes " <> show (ByteStringS b)
showAlter (AbiBytesDynamic b) = "AbiBytesDynamic " <>show (ByteStringS b)
showAlter (AbiString s) = "AbiString " <> formatString s
showAlter (AbiArrayDynamic _ v) = "AbiArrayDynamic " <>
"[" ++ intercalate ", " (show <$> Vector.toList v) ++ "]"
showAlter (AbiArray _ _ v) = "AbiArray " <>
"[" ++ intercalate ", " (showAlter <$> Vector.toList v) ++ "]"
showAlter (AbiTuple v) = "AbiTuple" <>
"(" ++ intercalate ", " (show <$> Vector.toList v) ++ ")"
showAlter (AbiFunction addr sel) = "AbiFunction " <> show (ByteStringS (word160Bytes addr <> word32Bytes sel))
data AbiType
= AbiUIntType Int
| AbiIntType Int
| AbiAddressType
| AbiBoolType
| AbiBytesType Int
| AbiBytesDynamicType
| AbiStringType
| AbiArrayDynamicType AbiType
| AbiArrayType Int AbiType
| AbiTupleType (Vector AbiType)
| AbiFunctionType
deriving (Read, Eq, Ord, Generic, Data)
instance Show AbiType where
show = Text.unpack . abiTypeSolidity
data AbiKind = Dynamic | Static
deriving (Show, Read, Eq, Ord, Generic)
data Anonymity = Anonymous | NotAnonymous
deriving (Show, Ord, Eq, Generic)
data Indexed = Indexed | NotIndexed
deriving (Show, Ord, Eq, Generic)
data Event = Event Text Anonymity [(Text, AbiType, Indexed)]
deriving (Show, Ord, Eq, Generic)
data SolError = SolError Text [AbiType]
deriving (Show, Ord, Eq, Generic)
abiTypeSolidity :: AbiType -> Text
abiTypeSolidity = \case
AbiUIntType n -> "uint" <> Text.pack (show n)
AbiIntType n -> "int" <> Text.pack (show n)
AbiAddressType -> "address"
AbiBoolType -> "bool"
AbiBytesType n -> "bytes" <> Text.pack (show n)
AbiBytesDynamicType -> "bytes"
AbiStringType -> "string"
AbiArrayDynamicType t -> abiTypeSolidity t <> "[]"
AbiArrayType n t -> abiTypeSolidity t <> "[" <> Text.pack (show n) <> "]"
AbiTupleType ts -> "(" <> (Text.intercalate "," . Vector.toList $ abiTypeSolidity <$> ts) <> ")"
AbiFunctionType -> "function"
abiKind :: AbiType -> AbiKind
abiKind = \case
AbiBytesDynamicType -> Dynamic
AbiStringType -> Dynamic
AbiArrayDynamicType _ -> Dynamic
AbiArrayType _ t -> abiKind t
AbiTupleType ts -> if Dynamic `elem` (abiKind <$> ts) then Dynamic else Static
_ -> Static
abiValueType :: AbiValue -> AbiType
abiValueType = \case
AbiUInt n _ -> AbiUIntType n
AbiInt n _ -> AbiIntType n
AbiAddress _ -> AbiAddressType
AbiBool _ -> AbiBoolType
AbiBytes n _ -> AbiBytesType n
AbiBytesDynamic _ -> AbiBytesDynamicType
AbiString _ -> AbiStringType
AbiArrayDynamic t _ -> AbiArrayDynamicType t
AbiArray n t _ -> AbiArrayType n t
AbiTuple v -> AbiTupleType (abiValueType <$> v)
AbiFunction _ _ -> AbiFunctionType
getAbi :: AbiType -> Get AbiValue
getAbi t = label (Text.unpack (abiTypeSolidity t)) $
case t of
AbiUIntType n -> do
let word32Count = 8 * div (n + 255) 256
xs <- replicateM word32Count getWord32be
pure (AbiUInt n (pack32 word32Count xs))
AbiIntType 256 -> asUInt 256 (AbiInt 256)
AbiIntType n -> do
(AbiUInt _ w) <- getAbi (AbiUIntType n)
let truncate' n' w' = w' .&. (bit n' - 1)
let signExtend n' w' = if testBit w' (n' - 1) then w' .|. complement (bit n' - 1) else w'
pure (AbiInt n (fromIntegral $ (signExtend n) . (truncate' n) $ w))
AbiAddressType -> asUInt 256 AbiAddress
AbiBoolType -> asUInt 256 (AbiBool . (> (0 :: Integer)))
AbiBytesType n ->
AbiBytes n <$> getBytesWith256BitPadding n
AbiBytesDynamicType ->
AbiBytesDynamic <$>
(label "bytes length prefix" getWord256
>>= label "bytes data" . getBytesWith256BitPadding)
AbiStringType -> do
AbiString <$>
(label "string length prefix" getWord256
>>= label "string data" . getBytesWith256BitPadding)
AbiArrayType n t' ->
AbiArray n t' <$> getAbiSeq n (repeat t')
AbiArrayDynamicType t' -> do
AbiUInt _ n <- label "array length" (getAbi (AbiUIntType 256))
let maxLen = fromIntegral (maxBound :: Int) :: Word256
if n > maxLen then fail "array length exceeds maximum Int"
else AbiArrayDynamic t' <$>
label "array body" (getAbiSeq (unsafeInto n) (repeat t'))
AbiTupleType ts ->
AbiTuple <$> getAbiSeq (Vector.length ts) (Vector.toList ts)
AbiFunctionType -> do
addrBytes <- BS.pack <$> replicateM 20 getWord8
sel <- FunctionSelector <$> getWord32be
skip 8 -- padding to 32 bytes
let addr = bytesToAddr addrBytes
pure (AbiFunction addr sel)
putAbi :: AbiValue -> Put
putAbi = \case
AbiUInt _ x ->
forM_ (reverse [0 .. 7]) $ \i ->
putWord32be (unsafeInto (shiftR x (i * 32) .&. 0xffffffff))
AbiInt n x -> putAbi (AbiUInt n (fromIntegral x))
AbiAddress x -> putAbi (AbiUInt 160 (fromIntegral x))
AbiBool x -> putAbi (AbiUInt 8 (if x then 1 else 0))
AbiBytes n xs -> do
forM_ [0 .. n-1] (putWord8 . BS.index xs)
replicateM_ (roundTo32Bytes n - n) (putWord8 0)
AbiBytesDynamic xs -> do
let n = BS.length xs
putAbi (AbiUInt 256 (unsafeInto n))
putAbi (AbiBytes n xs)
AbiString s ->
putAbi (AbiBytesDynamic s)
AbiArray _ _ xs ->
putAbiSeq xs
AbiArrayDynamic _ xs -> do
putAbi (AbiUInt 256 (fromIntegral (Vector.length xs)))
putAbiSeq xs
AbiTuple v ->
putAbiSeq v
AbiFunction addr (FunctionSelector sel) -> do
forM_ (BS.unpack (word160Bytes addr)) putWord8
putWord32be sel
replicateM_ 8 (putWord8 0) -- padding to 32 bytes
-- | Decode a sequence type (e.g. tuple / array). Will fail for non sequence types
getAbiSeq :: Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq n ts = label "sequence" $ do
hs <- label "sequence head" (getAbiHead n ts)
Vector.fromList <$>
label "sequence tail" (mapM (either getAbi pure) hs)
getAbiHead :: Int -> [AbiType]
-> Get [Either AbiType AbiValue]
getAbiHead 0 _ = pure []
getAbiHead _ [] = fail "ran out of types"
getAbiHead n (t:ts) =
case abiKind t of
Dynamic ->
(Left t :) <$> (skip 32 *> getAbiHead (n - 1) ts)
Static ->
do x <- getAbi t
xs <- getAbiHead (n - 1) ts
pure (Right x : xs)
putAbiTail :: AbiValue -> Put
putAbiTail x =
case abiKind (abiValueType x) of
Static -> pure ()
Dynamic -> putAbi x
abiTailSize :: AbiValue -> Int
abiTailSize x =
case abiKind (abiValueType x) of
Static -> 0
Dynamic ->
case x of
AbiString s -> 32 + roundTo32Bytes (BS.length s)
AbiBytesDynamic s -> 32 + roundTo32Bytes (BS.length s)
AbiArrayDynamic _ xs -> 32 + sum ((abiHeadSize <$> xs) <> (abiTailSize <$> xs))
AbiArray _ _ xs -> sum ((abiHeadSize <$> xs) <> (abiTailSize <$> xs))
AbiTuple v -> sum ((abiHeadSize <$> v) <> (abiTailSize <$> v))
_ -> internalError "impossible"
abiHeadSize :: AbiValue -> Int
abiHeadSize x =
case abiKind (abiValueType x) of
Dynamic -> 32
Static ->
case x of
AbiUInt _ _ -> 32
AbiInt _ _ -> 32
AbiBytes n _ -> roundTo32Bytes n
AbiAddress _ -> 32
AbiBool _ -> 32
AbiTuple v -> sum (abiHeadSize <$> v)
AbiArray _ _ xs -> sum (abiHeadSize <$> xs)
AbiFunction _ _ -> 32
_ -> internalError "impossible"
putAbiSeq :: Vector AbiValue -> Put
putAbiSeq xs = do
putHeads headSize $ toList xs
Vector.sequence_ (putAbiTail <$> xs)
where
headSize = Vector.sum $ Vector.map abiHeadSize xs
putHeads _ [] = pure ()
putHeads offset (x:xs') =
case abiKind (abiValueType x) of
Static -> do putAbi x
putHeads offset xs'
Dynamic -> do putAbi (AbiUInt 256 (unsafeInto offset))
putHeads (offset + abiTailSize x) xs'
encodeAbiValue :: AbiValue -> BS.ByteString
encodeAbiValue = BSLazy.toStrict . runPut . putAbi
decodeAbiValue :: AbiType -> BSLazy.ByteString -> AbiValue
decodeAbiValue = runGet . getAbi
selector :: Text -> BS.ByteString
selector s = BSLazy.toStrict . runPut $
putWord32be (abiKeccak (encodeUtf8 s)).unFunctionSelector
abiMethod :: Text -> AbiValue -> BS.ByteString
abiMethod s args = BSLazy.toStrict . runPut $ do
putWord32be (abiKeccak (encodeUtf8 s)).unFunctionSelector
putAbi args
parseTypeName :: Vector AbiType -> Text -> Maybe AbiType
parseTypeName = P.parseMaybe . typeWithArraySuffix
typeWithArraySuffix :: Vector AbiType -> P.Parsec () Text AbiType
typeWithArraySuffix v = do
base <- basicType v
sizes <-
P.many $
P.between
(P.char '[') (P.char ']')
(P.many P.digitChar)
let
parseSize :: AbiType -> String -> AbiType
parseSize t "" = AbiArrayDynamicType t
parseSize t s = AbiArrayType (read s) t
pure (foldl' parseSize base sizes)
basicType :: Vector AbiType -> P.Parsec () Text AbiType
basicType v =
P.choice
[ P.string "address" $> AbiAddressType
, P.string "bool" $> AbiBoolType
, P.string "string" $> AbiStringType
, sizedType "uint" AbiUIntType (const True)
, sizedType "int" AbiIntType (const True)
, sizedType "bytes" AbiBytesType (\n -> n >= 1 && n <= 32)
, P.string "bytes" $> AbiBytesDynamicType
, P.string "tuple" $> AbiTupleType v
, P.string "function" $> AbiFunctionType
-- Fallback for user-defined types (e.g. enums like "Order.OrderType").
-- Solidity libraries emit qualified enum names in their ABI instead of
-- the underlying uint8. Treat any unrecognized identifier as uint8.
, P.try (P.some (P.alphaNumChar P.<|> P.char '.') $> AbiUIntType 8)
]
where
sizedType :: Text -> (Int -> AbiType) -> (Int -> Bool) -> P.Parsec () Text AbiType
sizedType s f valid = P.try $ do
void (P.string s)
n <- read <$> P.some P.digitChar
if valid n then pure (f n) else P.empty
pack32 :: Int -> [Word32] -> Word256
pack32 n xs =
sum [ shiftL x ((n - i) * 32)
| (x, i) <- zip (map into xs) [1..] ]
asUInt :: Integral i => Int -> (i -> a) -> Get a
asUInt n f = y <$> getAbi (AbiUIntType n)
where y (AbiUInt _ x) = f (fromIntegral x)
y _ = internalError "can't happen"
getWord256 :: Get Word256
getWord256 = pack32 8 <$> replicateM 8 getWord32be
roundTo32Bytes :: Integral a => a -> a
roundTo32Bytes n = 32 * div (n + 31) 32
word32Bytes :: FunctionSelector -> ByteString
word32Bytes (FunctionSelector w) = BSLazy.toStrict $ runPut $ putWord32be w
bytesToAddr :: ByteString -> Addr
bytesToAddr bs = case Cereal.runGet m bs of
Right addr -> addr
Left _ -> internalError "bytesToAddr: failed to parse 20 bytes"
where
m = do a <- Cereal.getWord32be
b <- Cereal.getWord64be
c <- Cereal.getWord64be
pure $ Addr (Word160 a (Word128 b c))
emptyAbi :: AbiValue
emptyAbi = AbiTuple mempty
getBytesWith256BitPadding :: Integral a => a -> Get ByteString
getBytesWith256BitPadding i =
(BS.pack <$> replicateM n getWord8)
<* skip ((roundTo32Bytes n) - n)
where n = fromIntegral i
-- Bool synonym with custom read instance
-- to be able to parse lower case 'false' and 'true'
newtype Boolz = Boolz Bool
instance Read Boolz where
readsPrec _ ('T':'r':'u':'e':x) = [(Boolz True, x)]
readsPrec _ ('t':'r':'u':'e':x) = [(Boolz True, x)]
readsPrec _ ('f':'a':'l':'s':'e':x) = [(Boolz False, x)]
readsPrec _ ('F':'a':'l':'s':'e':x) = [(Boolz False, x)]
readsPrec _ [] = []
readsPrec n (_:t) = readsPrec n t
makeAbiValue :: AbiType -> String -> AbiValue
makeAbiValue typ str = case readP_to_S (parseAbiValue typ) (padStr str) of
[(val,"")] -> val
_ -> internalError $ "could not parse abi argument: " ++ str ++ " : " ++ show typ
where
padStr = case typ of
(AbiBytesType n) -> padRight' (2 * n + 2) -- +2 is for the 0x prefix
_ -> id
parseAbiValue :: AbiType -> ReadP AbiValue
parseAbiValue (AbiUIntType n) = do W256 w <- readS_to_P reads
pure $ AbiUInt n w
parseAbiValue (AbiIntType n) = do W256 w <- readS_to_P reads
pure $ AbiInt n (unsafeInto w)
parseAbiValue AbiAddressType = AbiAddress <$> readS_to_P reads
parseAbiValue AbiBoolType = (do W256 w <- readS_to_P reads
pure $ AbiBool (w /= 0))
<|> (do Boolz b <- readS_to_P reads
pure $ AbiBool b)
parseAbiValue (AbiBytesType n) = AbiBytes n <$> do ByteStringS bytes <- bytesP
if BS.length bytes == n
then pure bytes
else pfail
parseAbiValue AbiBytesDynamicType = AbiBytesDynamic <$> do ByteStringS bytes <- bytesP
pure bytes
parseAbiValue AbiStringType = AbiString <$> do Char8.pack <$> readS_to_P reads
parseAbiValue (AbiArrayDynamicType typ) =
AbiArrayDynamic typ <$> do a <- listP (parseAbiValue typ)
pure $ Vector.fromList a
parseAbiValue (AbiArrayType n typ) =
AbiArray n typ <$> do a <- listP (parseAbiValue typ)
pure $ Vector.fromList a
parseAbiValue (AbiTupleType _) = internalError "tuple types not supported"
parseAbiValue AbiFunctionType = do
ByteStringS bytes <- bytesP
if BS.length bytes == 24
then let addr = bytesToAddr (BS.take 20 bytes)
sel = FunctionSelector (word32 (BS.unpack (BS.drop 20 bytes)))
in pure (AbiFunction addr sel)
else pfail
listP :: ReadP a -> ReadP [a]
listP parser = between (char '[') (char ']') ((do skipSpaces
a <- parser
skipSpaces
pure a) `sepBy` (char ','))
bytesP :: ReadP ByteStringS
bytesP = do
_ <- string "0x"
hex <- munch isHexDigit
case BS16.decodeBase16Untyped (encodeUtf8 (Text.pack hex)) of
Right d -> pure $ ByteStringS d
Left _ -> pfail
data AbiVals = NoVals | CAbi [AbiValue] | SAbi [Expr EWord]
deriving (Show)
decodeBuf :: [AbiType] -> Expr Buf -> (AbiVals, String)
decodeBuf tps (ConcreteBuf b) =
case runGetOrFail (getAbiSeq (length tps) tps) (BSLazy.fromStrict b) of
Right ("", _, args) -> (CAbi (toList args), "")
Right (str, _, args) -> (CAbi (toList args), "with trailing bytes: " ++ show (BSLazy.unpack str))
Left (_, _, err) -> (NoVals, "error decoding abi: " ++ err)
decodeBuf tps b = case simplify b of
ConcreteBuf buf -> decodeBuf tps (ConcreteBuf buf)
buf -> if any isDynamic tps then tryDecodeDynamic tps buf
else let
vs = decodeStaticArgs 0 (length tps) buf
asBS = mconcat $ fmap word256Bytes (mapMaybe maybeLitWordSimp vs)
in if not (all isLitWord vs)
then (SAbi vs, "")
else decodeBuf tps (ConcreteBuf asBS)
where
isDynamic t = abiKind t == Dynamic
-- | Try to decode arguments including dynamic types like bytes/string
-- For dynamic types, reads offset from head, then length and data from that offset
tryDecodeDynamic :: [AbiType] -> Expr Buf -> (AbiVals, String)
tryDecodeDynamic tps buf =
let headVals = decodeStaticArgs 0 (length tps) buf
headSimp = map simplify headVals
in case decodeWithExprs 0 tps headSimp buf of
Left err -> (NoVals, err)
Right abiVals -> (CAbi abiVals, "")
-- | Decode types using head expressions
-- For static types, the expression is the value
-- For dynamic types, the expression must be a concrete offset
decodeWithExprs :: Int -> [AbiType] -> [Expr EWord] -> Expr Buf -> Err [AbiValue]
decodeWithExprs _ [] [] _ = Right []
decodeWithExprs _ [] _ _ = Left "mismatched types and values"
decodeWithExprs _ _ [] _ = Left "mismatched types and values"
decodeWithExprs headPos (t:ts) (v:vs) buf = do
val <- decodeOneArgExpr t v buf
rest <- decodeWithExprs (headPos + 32) ts vs buf
pure (val : rest)
-- | Decode a single argument from its head expression
-- For dynamic types, the expression must be a concrete offset
decodeOneArgExpr :: AbiType -> Expr EWord -> Expr Buf -> Err AbiValue
decodeOneArgExpr t expr buf = case abiKind t of
Static -> maybe (Left $ "static type requires concrete value, got: " ++ show expr)
(decodeStaticArgConcrete t) simpExpr
Dynamic -> maybe (Left $ "dynamic type requires concrete offset, got: " ++ show expr)
(\o -> decodeDynamicArg t (unsafeInto o) buf) simpExpr
where simpExpr = maybeLitWordSimp expr
-- | Decode a static type from a concrete 32-byte word value
decodeStaticArgConcrete :: AbiType -> W256 -> Err AbiValue
decodeStaticArgConcrete t v = case t of
AbiUIntType n -> Right $ AbiUInt n (fromIntegral v)
AbiIntType n -> Right $ AbiInt n (fromIntegral v)
AbiAddressType -> Right $ AbiAddress $ fromIntegral v
AbiBoolType -> Right $ AbiBool (v > 0)
AbiBytesType n ->
let bs = BS.take n (word256Bytes v)
in Right $ AbiBytes n bs
AbiFunctionType ->
let bs = word256Bytes v
addr = bytesToAddr (BS.take 20 bs)
sel = FunctionSelector (word32 (BS.unpack (BS.drop 20 (BS.take 24 bs))))
in Right $ AbiFunction addr sel
_ -> Left $ "unexpected static type: " ++ show t
-- | Decode a dynamic type from buffer at given offset
decodeDynamicArg :: AbiType -> Int -> Expr Buf -> Err AbiValue
decodeDynamicArg t offset buf = case t of
AbiBytesDynamicType -> do
-- Read length at offset
let lenExpr = simplify $ readWord (Lit $ unsafeInto offset) buf
case maybeLitWordSimp lenExpr of
Nothing -> Left "could not get concrete length for bytes"
Just len ->
let dataOffset = offset + 32
byteCount = unsafeInto len :: Int
bytes = [simplify $ readByte (Lit $ unsafeInto (dataOffset + i)) buf | i <- [0 .. byteCount - 1]]
concreteBytes = mapMaybe maybeLitByteSimp bytes
in if length concreteBytes /= byteCount
then Left $ "could not get all concrete bytes (got " ++ show (length concreteBytes) ++ " of " ++ show byteCount ++ ")"
else Right $ AbiBytesDynamic (BS.pack concreteBytes)
-- String is encoded the same as bytes
AbiStringType -> decodeDynamicArg AbiBytesDynamicType offset buf
_ -> Left $ "dynamic type not yet supported: " ++ show t
decodeStaticArgs :: Int -> Int -> Expr Buf -> [Expr EWord]
decodeStaticArgs offset numArgs b =
[readWord (Lit . unsafeInto $ i) b | i <- [offset,(offset+32) .. (offset + (numArgs-1)*32)]]
-- QuickCheck instances
genAbiValue :: AbiType -> Gen AbiValue
genAbiValue = \case
AbiUIntType n -> AbiUInt n <$> genUInt n
AbiIntType n -> do
x <- genUInt n
pure $ AbiInt n (signedWord (x - 2^(n-1)))
AbiAddressType -> AbiAddress . fromIntegral <$> genUInt 20
AbiBoolType ->
elements [AbiBool False, AbiBool True]
AbiBytesType n ->
do xs <- replicateM n arbitrary
pure (AbiBytes n (BS.pack xs))
AbiBytesDynamicType ->
AbiBytesDynamic . BS.pack <$> listOf arbitrary
AbiStringType ->
AbiString . BS.pack <$> listOf arbitrary
AbiArrayDynamicType t ->
do xs <- listOf1 (scale (`div` 3) (genAbiValue t))
pure (AbiArrayDynamic t (Vector.fromList xs))
AbiArrayType n t ->
AbiArray n t . Vector.fromList <$>
replicateM n (scale (`div` 3) (genAbiValue t))
AbiTupleType ts ->
AbiTuple <$> mapM genAbiValue ts
AbiFunctionType -> do
addrBytes <- BS.pack <$> replicateM 20 arbitrary
selBytes <- replicateM 4 arbitrary
let addr = bytesToAddr addrBytes
sel = FunctionSelector (word32 selBytes)
pure (AbiFunction addr sel)
where
genUInt :: Int -> Gen Word256
genUInt n = arbitraryIntegralWithMax (2^n-1) :: Gen Word256
instance Arbitrary AbiType where
arbitrary = oneof
[ (AbiUIntType . (* 8)) <$> choose (1, 32)
, (AbiIntType . (* 8)) <$> choose (1, 32)
, pure AbiAddressType
, pure AbiBoolType
, AbiBytesType <$> choose (1,32)
, pure AbiBytesDynamicType
, pure AbiStringType
, AbiArrayDynamicType <$> scale (`div` 2) arbitrary
, AbiArrayType
<$> (getPositive <$> arbitrary)
<*> scale (`div` 2) arbitrary
]
instance Arbitrary AbiValue where
arbitrary = arbitrary >>= genAbiValue
shrink = \case
AbiArrayDynamic t v ->
Vector.toList v ++
map (AbiArrayDynamic t . Vector.fromList)
(shrinkList shrink (Vector.toList v))
AbiBytesDynamic b -> AbiBytesDynamic . BS.pack <$> shrinkList shrinkIntegral (BS.unpack b)
AbiString b -> AbiString . BS.pack <$> shrinkList shrinkIntegral (BS.unpack b)
AbiBytes n a | n <= 32 -> shrink $ AbiUInt (n * 8) (word256 a)
--bytesN for N > 32 don't really exist right now anyway..
AbiBytes _ _ | otherwise -> []
AbiArray _ t v ->
Vector.toList v ++
map (\x -> AbiArray (length x) t (Vector.fromList x))
(shrinkList shrink (Vector.toList v))
AbiTuple v -> Vector.toList $ AbiTuple . Vector.fromList . shrink <$> v
AbiUInt n a -> AbiUInt n <$> (shrinkIntegral a)
AbiInt n a -> AbiInt n <$> (shrinkIntegral a)
AbiBool b -> AbiBool <$> shrink b
AbiAddress a -> [AbiAddress 0xacab, AbiAddress a, AbiAddress 0xbabeface, AbiAddress 0xdeadbeef]
AbiFunction addr (FunctionSelector sel) ->
[AbiFunction a (FunctionSelector s) | a <- shrinkIntegral addr, s <- [sel]]
++ [AbiFunction a (FunctionSelector s) | a <- [addr], s <- shrinkIntegral sel]
-- A modification of 'arbitrarySizedBoundedIntegral' quickcheck library
-- which takes the maxbound explicitly rather than relying on a Bounded instance.
-- Essentially a mix between three types of generators:
-- one that strongly prefers values close to 0, one that prefers values close to max
-- and one that chooses uniformly.
arbitraryIntegralWithMax :: (Integral a) => Integer -> Gen a
arbitraryIntegralWithMax maxbound =
sized $ \s ->
do let mn = 0 :: Int
mx = maxbound
bits n | n `quot` 2 == 0 = 0
| otherwise = 1 + bits (n `quot` 2)
k = 2^(s*(bits mn `max` bits mx `max` 40) `div` 100)
smol <- choose (into mn `max` (-k), mx `min` k)
mid <- choose (0, maxbound)
elements [fromIntegral smol, fromIntegral mid, fromIntegral (maxbound - (fromIntegral smol))]
callSig :: Sig -> Text
callSig (Sig name args) = name <> "(" <> (Text.intercalate "," (map abiTypeSolidity args)) <> ")"