{-

  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 heterogenous sequences sans length prefix.

-}

{-# Language StrictData #-}
{-# Language DataKinds #-}

module EVM.ABI
  ( AbiValue (..)
  , AbiType (..)
  , AbiKind (..)
  , AbiVals (..)
  , abiKind
  , Event (..)
  , SolError (..)
  , Anonymity (..)
  , Indexed (..)
  , putAbi
  , getAbi
  , getAbiSeq
  , genAbiValue
  , abiValueType
  , abiTypeSolidity
  , abiMethod
  , emptyAbi
  , encodeAbiValue
  , decodeAbiValue
  , decodeStaticArgs
  , decodeBuffer
  , formatString
  , parseTypeName
  , makeAbiValue
  , parseAbiValue
  , selector
  ) where

import EVM.Types

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, (.&.))
import Data.ByteString    (ByteString)
import Data.Char          (isHexDigit)
import Data.DoubleWord    (Word256, Int256, signedWord)
import Data.Functor       (($>))
import Data.Text          (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8')
import Data.Vector        (Vector, toList)
import Data.Word          (Word32)
import Data.List          (intercalate)
import Data.SBV           (fromBytes)
import GHC.Generics

import Test.QuickCheck hiding ((.&.), label)
import Text.ParserCombinators.ReadP
import Control.Applicative

import qualified Data.ByteString        as BS
import qualified Data.ByteString.Base16 as BS16
import qualified Data.ByteString.Char8  as Char8
import qualified Data.ByteString.Lazy   as BSLazy
import qualified Data.Text              as Text
import qualified Data.Vector            as Vector

import qualified Text.Megaparsec      as P
import qualified Text.Megaparsec.Char as P

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)
  deriving (ReadPrec [AbiValue]
ReadPrec AbiValue
Int -> ReadS AbiValue
ReadS [AbiValue]
(Int -> ReadS AbiValue)
-> ReadS [AbiValue]
-> ReadPrec AbiValue
-> ReadPrec [AbiValue]
-> Read AbiValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AbiValue]
$creadListPrec :: ReadPrec [AbiValue]
readPrec :: ReadPrec AbiValue
$creadPrec :: ReadPrec AbiValue
readList :: ReadS [AbiValue]
$creadList :: ReadS [AbiValue]
readsPrec :: Int -> ReadS AbiValue
$creadsPrec :: Int -> ReadS AbiValue
Read, AbiValue -> AbiValue -> Bool
(AbiValue -> AbiValue -> Bool)
-> (AbiValue -> AbiValue -> Bool) -> Eq AbiValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbiValue -> AbiValue -> Bool
$c/= :: AbiValue -> AbiValue -> Bool
== :: AbiValue -> AbiValue -> Bool
$c== :: AbiValue -> AbiValue -> Bool
Eq, Eq AbiValue
Eq AbiValue
-> (AbiValue -> AbiValue -> Ordering)
-> (AbiValue -> AbiValue -> Bool)
-> (AbiValue -> AbiValue -> Bool)
-> (AbiValue -> AbiValue -> Bool)
-> (AbiValue -> AbiValue -> Bool)
-> (AbiValue -> AbiValue -> AbiValue)
-> (AbiValue -> AbiValue -> AbiValue)
-> Ord AbiValue
AbiValue -> AbiValue -> Bool
AbiValue -> AbiValue -> Ordering
AbiValue -> AbiValue -> AbiValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AbiValue -> AbiValue -> AbiValue
$cmin :: AbiValue -> AbiValue -> AbiValue
max :: AbiValue -> AbiValue -> AbiValue
$cmax :: AbiValue -> AbiValue -> AbiValue
>= :: AbiValue -> AbiValue -> Bool
$c>= :: AbiValue -> AbiValue -> Bool
> :: AbiValue -> AbiValue -> Bool
$c> :: AbiValue -> AbiValue -> Bool
<= :: AbiValue -> AbiValue -> Bool
$c<= :: AbiValue -> AbiValue -> Bool
< :: AbiValue -> AbiValue -> Bool
$c< :: AbiValue -> AbiValue -> Bool
compare :: AbiValue -> AbiValue -> Ordering
$ccompare :: AbiValue -> AbiValue -> Ordering
$cp1Ord :: Eq AbiValue
Ord, (forall x. AbiValue -> Rep AbiValue x)
-> (forall x. Rep AbiValue x -> AbiValue) -> Generic AbiValue
forall x. Rep AbiValue x -> AbiValue
forall x. AbiValue -> Rep AbiValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbiValue x -> AbiValue
$cfrom :: forall x. AbiValue -> Rep AbiValue x
Generic)

-- | Pretty-print some 'AbiValue'.
instance Show AbiValue where
  show :: AbiValue -> String
