{-

  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
  , decodeBuf
  , decodeStaticArgs
  , formatString
  , parseTypeName
  , makeAbiValue
  , parseAbiValue
  , selector
  ) where

import EVM.Types
import EVM.Expr (readWord, isLitWord)

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.Data          (Data)
import Data.DoubleWord    (Word256, Int256, signedWord)
import Data.Functor       (($>))
import Data.Text          (Text)
import Data.List          (intercalate)
import Data.Text.Encoding (encodeUtf8)
import Data.Vector        (Vector, toList)
import Data.Word          (Word32)
import Data.Maybe         (mapMaybe)
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)
  | AbiFunction     BS.ByteString
  deriving (ReadPrec [AbiValue]
ReadPrec AbiValue
Int -> ReadS AbiValue
ReadS [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
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
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
Ord, 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)         = forall a. Show a => a -> String
show Word256
n
  show (AbiInt  Int
_ Int256
n)         = forall a. Show a => a -> String
show Int256
n
  show (AbiAddress Addr
n)        = 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)   = forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
b)
  show (AbiBytesDynamic ByteString
b)   = 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
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v) forall a. [a] -> [a] -> [a]
++ String
"]"
  show (AbiArray      Int
_ AbiType
_ Vector AbiValue
v) =
    String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v) forall a. [a] -> [a] -> [a]
++ String
"]"
  show (AbiTuple Vector AbiValue
v) =
    String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v) forall a. [a] -> [a] -> [a]
++ String
")"
  show (AbiFunction ByteString
b)       = forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
b)

data AbiType
  = AbiUIntType         Int
  | AbiIntType          Int
  | AbiAddressType
  | AbiBoolType
  | AbiBytesType        Int
  | AbiBytesDynamicType
  | AbiStringType
  | AbiArrayDynamicType AbiType
  | AbiArrayType        Int AbiType
  | AbiTupleType        (Vector AbiType)
  | AbiFunctionType
  deriving (ReadPrec [AbiType]
ReadPrec AbiType
Int -> ReadS AbiType
ReadS [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
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
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
Ord, 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, Typeable AbiType
AbiType -> DataType
AbiType -> Constr
(forall b. Data b => b -> b) -> AbiType -> AbiType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AbiType -> u
forall u. (forall d. Data d => d -> u) -> AbiType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbiType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbiType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbiType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbiType -> c AbiType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbiType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbiType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbiType -> m AbiType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbiType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbiType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AbiType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AbiType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbiType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbiType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbiType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbiType -> r
gmapT :: (forall b. Data b => b -> b) -> AbiType -> AbiType
$cgmapT :: (forall b. Data b => b -> b) -> AbiType -> AbiType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbiType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbiType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbiType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbiType)
dataTypeOf :: AbiType -> DataType
$cdataTypeOf :: AbiType -> DataType
toConstr :: AbiType -> Constr
$ctoConstr :: AbiType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbiType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbiType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbiType -> c AbiType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbiType -> c AbiType
Data)

instance Show AbiType where
  show :: AbiType -> String
show = Text -> String
Text.unpack 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
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]
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
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
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
Ord, 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
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
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
Ord, Anonymity -> Anonymity -> Bool
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. 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
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
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
Ord, Indexed -> Indexed -> Bool
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. 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
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
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
Ord, Event -> Event -> Bool
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. 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
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
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
Ord, SolError -> SolError -> Bool
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. 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)

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

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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (AbiType -> AbiKind
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v)
  AbiFunction ByteString
_       -> AbiType
AbiFunctionType

getAbi :: AbiType -> Get AbiValue
getAbi :: AbiType -> Get AbiValue
getAbi AbiType
t = forall a. String -> Get a -> Get a
label (Text -> String
Text.unpack (AbiType -> Text
abiTypeSolidity AbiType
t)) forall a b. (a -> b) -> a -> b
$
  case AbiType
t of
    AbiUIntType Int
n  -> do
      let word32Count :: Int
word32Count = Int
8 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> a -> a
div (Int
n forall a. Num a => a -> a -> a
+ Int
255) Int
256
      [Word32]
xs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
word32Count Get Word32
getWord32be
      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   -> forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt Int
n (Int -> Int256 -> AbiValue
AbiInt Int
n)
    AbiType
AbiAddressType -> forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt Int
256 Addr -> AbiValue
AbiAddress
    AbiType
AbiBoolType    -> forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt Int
256 (Bool -> AbiValue
AbiBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ord a => a -> a -> Bool
> (Integer
0 :: Integer)))

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

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

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

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

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

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

    AbiType
AbiFunctionType ->
      ByteString -> AbiValue
AbiFunction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => a -> Get ByteString
getBytesWith256BitPadding (Int
24 :: Int)

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

  AbiInt Int
n Int256
x   -> AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int256
x))
  AbiAddress Addr