show (AbiUInt Int
_ Word256
n)         = Word256 -> String
forall a. Show a => a -> String
show Word256
n
  show (AbiInt  Int
_ Int256
n)         = Int256 -> String
forall a. Show a => a -> String
show Int256
n
  show (AbiAddress Addr
n)        = Addr -> String
forall a. Show a => a -> String
show Addr
n
  show (AbiBool Bool
b)           = if Bool
b then String
"true" else String
"false"
  show (AbiBytes      Int
_ ByteString
b)   = ByteStringS -> String
forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
b)
  show (AbiBytesDynamic ByteString
b)   = ByteStringS -> String
forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
b)
  show (AbiString       ByteString
s)   = ByteString -> String
formatString ByteString
s
  show (AbiArrayDynamic AbiType
_ Vector AbiValue
v) =
    String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (AbiValue -> String
forall a. Show a => a -> String
show (AbiValue -> String) -> [AbiValue] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
  show (AbiArray      Int
_ AbiType
_ Vector AbiValue
v) =
    String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (AbiValue -> String
forall a. Show a => a -> String
show (AbiValue -> String) -> [AbiValue] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
  show (AbiTuple Vector AbiValue
v) =
    String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (AbiValue -> String
forall a. Show a => a -> String
show (AbiValue -> String) -> [AbiValue] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

formatString :: ByteString -> String
formatString :: ByteString -> String
formatString ByteString
bs =
  case ByteString -> Either UnicodeException Text
decodeUtf8' ((ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs)) of
    Right Text
s -> String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""
    Left UnicodeException
_ -> String
"❮utf8 decode failed❯: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (ByteStringS -> String
forall a. Show a => a -> String
show (ByteStringS -> String) -> ByteStringS -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
bs)

data AbiType
  = AbiUIntType         Int
  | AbiIntType          Int
  | AbiAddressType
  | AbiBoolType
  | AbiBytesType        Int
  | AbiBytesDynamicType
  | AbiStringType
  | AbiArrayDynamicType AbiType
  | AbiArrayType        Int AbiType
  | AbiTupleType        (Vector AbiType)
  deriving (ReadPrec [AbiType]
ReadPrec AbiType
Int -> ReadS AbiType
ReadS [AbiType]
(Int -> ReadS AbiType)
-> ReadS [AbiType]
-> ReadPrec AbiType
-> ReadPrec [AbiType]
-> Read AbiType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AbiType]
$creadListPrec :: ReadPrec [AbiType]
readPrec :: ReadPrec AbiType
$creadPrec :: ReadPrec AbiType
readList :: ReadS [AbiType]
$creadList :: ReadS [AbiType]
readsPrec :: Int -> ReadS AbiType
$creadsPrec :: Int -> ReadS AbiType
Read, AbiType -> AbiType -> Bool
(AbiType -> AbiType -> Bool)
-> (AbiType -> AbiType -> Bool) -> Eq AbiType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbiType -> AbiType -> Bool
$c/= :: AbiType -> AbiType -> Bool
== :: AbiType -> AbiType -> Bool
$c== :: AbiType -> AbiType -> Bool
Eq, Eq AbiType
Eq AbiType
-> (AbiType -> AbiType -> Ordering)
-> (AbiType -> AbiType -> Bool)
-> (AbiType -> AbiType -> Bool)
-> (AbiType -> AbiType -> Bool)
-> (AbiType -> AbiType -> Bool)
-> (AbiType -> AbiType -> AbiType)
-> (AbiType -> AbiType -> AbiType)
-> Ord AbiType
AbiType -> AbiType -> Bool
AbiType -> AbiType -> Ordering
AbiType -> AbiType -> AbiType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AbiType -> AbiType -> AbiType
$cmin :: AbiType -> AbiType -> AbiType
max :: AbiType -> AbiType -> AbiType
$cmax :: AbiType -> AbiType -> AbiType
>= :: AbiType -> AbiType -> Bool
$c>= :: AbiType -> AbiType -> Bool
> :: AbiType -> AbiType -> Bool
$c> :: AbiType -> AbiType -> Bool
<= :: AbiType -> AbiType -> Bool
$c<= :: AbiType -> AbiType -> Bool
< :: AbiType -> AbiType -> Bool
$c< :: AbiType -> AbiType -> Bool
compare :: AbiType -> AbiType -> Ordering
$ccompare :: AbiType -> AbiType -> Ordering
$cp1Ord :: Eq AbiType
Ord, (forall x. AbiType -> Rep AbiType x)
-> (forall x. Rep AbiType x -> AbiType) -> Generic AbiType
forall x. Rep AbiType x -> AbiType
forall x. AbiType -> Rep AbiType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbiType x -> AbiType
$cfrom :: forall x. AbiType -> Rep AbiType x
Generic)

instance Show AbiType where
  show :: AbiType -> String
show = Text -> String
Text.unpack (Text -> String) -> (AbiType -> Text) -> AbiType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiType -> Text
abiTypeSolidity

data AbiKind = Dynamic | Static
  deriving (Int -> AbiKind -> ShowS
[AbiKind] -> ShowS
AbiKind -> String
(Int -> AbiKind -> ShowS)
-> (AbiKind -> String) -> ([AbiKind] -> ShowS) -> Show AbiKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbiKind] -> ShowS
$cshowList :: [AbiKind] -> ShowS
show :: AbiKind -> String
$cshow :: AbiKind -> String
showsPrec :: Int -> AbiKind -> ShowS
$cshowsPrec :: Int -> AbiKind -> ShowS
Show, ReadPrec [AbiKind]
ReadPrec AbiKind
Int -> ReadS AbiKind
ReadS [AbiKind]
(Int -> ReadS AbiKind)
-> ReadS [AbiKind]
-> ReadPrec AbiKind
-> ReadPrec [AbiKind]
-> Read AbiKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AbiKind]
$creadListPrec :: ReadPrec [AbiKind]
readPrec :: ReadPrec AbiKind
$creadPrec :: ReadPrec AbiKind
readList :: ReadS [AbiKind]
$creadList :: ReadS [AbiKind]
readsPrec :: Int -> ReadS AbiKind
$creadsPrec :: Int -> ReadS AbiKind
Read, AbiKind -> AbiKind -> Bool
(AbiKind -> AbiKind -> Bool)
-> (AbiKind -> AbiKind -> Bool) -> Eq AbiKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbiKind -> AbiKind -> Bool
$c/= :: AbiKind -> AbiKind -> Bool
== :: AbiKind -> AbiKind -> Bool
$c== :: AbiKind -> AbiKind -> Bool
Eq, Eq AbiKind
Eq AbiKind
-> (AbiKind -> AbiKind -> Ordering)
-> (AbiKind -> AbiKind -> Bool)
-> (AbiKind -> AbiKind -> Bool)
-> (AbiKind -> AbiKind -> Bool)
-> (AbiKind -> AbiKind -> Bool)
-> (AbiKind -> AbiKind -> AbiKind)
-> (AbiKind -> AbiKind -> AbiKind)
-> Ord AbiKind
AbiKind -> AbiKind -> Bool
AbiKind -> AbiKind -> Ordering
AbiKind -> AbiKind -> AbiKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AbiKind -> AbiKind -> AbiKind
$cmin :: AbiKind -> AbiKind -> AbiKind
max :: AbiKind -> AbiKind -> AbiKind
$cmax :: AbiKind -> AbiKind -> AbiKind
>= :: AbiKind -> AbiKind -> Bool
$c>= :: AbiKind -> AbiKind -> Bool
> :: AbiKind -> AbiKind -> Bool
$c> :: AbiKind -> AbiKind -> Bool
<= :: AbiKind -> AbiKind -> Bool
$c<= :: AbiKind -> AbiKind -> Bool
< :: AbiKind -> AbiKind -> Bool
$c< :: AbiKind -> AbiKind -> Bool
compare :: AbiKind -> AbiKind -> Ordering
$ccompare :: AbiKind -> AbiKind -> Ordering
$cp1Ord :: Eq AbiKind
Ord, (forall x. AbiKind -> Rep AbiKind x)
-> (forall x. Rep AbiKind x -> AbiKind) -> Generic AbiKind
forall x. Rep AbiKind x -> AbiKind
forall x. AbiKind -> Rep AbiKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbiKind x -> AbiKind
$cfrom :: forall x. AbiKind -> Rep AbiKind x
Generic)

data Anonymity = Anonymous | NotAnonymous
  deriving (Int -> Anonymity -> ShowS
[Anonymity] -> ShowS
Anonymity -> String
(Int -> Anonymity -> ShowS)
-> (Anonymity -> String)
-> ([Anonymity] -> ShowS)
-> Show Anonymity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Anonymity] -> ShowS
$cshowList :: [Anonymity] -> ShowS
show :: Anonymity -> String
$cshow :: Anonymity -> String
showsPrec :: Int -> Anonymity -> ShowS
$cshowsPrec :: Int -> Anonymity -> ShowS
Show, Eq Anonymity
Eq Anonymity
-> (Anonymity -> Anonymity -> Ordering)
-> (Anonymity -> Anonymity -> Bool)
-> (Anonymity -> Anonymity -> Bool)
-> (Anonymity -> Anonymity -> Bool)
-> (Anonymity -> Anonymity -> Bool)
-> (Anonymity -> Anonymity -> Anonymity)
-> (Anonymity -> Anonymity -> Anonymity)
-> Ord Anonymity
Anonymity -> Anonymity -> Bool
Anonymity -> Anonymity -> Ordering
Anonymity -> Anonymity -> Anonymity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Anonymity -> Anonymity -> Anonymity
$cmin :: Anonymity -> Anonymity -> Anonymity
max :: Anonymity -> Anonymity -> Anonymity
$cmax :: Anonymity -> Anonymity -> Anonymity
>= :: Anonymity -> Anonymity -> Bool
$c>= :: Anonymity -> Anonymity -> Bool
> :: Anonymity -> Anonymity -> Bool
$c> :: Anonymity -> Anonymity -> Bool
<= :: Anonymity -> Anonymity -> Bool
$c<= :: Anonymity -> Anonymity -> Bool
< :: Anonymity -> Anonymity -> Bool
$c< :: Anonymity -> Anonymity -> Bool
compare :: Anonymity -> Anonymity -> Ordering
$ccompare :: Anonymity -> Anonymity -> Ordering
$cp1Ord :: Eq Anonymity
Ord, Anonymity -> Anonymity -> Bool
(Anonymity -> Anonymity -> Bool)
-> (Anonymity -> Anonymity -> Bool) -> Eq Anonymity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Anonymity -> Anonymity -> Bool
$c/= :: Anonymity -> Anonymity -> Bool
== :: Anonymity -> Anonymity -> Bool
$c== :: Anonymity -> Anonymity -> Bool
Eq, (forall x. Anonymity -> Rep Anonymity x)
-> (forall x. Rep Anonymity x -> Anonymity) -> Generic Anonymity
forall x. Rep Anonymity x -> Anonymity
forall x. Anonymity -> Rep Anonymity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Anonymity x -> Anonymity
$cfrom :: forall x. Anonymity -> Rep Anonymity x
Generic)
data Indexed   = Indexed   | NotIndexed
  deriving (Int -> Indexed -> ShowS
[Indexed] -> ShowS
Indexed -> String
(Int -> Indexed -> ShowS)
-> (Indexed -> String) -> ([Indexed] -> ShowS) -> Show Indexed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Indexed] -> ShowS
$cshowList :: [Indexed] -> ShowS
show :: Indexed -> String
$cshow :: Indexed -> String
showsPrec :: Int -> Indexed -> ShowS
$cshowsPrec :: Int -> Indexed -> ShowS
Show, Eq Indexed
Eq Indexed
-> (Indexed -> Indexed -> Ordering)
-> (Indexed -> Indexed -> Bool)
-> (Indexed -> Indexed -> Bool)
-> (Indexed -> Indexed -> Bool)
-> (Indexed -> Indexed -> Bool)
-> (Indexed -> Indexed -> Indexed)
-> (Indexed -> Indexed -> Indexed)
-> Ord Indexed
Indexed -> Indexed -> Bool
Indexed -> Indexed -> Ordering
Indexed -> Indexed -> Indexed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Indexed -> Indexed -> Indexed
$cmin :: Indexed -> Indexed -> Indexed
max :: Indexed -> Indexed -> Indexed
$cmax :: Indexed -> Indexed -> Indexed
>= :: Indexed -> Indexed -> Bool
$c>= :: Indexed -> Indexed -> Bool
> :: Indexed -> Indexed -> Bool
$c> :: Indexed -> Indexed -> Bool
<= :: Indexed -> Indexed -> Bool
$c<= :: Indexed -> Indexed -> Bool
< :: Indexed -> Indexed -> Bool
$c< :: Indexed -> Indexed -> Bool
compare :: Indexed -> Indexed -> Ordering
$ccompare :: Indexed -> Indexed -> Ordering
$cp1Ord :: Eq Indexed
Ord, Indexed -> Indexed -> Bool
(Indexed -> Indexed -> Bool)
-> (Indexed -> Indexed -> Bool) -> Eq Indexed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Indexed -> Indexed -> Bool
$c/= :: Indexed -> Indexed -> Bool
== :: Indexed -> Indexed -> Bool
$c== :: Indexed -> Indexed -> Bool
Eq, (forall x. Indexed -> Rep Indexed x)
-> (forall x. Rep Indexed x -> Indexed) -> Generic Indexed
forall x. Rep Indexed x -> Indexed
forall x. Indexed -> Rep Indexed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Indexed x -> Indexed
$cfrom :: forall x. Indexed -> Rep Indexed x
Generic)
data Event     = Event Text Anonymity [(Text, AbiType, Indexed)]
  deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Eq Event
Eq Event
-> (Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic)
data SolError  = SolError Text [AbiType]
  deriving (Int -> SolError -> ShowS
[SolError] -> ShowS
SolError -> String
(Int -> SolError -> ShowS)
-> (SolError -> String) -> ([SolError] -> ShowS) -> Show SolError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolError] -> ShowS
$cshowList :: [SolError] -> ShowS
show :: SolError -> String
$cshow :: SolError -> String
showsPrec :: Int -> SolError -> ShowS
$cshowsPrec :: Int -> SolError -> ShowS
Show, Eq SolError
Eq SolError
-> (SolError -> SolError -> Ordering)
-> (SolError -> SolError -> Bool)
-> (SolError -> SolError -> Bool)
-> (SolError -> SolError -> Bool)
-> (SolError -> SolError -> Bool)
-> (SolError -> SolError -> SolError)
-> (SolError -> SolError -> SolError)
-> Ord SolError
SolError -> SolError -> Bool
SolError -> SolError -> Ordering
SolError -> SolError -> SolError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SolError -> SolError -> SolError
$cmin :: SolError -> SolError -> SolError
max :: SolError -> SolError -> SolError
$cmax :: SolError -> SolError -> SolError
>= :: SolError -> SolError -> Bool
$c>= :: SolError -> SolError -> Bool
> :: SolError -> SolError -> Bool
$c> :: SolError -> SolError -> Bool
<= :: SolError -> SolError -> Bool
$c<= :: SolError -> SolError -> Bool
< :: SolError -> SolError -> Bool
$c< :: SolError -> SolError -> Bool
compare :: SolError -> SolError -> Ordering
$ccompare :: SolError -> SolError -> Ordering
$cp1Ord :: Eq SolError
Ord, SolError -> SolError -> Bool
(SolError -> SolError -> Bool)
-> (SolError -> SolError -> Bool) -> Eq SolError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolError -> SolError -> Bool
$c/= :: SolError -> SolError -> Bool
== :: SolError -> SolError -> Bool
$c== :: SolError -> SolError -> Bool
Eq, (forall x. SolError -> Rep SolError x)
-> (forall x. Rep SolError x -> SolError) -> Generic SolError
forall x. Rep SolError x -> SolError
forall x. SolError -> Rep SolError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolError x -> SolError
$cfrom :: forall x. SolError -> Rep SolError x
Generic)

abiKind :: AbiType -> AbiKind
abiKind :: AbiType -> AbiKind
abiKind = \case
  AbiType
AbiBytesDynamicType   -> AbiKind
Dynamic
  AbiType
AbiStringType         -> AbiKind
Dynamic
  AbiArrayDynamicType AbiType
_ -> AbiKind
Dynamic
  AbiArrayType Int
_ AbiType
t      -> AbiType -> AbiKind
abiKind AbiType
t
  AbiTupleType Vector AbiType
ts       -> if AbiKind
Dynamic AbiKind -> Vector AbiKind -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (AbiType -> AbiKind
abiKind (AbiType -> AbiKind) -> Vector AbiType -> Vector AbiKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiType
ts) then AbiKind
Dynamic else AbiKind
Static
  AbiType
_                     -> AbiKind
Static

abiValueType :: AbiValue -> AbiType
abiValueType :: AbiValue -> AbiType
abiValueType = \case
  AbiUInt Int
n Word256
_         -> Int -> AbiType
AbiUIntType Int
n
  AbiInt Int
n Int256
_          -> Int -> AbiType
AbiIntType  Int
n
  AbiAddress Addr
_        -> AbiType
AbiAddressType
  AbiBool Bool
_           -> AbiType
AbiBoolType
  AbiBytes Int
n ByteString
_        -> Int -> AbiType
AbiBytesType Int
n
  AbiBytesDynamic ByteString
_   -> AbiType
AbiBytesDynamicType
  AbiString ByteString
_         -> AbiType
AbiStringType
  AbiArrayDynamic AbiType
t Vector AbiValue
_ -> AbiType -> AbiType
AbiArrayDynamicType AbiType
t
  AbiArray Int
n AbiType
t Vector AbiValue
_      -> Int -> AbiType -> AbiType
AbiArrayType Int
n AbiType
t
  AbiTuple Vector AbiValue
v          -> Vector AbiType -> AbiType
AbiTupleType (AbiValue -> AbiType
abiValueType (AbiValue -> AbiType) -> Vector AbiValue -> Vector AbiType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v)

abiTypeSolidity :: AbiType -> Text
abiTypeSolidity :: AbiType -> Text
abiTypeSolidity = \case
  AbiUIntType Int
n         -> Text
"uint" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n)
  AbiIntType Int
n          -> Text
"int" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n)
  AbiType
AbiAddressType        -> Text
"address"
  AbiType
AbiBoolType           -> Text
"bool"
  AbiBytesType Int
n        -> Text
"bytes" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n)
  AbiType
AbiBytesDynamicType   -> Text
"bytes"
  AbiType
AbiStringType         -> Text
"string"
  AbiArrayDynamicType AbiType
t -> AbiType -> Text
abiTypeSolidity AbiType
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[]"
  AbiArrayType Int
n AbiType
t      -> AbiType -> Text
abiTypeSolidity AbiType
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  AbiTupleType Vector AbiType
ts       -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> (Vector Text -> [Text]) -> Vector Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList (Vector Text -> Text) -> Vector Text -> Text
forall a b. (a -> b) -> a -> b
$ AbiType -> Text
abiTypeSolidity (AbiType -> Text) -> Vector AbiType -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiType
ts) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

getAbi :: AbiType -> Get AbiValue
getAbi :: AbiType -> Get AbiValue
getAbi AbiType
t = String -> Get AbiValue -> Get AbiValue
forall a. String -> Get a -> Get a
label (Text -> String
Text.unpack (AbiType -> Text
abiTypeSolidity AbiType
t)) (Get AbiValue -> Get AbiValue) -> Get AbiValue -> Get AbiValue
forall a b. (a -> b) -> a -> b
$
  case AbiType
t of
    AbiUIntType Int
n  -> do
      let word32Count :: Int
word32Count = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
255) Int
256
      [Word32]
xs <- Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
word32Count Get Word32
getWord32be
      AbiValue -> Get AbiValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Word256 -> AbiValue
AbiUInt Int
n (Int -> [Word32] -> Word256
pack32 Int
word32Count [Word32]
xs))

    AbiIntType Int
n   -> Int -> (Int256 -> AbiValue) -> Get AbiValue
forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt Int
n (Int -> Int256 -> AbiValue
AbiInt Int
n)
    AbiType
AbiAddressType -> Int -> (Addr -> AbiValue) -> Get AbiValue
forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt Int
256 Addr -> AbiValue
AbiAddress
    AbiType
AbiBoolType    -> Int -> (Integer -> AbiValue) -> Get AbiValue
forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt Int
256 (Bool -> AbiValue
AbiBool (Bool -> AbiValue) -> (Integer -> Bool) -> Integer -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (Integer
0 :: Integer)))

    AbiBytesType Int
n ->
      Int -> ByteString -> AbiValue
AbiBytes Int
n (ByteString -> AbiValue) -> Get ByteString -> Get AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
forall a. Integral a => a -> Get ByteString
getBytesWith256BitPadding Int
n

    AbiType
AbiBytesDynamicType ->
      ByteString -> AbiValue