x -> AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt Int
160 (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
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
nforall a. Num a => a -> a -> a
-Int
1] (Word8 -> Put
putWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
xs)
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (forall a. Integral a => a -> a
roundTo32Bytes Int
n 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 (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (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

  AbiFunction ByteString
b -> do
    AbiValue -> Put
putAbi (Int -> ByteString -> AbiValue
AbiBytes Int
24 ByteString
b)

-- | 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 = forall a. String -> Get a -> Get a
label String
"sequence" forall a b. (a -> b) -> a -> b
$ do
  [Either AbiType AbiValue]
hs <- forall a. String -> Get a -> Get a
label String
"sequence head" (Int -> [AbiType] -> Get [Either AbiType AbiValue]
getAbiHead Int
n [AbiType]
ts)
  forall a. [a] -> Vector a
Vector.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall a. String -> Get a -> Get a
label String
"sequence tail" (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either AbiType -> Get AbiValue
getAbi 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]
_      = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getAbiHead Int
_ []     = 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 ->
      (forall a b. a -> Either a b
Left AbiType
t :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Get ()
skip Int
32 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> [AbiType] -> Get [Either AbiType AbiValue]
getAbiHead (Int
n 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 forall a. Num a => a -> a -> a
- Int
1) [AbiType]
ts
         forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right AbiValue
x 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  -> 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 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a
roundTo32Bytes (ByteString -> Int
BS.length ByteString
s)
        AbiBytesDynamic ByteString
s -> Int
32 forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> a
roundTo32Bytes (ByteString -> Int
BS.length ByteString
s)
        AbiArrayDynamic AbiType
_ Vector AbiValue
xs -> Int
32 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AbiValue -> Int
abiHeadSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs) forall a. Semigroup a => a -> a -> a
<> (AbiValue -> Int
abiTailSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs))
        AbiArray Int
_ AbiType
_ Vector AbiValue
xs -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AbiValue -> Int
abiHeadSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs) forall a. Semigroup a => a -> a -> a
<> (AbiValue -> Int
abiTailSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs))
        AbiTuple Vector AbiValue
v -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((AbiValue -> Int
abiHeadSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v) forall a. Semigroup a => a -> a -> a
<> (AbiValue -> Int
abiTailSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v))
        AbiValue
_ -> 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
_ -> forall a. Integral a => a -> a
roundTo32Bytes Int
n
        AbiAddress Addr
_ -> Int
32
        AbiBool Bool
_    -> Int
32
        AbiTuple Vector AbiValue
v   -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (AbiValue -> Int
abiHeadSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
v)
        AbiArray Int
_ AbiType
_ Vector AbiValue
xs -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (AbiValue -> Int
abiHeadSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs)
        AbiFunction ByteString
_ -> Int
32
        AbiValue
_ -> 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 forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
toList Vector AbiValue
xs
     forall (m :: * -> *) a. Monad m => Vector (m a) -> m ()
Vector.sequence_ (AbiValue -> Put
putAbiTail forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AbiValue
xs)
  where
    headSize :: Int
headSize = forall a. Num a => Vector a -> a
Vector.sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
Vector.map AbiValue -> Int
abiHeadSize Vector AbiValue
xs
    putHeads :: Int -> [AbiValue] -> Put
putHeads Int
_ [] = 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset))
                      Int -> [AbiValue] -> Put
putHeads (Int
offset 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbiValue -> Put
putAbi

decodeAbiValue :: AbiType -> BSLazy.ByteString -> AbiValue
decodeAbiValue :: AbiType -> ByteString -> AbiValue
decodeAbiValue = forall a. Get a -> ByteString -> a
runGet 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$
  Word32 -> Put
putWord32be (ByteString -> FunctionSelector
abiKeccak (Text -> ByteString
encodeUtf8 Text
s)).unFunctionSelector

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

parseTypeName :: Vector AbiType -> Text -> Maybe AbiType
parseTypeName :: Vector AbiType -> Text -> Maybe AbiType
parseTypeName = forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe 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 <-
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between
        (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
']')
        (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many 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 (forall a. Read a => String -> a
read String
s) AbiType
t

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
    [ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"address" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AbiType
AbiAddressType
    , forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"bool"    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AbiType
AbiBoolType
    , forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"string"  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

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

  where
    sizedType :: Text -> (Int -> AbiType) -> P.Parsec () Text AbiType
    sizedType :: Text -> (Int -> AbiType) -> Parsec () Text AbiType
sizedType Text
s Int -> AbiType
f = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try forall a b. (a -> b) -> a -> b
$ do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Text
s)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> AbiType
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some 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 =
  forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ forall a. Bits a => a -> Int -> a
shiftL Word256
x ((Int
n forall a. Num a => a -> a -> a
- Int
i) forall a. Num a => a -> a -> a
* Int
32)
      | (Word256
x, Int
i) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word32]
xs) [Int
1..] ]