AbiBytesDynamic (ByteString -> AbiValue) -> Get ByteString -> Get AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (String -> Get Word256 -> Get Word256
forall a. String -> Get a -> Get a
label String
"bytes length prefix" Get Word256
getWord256
          Get Word256 -> (Word256 -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Get ByteString -> Get ByteString
forall a. String -> Get a -> Get a
label String
"bytes data" (Get ByteString -> Get ByteString)
-> (Word256 -> Get ByteString) -> Word256 -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word256 -> Get ByteString
forall a. Integral a => a -> Get ByteString
getBytesWith256BitPadding)

    AbiType
AbiStringType -> do
      ByteString -> AbiValue
AbiString (ByteString -> AbiValue) -> Get ByteString -> Get AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (String -> Get Word256 -> Get Word256
forall a. String -> Get a -> Get a
label String
"string length prefix" Get Word256
getWord256
          Get Word256 -> (Word256 -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Get ByteString -> Get ByteString
forall a. String -> Get a -> Get a
label String
"string data" (Get ByteString -> Get ByteString)
-> (Word256 -> Get ByteString) -> Word256 -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word256 -> Get ByteString
forall a. Integral a => a -> Get ByteString
getBytesWith256BitPadding)

    AbiArrayType Int
n AbiType
t' ->
      Int -> AbiType -> Vector AbiValue -> AbiValue
AbiArray Int
n AbiType
t' (Vector AbiValue -> AbiValue)
-> Get (Vector AbiValue) -> Get AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq Int
n (AbiType -> [AbiType]
forall a. a -> [a]
repeat AbiType
t')

    AbiArrayDynamicType AbiType
t' -> do
      AbiUInt Int
_ Word256
n <- String -> Get AbiValue -> Get AbiValue
forall a. String -> Get a -> Get a
label String
"array length" (AbiType -> Get AbiValue
getAbi (Int -> AbiType
AbiUIntType Int
256))
      AbiType -> Vector AbiValue -> AbiValue
AbiArrayDynamic AbiType
t' (Vector AbiValue -> AbiValue)
-> Get (Vector AbiValue) -> Get AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        String -> Get (Vector AbiValue) -> Get (Vector AbiValue)
forall a. String -> Get a -> Get a
label String
"array body" (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq (Word256 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word256
n) (AbiType -> [AbiType]
forall a. a -> [a]
repeat AbiType
t'))

    AbiTupleType Vector AbiType
ts ->
      Vector AbiValue -> AbiValue
AbiTuple (Vector AbiValue -> AbiValue)
-> Get (Vector AbiValue) -> Get AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq (Vector AbiType -> Int
forall a. Vector a -> Int
Vector.length Vector AbiType
ts) (Vector AbiType -> [AbiType]
forall a. Vector a -> [a]
Vector.toList Vector AbiType
ts)

putAbi :: AbiValue -> Put
putAbi :: AbiValue -> Put
putAbi = \case
  AbiUInt Int
_ Word256
x ->
    [Int] -> (Int -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0 .. Int
7]) ((Int -> Put) -> Put) -> (Int -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \Int
i ->
      Word32 -> Put
putWord32be (Word256 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word256 -> Int -> Word256
forall a. Bits a => a -> Int -> a
shiftR Word256
x (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32) Word256 -> Word256 -> Word256
forall a. Bits a => a -> a -> a
.&. Word256
0xffffffff))

  AbiInt Int
n Int256
x   -> AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
n (Int256 -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int256
x))
  AbiAddress Addr
x -> AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
160 (Addr -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Addr
x))
  AbiBool Bool
x    -> AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
8 (if Bool
x then Word256
1 else Word256
0))

  AbiBytes Int
n ByteString
xs -> do
    [Int] -> (Int -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] (Word8 -> Put
putWord8 (Word8 -> Put) -> (Int -> Word8) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
BS.index ByteString
xs)
    Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int -> Int
forall a. Integral a => a -> a
roundTo32Bytes Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Word8 -> Put
putWord8 Word8
0)

  AbiBytesDynamic ByteString
xs -> do
    let n :: Int
n = ByteString -> Int
BS.length ByteString
xs
    AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
256 (Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
    AbiValue -> Put
putAbi (Int -> ByteString -> AbiValue
AbiBytes Int
n ByteString
xs)

  AbiString ByteString
s ->
    AbiValue -> Put
putAbi (ByteString -> AbiValue
AbiBytesDynamic ByteString
s)

  AbiArray Int
_ AbiType
_ Vector AbiValue
xs ->
    Vector AbiValue -> Put
putAbiSeq Vector AbiValue
xs

  AbiArrayDynamic AbiType
_ Vector AbiValue
xs -> do
    AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
256 (Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector AbiValue -> Int
forall a. Vector a -> Int
Vector.length Vector AbiValue
xs)))
    Vector AbiValue -> Put
putAbiSeq Vector AbiValue
xs

  AbiTuple Vector AbiValue
v ->
    Vector AbiValue -> Put
putAbiSeq Vector AbiValue
v

-- | Decode a sequence type (e.g. tuple / array). Will fail for non sequence types
getAbiSeq :: Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq :: Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq Int
n [AbiType]
ts = String -> Get (Vector AbiValue) -> Get (Vector AbiValue)
forall a. String -> Get a -> Get a
label String
"sequence" (Get (Vector AbiValue) -> Get (Vector AbiValue))
-> Get (Vector AbiValue) -> Get (Vector AbiValue)
forall a b. (a -> b) -> a -> b
$ do
  [Either AbiType AbiValue]
hs <- String
-> Get [Either AbiType AbiValue] -> Get [Either AbiType AbiValue]
forall a. String -> Get a -> Get a
label String
"sequence head" (Int -> [AbiType] -> Get [Either AbiType AbiValue]
getAbiHead Int
n [AbiType]
ts)
  [AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList ([AbiValue] -> Vector AbiValue)
-> Get [AbiValue] -> Get (Vector AbiValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    String -> Get [AbiValue] -> Get [AbiValue]
forall a. String -> Get a -> Get a
label String
"sequence tail" ((Either AbiType AbiValue -> Get AbiValue)
-> [Either AbiType AbiValue] -> Get [AbiValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((AbiType -> Get AbiValue)
-> (AbiValue -> Get AbiValue)
-> Either AbiType AbiValue
-> Get AbiValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either AbiType -> Get AbiValue
getAbi AbiValue -> Get AbiValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Either AbiType AbiValue]
hs)

getAbiHead :: Int -> [AbiType]
  -> Get [Either AbiType AbiValue]
getAbiHead :: Int -> [AbiType] -> Get [Either AbiType AbiValue]
getAbiHead Int
0 [AbiType]
_      = [Either AbiType AbiValue] -> Get [Either AbiType AbiValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getAbiHead Int
_ []     = String -> Get [Either AbiType AbiValue]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ran out of types"
getAbiHead Int
n (AbiType
t:[AbiType]
ts) =
  case AbiType -> AbiKind
abiKind AbiType
t of
    AbiKind
Dynamic ->
      (AbiType -> Either AbiType AbiValue
forall a b. a -> Either a b
Left AbiType
t Either AbiType AbiValue
-> [Either AbiType AbiValue] -> [Either AbiType AbiValue]
forall a. a -> [a] -> [a]
:) ([Either AbiType AbiValue] -> [Either AbiType AbiValue])
-> Get [Either AbiType AbiValue] -> Get [Either AbiType AbiValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get ()
skip Int
32 Get ()
-> Get [Either AbiType AbiValue] -> Get [Either AbiType AbiValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> [AbiType] -> Get [Either AbiType AbiValue]
getAbiHead (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [AbiType]
ts)
    AbiKind
Static ->
      do AbiValue
x  <- AbiType -> Get AbiValue
getAbi AbiType
t
         [Either AbiType AbiValue]
xs <- Int -> [AbiType] -> Get [Either AbiType AbiValue]
getAbiHead (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [AbiType]
ts
         [Either AbiType AbiValue] -> Get [Either AbiType AbiValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbiValue -> Either AbiType AbiValue
forall a b. b -> Either a b
Right AbiValue
x Either AbiType AbiValue
-> [Either AbiType AbiValue] -> [Either AbiType AbiValue]
forall a. a -> [a] -> [a]
: [Either AbiType AbiValue]
xs)

putAbiTail :: AbiValue -> Put
putAbiTail :: AbiValue -> Put
putAbiTail AbiValue
x =
  case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
    AbiKind
Static  -> () -> Put
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    AbiKind
Dynamic -> AbiValue -> Put
putAbi AbiValue
x

abiTailSize :: AbiValue -> Int
abiTailSize :: AbiValue -> Int
abiTailSize AbiValue
x =
  case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
    AbiKind
Static -> Int
0
    AbiKind
Dynamic ->
      case AbiValue
x of
        AbiString ByteString
s -> Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Integral a => a -> a
roundTo32Bytes (ByteString -> Int
BS.length ByteString
s)
        AbiBytesDynamic ByteString
s -> Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Integral a => a -> a
roundTo32Bytes (ByteString -> Int
BS.length ByteString
s)
        AbiArrayDynamic AbiType
_ Vector AbiValue
xs -> Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AbiValue -> Int
abiHeadSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs) Vector Int -> Vector Int -> Vector Int
forall a. Semigroup a => a -> a -> a
<> (AbiValue -> Int
abiTailSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs))
        AbiArray Int
_ AbiType
_ Vector AbiValue
xs -> Vector Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AbiValue -> Int
abiHeadSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs) Vector Int -> Vector Int -> Vector Int
forall a. Semigroup a => a -> a -> a
<> (AbiValue -> Int
abiTailSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs))
        AbiTuple Vector AbiValue
v -> Vector Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AbiValue -> Int
abiHeadSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v) Vector Int -> Vector Int -> Vector Int
forall a. Semigroup a => a -> a -> a
<> (AbiValue -> Int
abiTailSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v))
        AbiValue
_ -> String -> Int
forall a. HasCallStack => String -> a
error String
"impossible"

abiHeadSize :: AbiValue -> Int
abiHeadSize :: AbiValue -> Int
abiHeadSize AbiValue
x =
  case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
    AbiKind
Dynamic -> Int
32
    AbiKind
Static ->
      case AbiValue
x of
        AbiUInt Int
_ Word256
_  -> Int
32
        AbiInt  Int
_ Int256
_  -> Int
32
        AbiBytes Int
n ByteString
_ -> Int -> Int
forall a. Integral a => a -> a
roundTo32Bytes Int
n
        AbiAddress Addr
_ -> Int
32
        AbiBool Bool
_    -> Int
32
        AbiTuple Vector AbiValue
v   -> Vector Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (AbiValue -> Int
abiHeadSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v)
        AbiArray Int
_ AbiType
_ Vector AbiValue
xs -> Vector Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (AbiValue -> Int
abiHeadSize (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs)
        AbiValue
_ -> String -> Int
forall a. HasCallStack => String -> a
error String
"impossible"

putAbiSeq :: Vector AbiValue -> Put
putAbiSeq :: Vector AbiValue -> Put
putAbiSeq Vector AbiValue
xs =
  do Int -> [AbiValue] -> Put
putHeads Int
headSize ([AbiValue] -> Put) -> [AbiValue] -> Put
forall a b. (a -> b) -> a -> b
$ Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
toList Vector AbiValue
xs
     Vector Put -> Put
forall (m :: * -> *) a. Monad m => Vector (m a) -> m ()
Vector.sequence_ (AbiValue -> Put
putAbiTail (AbiValue -> Put) -> Vector AbiValue -> Vector Put
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs)
  where
    headSize :: Int
headSize = Vector Int -> Int
forall a. Num a => Vector a -> a
Vector.sum (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (AbiValue -> Int) -> Vector AbiValue -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map AbiValue -> Int
abiHeadSize Vector AbiValue
xs
    putHeads :: Int -> [AbiValue] -> Put
putHeads Int
_ [] = () -> Put
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    putHeads Int
offset (AbiValue
x:[AbiValue]
xs') =
      case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
        AbiKind
Static -> do AbiValue -> Put
putAbi AbiValue
x
                     Int -> [AbiValue] -> Put
putHeads Int
offset [AbiValue]
xs'
        AbiKind
Dynamic -> do AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
256 (Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))
                      Int -> [AbiValue] -> Put
putHeads (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AbiValue -> Int
abiTailSize AbiValue
x) [AbiValue]
xs'

encodeAbiValue :: AbiValue -> BS.ByteString
encodeAbiValue :: AbiValue -> ByteString
encodeAbiValue = ByteString -> ByteString
BSLazy.toStrict (ByteString -> ByteString)
-> (AbiValue -> ByteString) -> AbiValue -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> (AbiValue -> Put) -> AbiValue -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiValue -> Put
putAbi

decodeAbiValue :: AbiType -> BSLazy.ByteString -> AbiValue
decodeAbiValue :: AbiType -> ByteString -> AbiValue
decodeAbiValue = Get AbiValue -> ByteString -> AbiValue
forall a. Get a -> ByteString -> a
runGet (Get AbiValue -> ByteString -> AbiValue)
-> (AbiType -> Get AbiValue) -> AbiType -> ByteString -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiType -> Get AbiValue
getAbi

selector :: Text -> BS.ByteString
selector :: Text -> ByteString
selector Text
s = ByteString -> ByteString
BSLazy.toStrict (ByteString -> ByteString)
-> (Put -> ByteString) -> Put -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
putWord32be (ByteString -> Word32
abiKeccak (Text -> ByteString
encodeUtf8 Text
s))

abiMethod :: Text -> AbiValue -> BS.ByteString
abiMethod :: Text -> AbiValue -> ByteString
abiMethod Text
s AbiValue
args = ByteString -> ByteString
BSLazy.toStrict (ByteString -> ByteString)
-> (Put -> ByteString) -> Put -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  Word32 -> Put
putWord32be (ByteString -> Word32
abiKeccak (Text -> ByteString
encodeUtf8 Text
s))
  AbiValue -> Put
putAbi AbiValue
args

parseTypeName :: Vector AbiType -> Text -> Maybe AbiType
parseTypeName :: Vector AbiType -> Text -> Maybe AbiType
parseTypeName = Parsec () Text AbiType -> Text -> Maybe AbiType
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe (Parsec () Text AbiType -> Text -> Maybe AbiType)
-> (Vector AbiType -> Parsec () Text AbiType)
-> Vector AbiType
-> Text
-> Maybe AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector AbiType -> Parsec () Text AbiType
typeWithArraySuffix

typeWithArraySuffix :: Vector AbiType -> P.Parsec () Text AbiType
typeWithArraySuffix :: Vector AbiType -> Parsec () Text AbiType
typeWithArraySuffix Vector AbiType
v = do
  AbiType
base <- Vector AbiType -> Parsec () Text AbiType
basicType Vector AbiType
v
  [String]
sizes <-
    ParsecT () Text Identity String
-> ParsecT () Text Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (ParsecT () Text Identity String
 -> ParsecT () Text Identity [String])
-> ParsecT () Text Identity String
-> ParsecT () Text Identity [String]
forall a b. (a -> b) -> a -> b
$
      ParsecT () Text Identity Char
-> ParsecT () Text Identity Char
-> ParsecT () Text Identity String
-> ParsecT () Text Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between
        (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'[') (Token Text -> ParsecT () Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
']')
        (ParsecT () Text Identity Char -> ParsecT () Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many ParsecT () Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.digitChar)

  let
    parseSize :: AbiType -> String -> AbiType
    parseSize :: AbiType -> String -> AbiType
parseSize AbiType
t String
"" = AbiType -> AbiType
AbiArrayDynamicType AbiType
t
    parseSize AbiType
t String
s  = Int -> AbiType -> AbiType
AbiArrayType (String -> Int
forall a. Read a => String -> a
read String
s) AbiType
t

  AbiType -> Parsec () Text AbiType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AbiType -> String -> AbiType) -> AbiType -> [String] -> AbiType
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl AbiType -> String -> AbiType
parseSize AbiType
base [String]
sizes)

basicType :: Vector AbiType -> P.Parsec () Text AbiType
basicType :: Vector AbiType -> Parsec () Text AbiType
basicType Vector AbiType
v =
  [Parsec () Text AbiType] -> Parsec () Text AbiType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
    [ Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"address" ParsecT () Text Identity Text -> AbiType -> Parsec () Text AbiType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AbiType
AbiAddressType
    , Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"bool"    ParsecT () Text Identity Text -> AbiType -> Parsec () Text AbiType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AbiType
AbiBoolType
    , Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"string"  ParsecT () Text Identity Text -> AbiType -> Parsec () Text AbiType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AbiType
AbiStringType

    , Text -> (Int -> AbiType) -> Parsec () Text AbiType
sizedType Text
"uint" Int -> AbiType
AbiUIntType
    , Text -> (Int -> AbiType) -> Parsec () Text AbiType
sizedType Text
"int"  Int -> AbiType
AbiIntType
    , Text -> (Int -> AbiType) -> Parsec () Text AbiType
sizedType Text
"bytes" Int -> AbiType
AbiBytesType

    , Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"bytes" ParsecT () Text Identity Text -> AbiType -> Parsec () Text AbiType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AbiType
AbiBytesDynamicType
    , Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"tuple" ParsecT () Text Identity Text -> AbiType -> Parsec () Text AbiType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Vector AbiType -> AbiType
AbiTupleType Vector AbiType
v
    ]

  where
    sizedType :: Text -> (Int -> AbiType) -> P.Parsec () Text AbiType
    sizedType :: Text -> (Int -> AbiType) -> Parsec () Text AbiType
sizedType Text
s Int -> AbiType
f = Parsec () Text AbiType -> Parsec () Text AbiType
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Parsec () Text AbiType -> Parsec () Text AbiType)
-> Parsec () Text AbiType -> Parsec () Text AbiType
forall a b. (a -> b) -> a -> b
$ do
      ParsecT () Text Identity Text -> ParsecT () Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT () Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Text
Tokens Text
s)
      (String -> AbiType)
-> ParsecT () Text Identity String -> Parsec () Text AbiType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> AbiType
f (Int -> AbiType) -> (String -> Int) -> String -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read) (ParsecT () Text Identity Char -> ParsecT () Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some ParsecT () Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.digitChar)