asUInt :: Integral i => Int -> (i -> a) -> Get a
asUInt :: forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt Int
n i -> a
f = AbiValue -> a
y forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbiType -> Get AbiValue
getAbi (Int -> AbiType
AbiUIntType Int
n)
  where y :: AbiValue -> a
y (AbiUInt Int
_ Word256
x) = i -> a
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word256
x)
        y AbiValue
_ = forall a. HasCallStack => String -> a
error String
"can't happen"

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

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

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

getBytesWith256BitPadding :: Integral a => a -> Get ByteString
getBytesWith256BitPadding :: forall a. Integral a => a -> Get ByteString
getBytesWith256BitPadding a
i =
  ([Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Get Word8
getWord8)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Get ()
skip ((forall a. Integral a => a -> a
roundTo32Bytes Int
n) forall a. Num a => a -> a -> a
- Int
n)
  where n :: Int
n = 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 -> Word256 -> AbiValue
AbiUInt Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word256
genUInt Int
n
   AbiIntType Int
n -> do
     Word256
x <- Int -> Gen Word256
genUInt Int
n
     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int256 -> AbiValue
AbiInt Int
n (forall w. BinaryWord w => w -> SignedWord w
signedWord (Word256
x forall a. Num a => a -> a -> a
- Word256
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nforall a. Num a => a -> a -> a
-Int
1)))
   AbiType
AbiAddressType ->
     Addr -> AbiValue
AbiAddress forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word256
genUInt Int
20
   AbiType
AbiBoolType ->
     forall a. [a] -> Gen a
elements [Bool -> AbiValue
AbiBool Bool
False, Bool -> AbiValue
AbiBool Bool
True]
   AbiBytesType Int
n ->
     do [Word8]
xs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n forall a. Arbitrary a => Gen a
arbitrary
        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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
arbitrary
   AbiType
AbiStringType ->
     ByteString -> AbiValue
AbiString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
arbitrary
   AbiArrayDynamicType AbiType
t ->
     do [AbiValue]
xs <- forall a. Gen a -> Gen [a]
listOf1 (forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
2) (AbiType -> Gen AbiValue
genAbiValue AbiType
t))
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbiType -> Vector AbiValue -> AbiValue
AbiArrayDynamic AbiType
t (forall a. [a] -> Vector a
Vector.fromList [AbiValue]
xs))
   AbiArrayType Int
n AbiType
t ->
     Int -> AbiType -> Vector AbiValue -> AbiValue
AbiArray Int
n AbiType
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
Vector.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
2) (AbiType -> Gen AbiValue
genAbiValue AbiType
t))
   AbiTupleType Vector AbiType
ts ->
     Vector AbiValue -> AbiValue
AbiTuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
   AbiType
AbiFunctionType ->
     do [Word8]
xs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
24 forall a. Arbitrary a => Gen a
arbitrary
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> AbiValue
AbiFunction ([Word8] -> ByteString
BS.pack [Word8]
xs))
  where
    genUInt :: Int -> Gen Word256
    genUInt :: Int -> Gen Word256
genUInt Int
n = forall a. Integral a => Integer -> Gen a
arbitraryIntegralWithMax (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
nforall a. Num a => a -> a -> a
-Integer
1) :: Gen Word256

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

instance Arbitrary AbiValue where
  arbitrary :: Gen AbiValue
arbitrary = forall a. Arbitrary a => Gen a
arbitrary 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 ->
      forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v forall a. [a] -> [a] -> [a]
++
        forall a b. (a -> b) -> [a] -> [b]
map (AbiType -> Vector AbiValue -> AbiValue
AbiArrayDynamic AbiType
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
Vector.fromList)
            (forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList forall a. Arbitrary a => a -> [a]
shrink (forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v))
    AbiBytesDynamic ByteString
b -> ByteString -> AbiValue
AbiBytesDynamic forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList forall a. Integral a => a -> [a]
shrinkIntegral (ByteString -> [Word8]
BS.unpack ByteString
b)
    AbiString ByteString
b -> ByteString -> AbiValue
AbiString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList forall a. Integral a => a -> [a]
shrinkIntegral (ByteString -> [Word8]
BS.unpack ByteString
b)
    AbiBytes Int
n ByteString
a | Int
n forall a. Ord a => a -> a -> Bool
<= Int
32 -> forall a. Arbitrary a => a -> [a]
shrink forall a b. (a -> b) -> a -> b
$ Int -> Word256 -> AbiValue
AbiUInt (Int
n 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 ->
      forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v forall a. [a] -> [a] -> [a]
++
        forall a b. (a -> b) -> [a] -> [b]
map (\[AbiValue]
x -> Int -> AbiType -> Vector AbiValue -> AbiValue
AbiArray (forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbiValue]
x) AbiType
t (forall a. [a] -> Vector a
Vector.fromList [AbiValue]
x))
            (forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList forall a. Arbitrary a => a -> [a]
shrink (forall a. Vector a -> [a]
Vector.toList Vector AbiValue
v))
    AbiTuple Vector AbiValue