pack32 :: Int -> [Word32] -> Word256
pack32 :: Int -> [Word32] -> Word256
pack32 Int
n [Word32]
xs =
  [Word256] -> Word256
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Word256 -> Int -> Word256
forall a. Bits a => a -> Int -> a
shiftL Word256
x ((Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32)
      | (Word256
x, Int
i) <- [Word256] -> [Int] -> [(Word256, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Word32 -> Word256) -> [Word32] -> [Word256]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word32]
xs) [Int
1..] ]

asUInt :: Integral i => Int -> (i -> a) -> Get a
asUInt :: Int -> (i -> a) -> Get a
asUInt Int
n i -> a
f = (\(AbiUInt Int
_ Word256
x) -> i -> a
f (Word256 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word256
x)) (AbiValue -> a) -> Get AbiValue -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbiType -> Get AbiValue
getAbi (Int -> AbiType
AbiUIntType Int
n)

getWord256 :: Get Word256
getWord256 :: Get Word256
getWord256 = Int -> [Word32] -> Word256
pack32 Int
8 ([Word32] -> Word256) -> Get [Word32] -> Get Word256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
8 Get Word32
getWord32be

roundTo32Bytes :: Integral a => a -> a
roundTo32Bytes :: a -> a
roundTo32Bytes a
n = a
32 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a -> a
forall a. Integral a => a -> a -> a
div (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
31) a
32

emptyAbi :: AbiValue
emptyAbi :: AbiValue
emptyAbi = Vector AbiValue -> AbiValue
AbiTuple Vector AbiValue
forall a. Monoid a => a
mempty

getBytesWith256BitPadding :: Integral a => a -> Get ByteString
getBytesWith256BitPadding :: a -> Get ByteString
getBytesWith256BitPadding a
i =
  ([Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Get [Word8] -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Get Word8
getWord8)
    Get ByteString -> Get () -> Get ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Get ()
skip ((Int -> Int
forall a. Integral a => a -> a
roundTo32Bytes Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
  where n :: Int
n = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i

-- QuickCheck instances

genAbiValue :: AbiType -> Gen AbiValue
genAbiValue :: AbiType -> Gen AbiValue
genAbiValue = \case
   AbiUIntType Int
n -> Int -> Gen AbiValue
genUInt Int
n
   AbiIntType Int
n ->
     do AbiValue
a <- Int -> Gen AbiValue
genUInt Int
n
        let AbiUInt Int
_ Word256
x = AbiValue
a
        AbiValue -> Gen AbiValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbiValue -> Gen AbiValue) -> AbiValue -> Gen AbiValue
forall a b. (a -> b) -> a -> b
$ Int -> Int256 -> AbiValue
AbiInt Int
n (Word256 -> SignedWord Word256
forall w. BinaryWord w => w -> SignedWord w
signedWord (Word256
x Word256 -> Word256 -> Word256
forall a. Num a => a -> a -> a
- Word256
2Word256 -> Int -> Word256
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)))
   AbiType
AbiAddressType ->
     (\(AbiUInt Int
_ Word256
x) -> Addr -> AbiValue
AbiAddress (Word256 -> Addr
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word256
x)) (AbiValue -> AbiValue) -> Gen AbiValue -> Gen AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen AbiValue
genUInt Int
20
   AbiType
AbiBoolType ->
     [AbiValue] -> Gen AbiValue
forall a. [a] -> Gen a
elements [Bool -> AbiValue
AbiBool Bool
False, Bool -> AbiValue
AbiBool Bool
True]
   AbiBytesType Int
n ->
     do [Word8]
xs <- Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
        AbiValue -> Gen AbiValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ByteString -> AbiValue
AbiBytes Int
n ([Word8] -> ByteString
BS.pack [Word8]
xs))
   AbiType
AbiBytesDynamicType ->
     ByteString -> AbiValue
AbiBytesDynamic (ByteString -> AbiValue)
-> ([Word8] -> ByteString) -> [Word8] -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> AbiValue) -> Gen [Word8] -> Gen AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
   AbiType
AbiStringType ->
     ByteString -> AbiValue
AbiString (ByteString -> AbiValue)
-> ([Word8] -> ByteString) -> [Word8] -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> AbiValue) -> Gen [Word8] -> Gen AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
   AbiArrayDynamicType AbiType
t ->
     do [AbiValue]
xs <- Gen AbiValue -> Gen [AbiValue]
forall a. Gen a -> Gen [a]
listOf1 ((Int -> Int) -> Gen AbiValue -> Gen AbiValue
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (AbiType -> Gen AbiValue
genAbiValue AbiType
t))
        AbiValue -> Gen AbiValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbiType -> Vector AbiValue -> AbiValue
AbiArrayDynamic AbiType
t ([AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList [AbiValue]
xs))
   AbiArrayType Int
n AbiType
t ->
     Int -> AbiType -> Vector AbiValue -> AbiValue
AbiArray Int
n AbiType
t (Vector AbiValue -> AbiValue)
-> ([AbiValue] -> Vector AbiValue) -> [AbiValue] -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList ([AbiValue] -> AbiValue) -> Gen [AbiValue] -> Gen AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       Int -> Gen AbiValue -> Gen [AbiValue]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n ((Int -> Int) -> Gen AbiValue -> Gen AbiValue
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (AbiType -> Gen AbiValue
genAbiValue AbiType
t))
   AbiTupleType Vector AbiType
ts ->
     Vector AbiValue -> AbiValue
AbiTuple (Vector AbiValue -> AbiValue)
-> Gen (Vector AbiValue) -> Gen AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbiType -> Gen AbiValue)
-> Vector AbiType -> Gen (Vector AbiValue)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AbiType -> Gen AbiValue
genAbiValue Vector AbiType
ts
  where
    genUInt :: Int -> Gen AbiValue
genUInt Int
n = Int -> Word256 -> AbiValue
AbiUInt Int
n (Word256 -> AbiValue) -> Gen Word256 -> Gen AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Gen Word256
forall a. Integral a => Integer -> Gen a
arbitraryIntegralWithMax (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)

instance Arbitrary AbiType where
  arbitrary :: Gen AbiType
arbitrary = [Gen AbiType] -> Gen AbiType
forall a. [Gen a] -> Gen a
oneof ([Gen AbiType] -> Gen AbiType) -> [Gen AbiType] -> Gen AbiType
forall a b. (a -> b) -> a -> b
$ -- doesn't create any tuples
    [ (Int -> AbiType
AbiUIntType (Int -> AbiType) -> (Int -> Int) -> Int -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) (Int -> AbiType) -> Gen Int -> Gen AbiType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
32)
    , (Int -> AbiType
AbiIntType (Int -> AbiType) -> (Int -> Int) -> Int -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) (Int -> AbiType) -> Gen Int -> Gen AbiType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
32)
    , AbiType -> Gen AbiType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbiType
AbiAddressType
    , AbiType -> Gen AbiType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbiType
AbiBoolType
    , Int -> AbiType
AbiBytesType (Int -> AbiType) -> Gen Int -> Gen AbiType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1,Int
32)
    , AbiType -> Gen AbiType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbiType
AbiBytesDynamicType
    , AbiType -> Gen AbiType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AbiType
AbiStringType
    , AbiType -> AbiType
AbiArrayDynamicType (AbiType -> AbiType) -> Gen AbiType -> Gen AbiType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen AbiType -> Gen AbiType
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen AbiType
forall a. Arbitrary a => Gen a
arbitrary
    , Int -> AbiType -> AbiType
AbiArrayType
        (Int -> AbiType -> AbiType) -> Gen Int -> Gen (AbiType -> AbiType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Positive Int -> Int
forall a. Positive a -> a
getPositive (Positive Int -> Int) -> Gen (Positive Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary)
        Gen (AbiType -> AbiType) -> Gen AbiType -> Gen AbiType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen AbiType -> Gen AbiType
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen AbiType
forall a. Arbitrary a => Gen a
arbitrary
    ]

instance Arbitrary AbiValue where
  arbitrary :: Gen AbiValue
arbitrary = Gen AbiType
forall a. Arbitrary a => Gen a
arbitrary Gen AbiType -> (AbiType -> Gen AbiValue) -> Gen AbiValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AbiType -> Gen AbiValue
genAbiValue
  shrink :: AbiValue -> [AbiValue]
shrink = \case
    AbiArrayDynamic AbiType
t Vector AbiValue
v ->
      Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v [AbiValue] -> [AbiValue] -> [AbiValue]
forall a. [a] -> [a] -> [a]
++
        ([AbiValue] -> AbiValue) -> [[AbiValue]] -> [AbiValue]
forall a b. (a -> b) -> [a] -> [b]
map (AbiType -> Vector AbiValue -> AbiValue
AbiArrayDynamic AbiType
t (Vector AbiValue -> AbiValue)
-> ([AbiValue] -> Vector AbiValue) -> [AbiValue] -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList)
            ((AbiValue -> [AbiValue]) -> [AbiValue] -> [[AbiValue]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList AbiValue -> [AbiValue]
forall a. Arbitrary a => a -> [a]
shrink (Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v))
    AbiBytesDynamic ByteString
b -> ByteString -> AbiValue
AbiBytesDynamic (ByteString -> AbiValue)
-> ([Word8] -> ByteString) -> [Word8] -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> AbiValue) -> [[Word8]] -> [AbiValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> [Word8]) -> [Word8] -> [[Word8]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList Word8 -> [Word8]
forall a. Integral a => a -> [a]
shrinkIntegral (ByteString -> [Word8]
BS.unpack ByteString
b)
    AbiString ByteString
b -> ByteString -> AbiValue
AbiString (ByteString -> AbiValue)
-> ([Word8] -> ByteString) -> [Word8] -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> AbiValue) -> [[Word8]] -> [AbiValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> [Word8]) -> [Word8] -> [[Word8]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList Word8 -> [Word8]
forall a. Integral a => a -> [a]
shrinkIntegral (ByteString -> [Word8]
BS.unpack ByteString
b)
    AbiBytes Int
n ByteString
a | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 -> AbiValue -> [AbiValue]
forall a. Arbitrary a => a -> [a]
shrink (AbiValue -> [AbiValue]) -> AbiValue -> [AbiValue]
forall a b. (a -> b) -> a -> b
$ Int -> Word256 -> AbiValue
AbiUInt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) (ByteString -> Word256
word256 ByteString
a)
    --bytesN for N > 32 don't really exist right now anyway..
    AbiBytes Int
_ ByteString
_ | Bool
otherwise -> []
    AbiArray Int
_ AbiType
t Vector AbiValue
v ->
      Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v [AbiValue] -> [AbiValue] -> [AbiValue]
forall a. [a] -> [a] -> [a]
++
        ([AbiValue] -> AbiValue) -> [[AbiValue]] -> [AbiValue]
forall a b. (a -> b) -> [a] -> [b]
map (\[AbiValue]
x -> Int -> AbiType -> Vector AbiValue -> AbiValue
AbiArray ([AbiValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbiValue]
x) AbiType
t ([AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList [AbiValue]
x))
            ((AbiValue -> [AbiValue]) -> [AbiValue] -> [[AbiValue]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList AbiValue -> [AbiValue]
forall a. Arbitrary a => a -> [a]
shrink (Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v))
    AbiTuple Vector AbiValue
v -> Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
Vector.toList (Vector AbiValue -> [AbiValue]) -> Vector AbiValue -> [AbiValue]
forall a b. (a -> b) -> a -> b
$ Vector AbiValue -> AbiValue
AbiTuple (Vector AbiValue -> AbiValue)
-> (AbiValue -> Vector AbiValue) -> AbiValue -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList ([AbiValue] -> Vector AbiValue)
-> (AbiValue -> [AbiValue]) -> AbiValue -> Vector AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiValue -> [AbiValue]
forall a. Arbitrary a => a -> [a]
shrink (AbiValue -> AbiValue) -> Vector AbiValue -> Vector AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v
    AbiUInt Int
n Word256
a -> Int -> Word256 -> AbiValue
AbiUInt Int
n (Word256 -> AbiValue) -> [Word256] -> [AbiValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word256 -> [Word256]
forall a. Integral a => a -> [a]
shrinkIntegral Word256
a)
    AbiInt Int
n Int256
a -> Int -> Int256 -> AbiValue
AbiInt Int
n (Int256 -> AbiValue) -> [Int256] -> [AbiValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int256 -> [Int256]
forall a. Integral a => a -> [a]
shrinkIntegral Int256
a)
    AbiBool Bool
b -> Bool -> AbiValue
AbiBool (Bool -> AbiValue) -> [Bool] -> [AbiValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Bool]
forall a. Arbitrary a => a -> [a]
shrink Bool
b
    AbiAddress Addr
a -> [Addr -> AbiValue
AbiAddress Addr
0xacab, Addr -> AbiValue
AbiAddress Addr
0xdeadbeef, Addr -> AbiValue
AbiAddress Addr
0xbabeface]
      [AbiValue] -> [AbiValue] -> [AbiValue]
forall a. Semigroup a => a -> a -> a
<> (Addr -> AbiValue
AbiAddress (Addr -> AbiValue) -> [Addr] -> [AbiValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr -> [Addr]
forall a. Integral a => a -> [a]
shrinkIntegral Addr
a)


-- Bool synonym with custom read instance
-- to be able to parse lower case 'false' and 'true'
data Boolz = Boolz Bool

instance Read Boolz where
  readsPrec :: Int -> ReadS Boolz
readsPrec Int
_ (Char
'T':Char
'r':Char
'u':Char
'e':String
x) = [(Bool -> Boolz
Boolz Bool
True, String
x)]
  readsPrec Int
_ (Char
't':Char
'r':Char
'u':Char
'e':String
x) = [(Bool -> Boolz
Boolz Bool
True, String
x)]
  readsPrec Int
_ (Char
'f':Char
'a':Char
'l':Char
's':Char
'e':String
x) = [(Bool -> Boolz
Boolz Bool
False, String
x)]
  readsPrec Int
_ (Char
'F':Char
'a':Char
'l':Char
's':Char
'e':String
x) = [(Bool -> Boolz
Boolz Bool
False, String
x)]
  readsPrec Int
_ [] = []
  readsPrec Int
n (Char
_:String
t) = Int -> ReadS Boolz
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
t

makeAbiValue :: AbiType -> String -> AbiValue
makeAbiValue :: AbiType -> String -> AbiValue
makeAbiValue AbiType
typ String
str = case ReadP AbiValue -> ReadS AbiValue
forall a. ReadP a -> ReadS a
readP_to_S (AbiType -> ReadP AbiValue
parseAbiValue AbiType
typ) (ShowS
padStr String
str) of
  [(AbiValue
val,String
"")] -> AbiValue
val
  [(AbiValue, String)]
_ -> String -> AbiValue
forall a. HasCallStack => String -> a
error (String -> AbiValue) -> String -> AbiValue
forall a b. (a -> b) -> a -> b
$  String
"could not parse abi argument: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AbiType -> String
forall a. Show a => a -> String
show AbiType
typ
  where
    padStr :: ShowS
padStr = case AbiType
typ of
      (AbiBytesType Int
n) -> Int -> ShowS
padRight' (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) -- +2 is for the 0x prefix
      AbiType
_ -> ShowS
forall a. a -> a
id

parseAbiValue :: AbiType -> ReadP AbiValue
parseAbiValue :: AbiType -> ReadP AbiValue
parseAbiValue (AbiUIntType Int
n) = do W256 Word256
w <- ReadS W256 -> ReadP W256
forall a. ReadS a -> ReadP a
readS_to_P ReadS W256
forall a. Read a => ReadS a
reads
                                   AbiValue -> ReadP AbiValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AbiValue -> ReadP AbiValue) -> AbiValue -> ReadP AbiValue
forall a b. (a -> b) -> a -> b
$ Int -> Word256 -> AbiValue
AbiUInt Int
n Word256
w
parseAbiValue (AbiIntType Int
n) = do W256 Word256
w <- ReadS W256 -> ReadP W256
forall a. ReadS a -> ReadP a
readS_to_P ReadS W256
forall a. Read a => ReadS a
reads
                                  AbiValue -> ReadP AbiValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AbiValue -> ReadP AbiValue) -> AbiValue -> ReadP AbiValue
forall a b. (a -> b) -> a -> b
$ Int -> Int256 -> AbiValue
AbiInt Int
n (Word256 -> Int256
forall a b. (Integral a, Num b) => a -> b
num Word256
w)
parseAbiValue AbiType
AbiAddressType = Addr -> AbiValue
AbiAddress (Addr -> AbiValue) -> ReadP Addr -> ReadP AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS Addr -> ReadP Addr
forall a. ReadS a -> ReadP a
readS_to_P ReadS Addr
forall a. Read a => ReadS a
reads
parseAbiValue AbiType
AbiBoolType = (do W256 Word256
w <- ReadS W256 -> ReadP W256
forall a. ReadS a -> ReadP a
readS_to_P ReadS W256
forall a. Read a => ReadS a
reads
                                AbiValue -> ReadP AbiValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AbiValue -> ReadP AbiValue) -> AbiValue -> ReadP AbiValue
forall a b. (a -> b) -> a -> b
$ Bool -> AbiValue
AbiBool (Word256
w Word256 -> Word256 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word256
0))
                            ReadP AbiValue -> ReadP AbiValue -> ReadP AbiValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do Boolz Bool