v -> forall a. Vector a -> [a]
Vector.toList forall a b. (a -> b) -> a -> b
$ Vector AbiValue -> AbiValue
AbiTuple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Integral a => a -> [a]
shrinkIntegral Word256
a)
    AbiInt Int
n Int256
a -> Int -> Int256 -> AbiValue
AbiInt Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Integral a => a -> [a]
shrinkIntegral Int256
a)
    AbiBool Bool
b -> Bool -> AbiValue
AbiBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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]
      forall a. Semigroup a => a -> a -> a
<> (Addr -> AbiValue
AbiAddress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => a -> [a]
shrinkIntegral Addr
a)
    AbiFunction ByteString
b -> forall a. Arbitrary a => a -> [a]
shrink forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> AbiValue
AbiBytes Int
24 ByteString
b


-- 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 :: 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) = 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 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)]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$  String
"could not parse abi argument: " forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
" : " forall a. [a] -> [a] -> [a]
++ 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 forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
2) -- +2 is for the 0x prefix
      AbiType
_ -> forall a. a -> a
id

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

listP :: ReadP a -> ReadP [a]
listP :: forall a. ReadP a -> ReadP [a]
listP ReadP a
parser = 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
                                                  forall (m :: * -> *) a. Monad m => a -> m a
return a
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
_ <- String -> ReadP String
string String
"0x"
  String
hex <- (Char -> Bool) -> ReadP String
munch Char -> Bool
isHexDigit
  case ByteString -> Either Text ByteString
BS16.decodeBase16 (Text -> ByteString
encodeUtf8 (String -> Text
Text.pack String
hex)) of
    Right ByteString
d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
d
    Left Text
_ -> forall a. ReadP a
pfail

data AbiVals = NoVals | CAbi [AbiValue] | SAbi [Expr EWord]
  deriving (Int -> AbiVals -> ShowS
[AbiVals] -> ShowS
AbiVals -> String
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)

decodeBuf :: [AbiType] -> Expr Buf -> AbiVals
decodeBuf :: [AbiType] -> Expr 'Buf -> AbiVals
decodeBuf [AbiType]
tps (ConcreteBuf ByteString
b)
  = case forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq (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 (forall a. Vector a -> [a]
toList Vector AbiValue
args)
      Either
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, Vector AbiValue)
_ -> AbiVals
NoVals
decodeBuf [AbiType]
tps Expr 'Buf
buf
  = if [AbiType] -> Bool
containsDynamic [AbiType]
tps
    then AbiVals
NoVals
    else let
      vs :: [Expr 'EWord]
vs = Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbiType]
tps) Expr 'Buf
buf
      allLit :: Bool
allLit = forall (t :: * -> *). Foldable t => t Bool -> Bool
Prelude.and forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr 'EWord -> Bool
isLitWord) forall a b. (a -> b) -> a -> b
$ [Expr 'EWord]
vs
      asBS :: ByteString
asBS = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap W256 -> ByteString
word256Bytes (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Expr 'EWord -> Maybe W256
maybeLitWord [Expr 'EWord]
vs)
    in if Bool -> Bool
not Bool
allLit
       then [Expr 'EWord] -> AbiVals
SAbi [Expr 'EWord]
vs
       else case forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq (forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbiType]
tps) [AbiType]
tps) (ByteString -> ByteString
BSLazy.fromStrict ByteString
asBS) of
         Right (ByteString
"", ByteOffset
_, Vector AbiValue
args) -> [AbiValue] -> AbiVals
CAbi (forall a. Vector a -> [a]
toList Vector AbiValue
args)
         Either
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, Vector AbiValue)
_ -> AbiVals
NoVals

  where
    isDynamic :: AbiType -> Bool
isDynamic AbiType
t = AbiType -> AbiKind
abiKind AbiType
t forall a. Eq a => a -> a -> Bool
== AbiKind
Dynamic
    containsDynamic :: [AbiType] -> Bool
containsDynamic = forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbiType -> Bool
isDynamic

decodeStaticArgs :: Int -> Int -> Expr Buf -> [Expr EWord]
decodeStaticArgs :: Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
offset Int
numArgs Expr 'Buf
b = [Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ Int
i) Expr 'Buf
b | Int
i <- [Int
offset,(Int
offsetforall a. Num a => a -> a -> a
+Int
32) .. (Int
offset forall a. Num a => a -> a -> a
+ (Int
numArgsforall a. Num a => a -> a -> a
-Int
1)forall a. Num a => a -> a -> a
*Int
32)]]


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