b <- ReadS Boolz -> ReadP Boolz
forall a. ReadS a -> ReadP a
readS_to_P ReadS Boolz
forall a. Read a => ReadS a
reads
                                    AbiValue -> ReadP AbiValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AbiValue -> ReadP AbiValue) -> AbiValue -> ReadP AbiValue
forall a b. (a -> b) -> a -> b
$ Bool -> AbiValue
AbiBool Bool
b)
parseAbiValue (AbiBytesType Int
n) = Int -> ByteString -> AbiValue
AbiBytes Int
n (ByteString -> AbiValue) -> ReadP ByteString -> ReadP AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do ByteStringS ByteString
bytes <- ReadP ByteStringS
bytesP
                                                   ByteString -> ReadP ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes
parseAbiValue AbiType
AbiBytesDynamicType = ByteString -> AbiValue
AbiBytesDynamic (ByteString -> AbiValue) -> ReadP ByteString -> ReadP AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do ByteStringS ByteString
bytes <- ReadP ByteStringS
bytesP
                                                           ByteString -> ReadP ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes
parseAbiValue AbiType
AbiStringType = ByteString -> AbiValue
AbiString (ByteString -> AbiValue) -> ReadP ByteString -> ReadP AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do String -> ByteString
Char8.pack (String -> ByteString) -> ReadP String -> ReadP ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS String -> ReadP String
forall a. ReadS a -> ReadP a
readS_to_P ReadS String
forall a. Read a => ReadS a
reads
parseAbiValue (AbiArrayDynamicType AbiType
typ) =
  AbiType -> Vector AbiValue -> AbiValue
AbiArrayDynamic AbiType
typ (Vector AbiValue -> AbiValue)
-> ReadP (Vector AbiValue) -> ReadP AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do [AbiValue]
a <- ReadP AbiValue -> ReadP [AbiValue]
forall a. ReadP a -> ReadP [a]
listP (AbiType -> ReadP AbiValue
parseAbiValue AbiType
typ)
                             Vector AbiValue -> ReadP (Vector AbiValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector AbiValue -> ReadP (Vector AbiValue))
-> Vector AbiValue -> ReadP (Vector AbiValue)
forall a b. (a -> b) -> a -> b
$ [AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList [AbiValue]
a
parseAbiValue (AbiArrayType Int
n AbiType
typ) =
  Int -> AbiType -> Vector AbiValue -> AbiValue
AbiArray Int
n AbiType
typ (Vector AbiValue -> AbiValue)
-> ReadP (Vector AbiValue) -> ReadP AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do [AbiValue]
a <- ReadP AbiValue -> ReadP [AbiValue]
forall a. ReadP a -> ReadP [a]
listP (AbiType -> ReadP AbiValue
parseAbiValue AbiType
typ)
                        Vector AbiValue -> ReadP (Vector AbiValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector AbiValue -> ReadP (Vector AbiValue))
-> Vector AbiValue -> ReadP (Vector AbiValue)
forall a b. (a -> b) -> a -> b
$ [AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
Vector.fromList [AbiValue]
a
parseAbiValue (AbiTupleType Vector AbiType
_) = String -> ReadP AbiValue
forall a. HasCallStack => String -> a
error String
"tuple types not supported"

listP :: ReadP a -> ReadP [a]
listP :: ReadP a -> ReadP [a]
listP ReadP a
parser = ReadP Char -> ReadP Char -> ReadP [a] -> ReadP [a]
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (Char -> ReadP Char
char Char
'[') (Char -> ReadP Char
char Char
']') ((do ReadP ()
skipSpaces
                                                  a
a <- ReadP a
parser
                                                  ReadP ()
skipSpaces
                                                  a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a) ReadP a -> ReadP Char -> ReadP [a]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy` (Char -> ReadP Char
char Char
','))

bytesP :: ReadP ByteStringS
bytesP :: ReadP ByteStringS
bytesP = do
  String -> ReadP String
string String
"0x"
  String
hex <- (Char -> Bool) -> ReadP String
munch Char -> Bool
isHexDigit
  case ByteString -> Either String ByteString
BS16.decode (Text -> ByteString
encodeUtf8 (String -> Text
Text.pack String
hex)) of
    Right ByteString
d -> ByteStringS -> ReadP ByteStringS
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStringS -> ReadP ByteStringS)
-> ByteStringS -> ReadP ByteStringS
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
d
    Left String
d -> ReadP ByteStringS
forall a. ReadP a
pfail

data AbiVals = NoVals | CAbi [AbiValue] | SAbi [SymWord]
  deriving (Int -> AbiVals -> ShowS
[AbiVals] -> ShowS
AbiVals -> String
(Int -> AbiVals -> ShowS)
-> (AbiVals -> String) -> ([AbiVals] -> ShowS) -> Show AbiVals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbiVals] -> ShowS
$cshowList :: [AbiVals] -> ShowS
show :: AbiVals -> String
$cshow :: AbiVals -> String
showsPrec :: Int -> AbiVals -> ShowS
$cshowsPrec :: Int -> AbiVals -> ShowS
Show)

decodeBuffer :: [AbiType] -> Buffer -> AbiVals
decodeBuffer :: [AbiType] -> Buffer -> AbiVals
decodeBuffer [AbiType]
tps (ConcreteBuffer ByteString
b)
  = case Get (Vector AbiValue)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Vector AbiValue)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq ([AbiType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbiType]
tps) [AbiType]
tps) (ByteString -> ByteString
BSLazy.fromStrict ByteString
b) of
      Right (ByteString
"", ByteOffset
_, Vector AbiValue
args) -> [AbiValue] -> AbiVals
CAbi ([AbiValue] -> AbiVals)
-> (Vector AbiValue -> [AbiValue]) -> Vector AbiValue -> AbiVals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
toList (Vector AbiValue -> AbiVals) -> Vector AbiValue -> AbiVals
forall a b. (a -> b) -> a -> b
$ Vector AbiValue
args
      Either
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, Vector AbiValue)
_ -> AbiVals
NoVals
decodeBuffer [AbiType]
tps b :: Buffer
b@(SymbolicBuffer [SWord 8]
_)
  = if [AbiType] -> Bool
containsDynamic [AbiType]
tps
    then AbiVals
NoVals
    else [SymWord] -> AbiVals
SAbi ([SymWord] -> AbiVals)
-> (Buffer -> [SymWord]) -> Buffer -> AbiVals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> [SymWord]
decodeStaticArgs (Buffer -> AbiVals) -> Buffer -> AbiVals
forall a b. (a -> b) -> a -> b
$ Buffer
b
  where
    isDynamic :: AbiType -> Bool
isDynamic AbiType
t = AbiType -> AbiKind
abiKind AbiType
t AbiKind -> AbiKind -> Bool
forall a. Eq a => a -> a -> Bool
== AbiKind
Dynamic
    containsDynamic :: [AbiType] -> Bool
containsDynamic = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([AbiType] -> [Bool]) -> [AbiType] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbiType -> Bool) -> [AbiType] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbiType -> Bool
isDynamic

decodeStaticArgs :: Buffer -> [SymWord]
decodeStaticArgs :: Buffer -> [SymWord]
decodeStaticArgs Buffer
buffer = let
    bs :: [SWord 8]
bs = case Buffer
buffer of
      ConcreteBuffer ByteString
b -> ByteString -> [SWord 8]
litBytes ByteString
b
      SymbolicBuffer [SWord 8]
b -> [SWord 8]
b
  in (Int -> SymWord) -> [Int] -> [SymWord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
i -> Whiff -> SWord 256 -> SymWord
S (Buffer -> Whiff
FromBytes Buffer
buffer) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$
            [SWord 8] -> SWord 256
forall a. ByteConverter a => [SWord 8] -> a
fromBytes ([SWord 8] -> SWord 256) -> [SWord 8] -> SWord 256
forall a b. (a -> b) -> a -> b
$ Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
take Int
32 (Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
32) [SWord 8]
bs)) [Int
0..(([SWord 8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SWord 8]
bs) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

-- 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 :: Integer -> Gen a
arbitraryIntegralWithMax Integer
maxbound =
  (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen a) -> Gen a) -> (Int -> Gen a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \Int
s ->
    do let mn :: Int
mn = Int
0 :: Int
           mx :: Integer
mx = Integer
maxbound
           bits :: t -> p
bits t
n | t
n t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = p
0
                  | Bool
otherwise = p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ t -> p
bits (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2)
           k :: Integer
k  = Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int -> Int
forall a b. (Integral a, Num b) => a -> b
bits Int
mn Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Integer -> Int
forall a b. (Integral a, Num b) => a -> b
bits Integer
mx Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100)
       Integer
smol <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
mn Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`max` (-Integer
k), Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
mx Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`min` Integer
k)
       Integer
mid <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
maxbound)
       [a] -> Gen a
forall a. [a] -> Gen a
elements [Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
smol, Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
mid, Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
maxbound Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
smol))]