{-# Language StrictData #-}
{-# Language DataKinds #-}
module EVM.ABI
( AbiValue (..)
, AbiType (..)
, AbiKind (..)
, AbiVals (..)
, abiKind
, Event (..)
, 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.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 (SWord, 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.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)
instance Show AbiValue where
show :: AbiValue -> String
show (AbiUInt _ n :: Word256
n) = Word256 -> String
forall a. Show a => a -> String
show Word256
n
show (AbiInt _ n :: Int256
n) = Int256 -> String
forall a. Show a => a -> String
show Int256
n
show (AbiAddress n :: Addr
n) = Addr -> String
forall a. Show a => a -> String
show Addr
n
show (AbiBool b :: Bool
b) = if Bool
b then "true" else "false"
show (AbiBytes _ b :: ByteString
b) = ByteStringS -> String
forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
b)
show (AbiBytesDynamic b :: ByteString
b) = ByteStringS -> String
forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
b)
show (AbiString s :: ByteString
s) = ByteString -> String
formatString ByteString
s
show (AbiArrayDynamic _ v :: Vector AbiValue
v) =
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " (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]
++ "]"
show (AbiArray _ _ v :: Vector AbiValue
v) =
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " (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]
++ "]"
show (AbiTuple v :: Vector AbiValue
v) =
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " (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]
++ ")"
formatString :: ByteString -> String
formatString :: ByteString -> String
formatString bs :: 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
== 0) ByteString
bs)) of
Right s :: Text
s -> "\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\""
Left _ -> "❮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 [(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)
abiKind :: AbiType -> AbiKind
abiKind :: AbiType -> AbiKind
abiKind = \case
AbiBytesDynamicType -> AbiKind
Dynamic
AbiStringType -> AbiKind
Dynamic
AbiArrayDynamicType _ -> AbiKind
Dynamic
AbiArrayType _ t :: AbiType
t -> AbiType -> AbiKind
abiKind AbiType
t
AbiTupleType ts :: 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
_ -> AbiKind
Static
abiValueType :: AbiValue -> AbiType
abiValueType :: AbiValue -> AbiType
abiValueType = \case
AbiUInt n :: Int
n _ -> Int -> AbiType
AbiUIntType Int
n
AbiInt n :: Int
n _ -> Int -> AbiType
AbiIntType Int
n
AbiAddress _ -> AbiType
AbiAddressType
AbiBool _ -> AbiType
AbiBoolType
AbiBytes n :: Int
n _ -> Int -> AbiType
AbiBytesType Int
n
AbiBytesDynamic _ -> AbiType
AbiBytesDynamicType
AbiString _ -> AbiType
AbiStringType
AbiArrayDynamic t :: AbiType
t _ -> AbiType -> AbiType
AbiArrayDynamicType AbiType
t
AbiArray n :: Int
n t :: AbiType
t _ -> Int -> AbiType -> AbiType
AbiArrayType Int
n AbiType
t
AbiTuple v :: 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 n :: Int
n -> "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 n :: Int
n -> "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)
AbiAddressType -> "address"
AbiBoolType -> "bool"
AbiBytesType n :: Int
n -> "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)
AbiBytesDynamicType -> "bytes"
AbiStringType -> "string"
AbiArrayDynamicType t :: AbiType
t -> AbiType -> Text
abiTypeSolidity AbiType
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "[]"
AbiArrayType n :: Int
n t :: AbiType
t -> AbiType -> Text
abiTypeSolidity AbiType
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "[" 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
<> "]"
AbiTupleType ts :: Vector AbiType
ts -> "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
Text.intercalate "," ([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
<> ")"
getAbi :: AbiType -> Get AbiValue
getAbi :: AbiType -> Get AbiValue
getAbi t :: 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 n :: Int
n -> do
let word32Count :: Int
word32Count = 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
+ 255) 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 n :: 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)
AbiAddressType -> Int -> (Addr -> AbiValue) -> Get AbiValue
forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt 256 Addr -> AbiValue
AbiAddress
AbiBoolType -> Int -> (Integer -> AbiValue) -> Get AbiValue
forall i a. Integral i => Int -> (i -> a) -> Get a
asUInt 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
> (0 :: Integer)))
AbiBytesType n :: 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
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 "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 "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)
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 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 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 n :: Int
n t' :: 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 t' :: AbiType
t' -> do
AbiUInt _ n :: Word256
n <- String -> Get AbiValue -> Get AbiValue
forall a. String -> Get a -> Get a
label "array length" (AbiType -> Get AbiValue
getAbi (Int -> AbiType
AbiUIntType 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 "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 ts :: 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 _ x :: 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 [0 .. 7]) ((Int -> Put) -> Put) -> (Int -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \i :: 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
* 32) Word256 -> Word256 -> Word256
forall a. Bits a => a -> a -> a
.&. 0xffffffff))
AbiInt n :: Int
n x :: 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 x :: Addr
x -> AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt 160 (Addr -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Addr
x))
AbiBool x :: Bool
x -> AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt 8 (if Bool
x then 1 else 0))
AbiBytes n :: Int
n xs :: ByteString
xs -> do
[Int] -> (Int -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-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 0)
AbiBytesDynamic xs :: ByteString
xs -> do
let n :: Int
n = ByteString -> Int
BS.length ByteString
xs
AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt 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 s :: ByteString
s ->
AbiValue -> Put
putAbi (ByteString -> AbiValue
AbiBytesDynamic ByteString
s)
AbiArray _ _ xs :: Vector AbiValue
xs ->
Vector AbiValue -> Put
putAbiSeq Vector AbiValue
xs
AbiArrayDynamic _ xs :: Vector AbiValue
xs -> do
AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt 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 v :: Vector AbiValue
v ->
Vector AbiValue -> Put
putAbiSeq Vector AbiValue
v
getAbiSeq :: Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq :: Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq n :: Int
n ts :: [AbiType]
ts = String -> Get (Vector AbiValue) -> Get (Vector AbiValue)
forall a. String -> Get a -> Get a
label "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 "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 "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 0 _ = [Either AbiType AbiValue] -> Get [Either AbiType AbiValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getAbiHead _ [] = String -> Get [Either AbiType AbiValue]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "ran out of types"
getAbiHead n :: Int
n (t :: AbiType
t:ts :: [AbiType]
ts) =
case AbiType -> AbiKind
abiKind AbiType
t of
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 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
- 1) [AbiType]
ts)
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
- 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 x :: AbiValue
x =
case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
Static -> () -> Put
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Dynamic -> AbiValue -> Put
putAbi AbiValue
x
abiTailSize :: AbiValue -> Int
abiTailSize :: AbiValue -> Int
abiTailSize x :: AbiValue
x =
case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
Static -> 0
Dynamic ->
case AbiValue
x of
AbiString s :: ByteString
s -> 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 s :: ByteString
s -> 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 _ xs :: Vector AbiValue
xs -> 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 _ _ xs :: 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 v :: 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))
_ -> String -> Int
forall a. HasCallStack => String -> a
error "impossible"
abiHeadSize :: AbiValue -> Int
abiHeadSize :: AbiValue -> Int
abiHeadSize x :: AbiValue
x =
case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
Dynamic -> 32
Static ->
case AbiValue
x of
AbiUInt _ _ -> 32
AbiInt _ _ -> 32
AbiBytes n :: Int
n _ -> Int -> Int
forall a. Integral a => a -> a
roundTo32Bytes Int
n
AbiAddress _ -> 32
AbiBool _ -> 32
AbiTuple v :: 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 _ _ xs :: 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)
_ -> String -> Int
forall a. HasCallStack => String -> a
error "impossible"
putAbiSeq :: Vector AbiValue -> Put
putAbiSeq :: Vector AbiValue -> Put
putAbiSeq xs :: 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 _ [] = () -> Put
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
putHeads offset :: Int
offset (x :: AbiValue
x:xs' :: [AbiValue]
xs') =
case AbiType -> AbiKind
abiKind (AbiValue -> AbiType
abiValueType AbiValue
x) of
Static -> do AbiValue -> Put
putAbi AbiValue
x
Int -> [AbiValue] -> Put
putHeads Int
offset [AbiValue]
xs'
Dynamic -> do AbiValue -> Put
putAbi (Int -> Word256 -> AbiValue
AbiUInt 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 s :: 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 s :: Text
s args :: 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 v :: 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 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 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 t :: AbiType
t "" = AbiType -> AbiType
AbiArrayDynamicType AbiType
t
parseSize t :: AbiType
t s :: 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 v :: 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 "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 "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 "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 "uint" Int -> AbiType
AbiUIntType
, Text -> (Int -> AbiType) -> Parsec () Text AbiType
sizedType "int" Int -> AbiType
AbiIntType
, Text -> (Int -> AbiType) -> Parsec () Text AbiType
sizedType "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 "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 "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 s :: Text
s f :: 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 n :: Int
n xs :: [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
* 32)
| (x :: Word256
x, i :: 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) [1..] ]
asUInt :: Integral i => Int -> (i -> a) -> Get a
asUInt :: Int -> (i -> a) -> Get a
asUInt n :: Int
n f :: i -> a
f = (\(AbiUInt _ x :: 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 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 8 Get Word32
getWord32be
roundTo32Bytes :: Integral a => a -> a
roundTo32Bytes :: a -> a
roundTo32Bytes n :: a
n = 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
+ 31) 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 i :: 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
genAbiValue :: AbiType -> Gen AbiValue
genAbiValue :: AbiType -> Gen AbiValue
genAbiValue = \case
AbiUIntType n :: Int
n -> Int -> Gen AbiValue
genUInt Int
n
AbiIntType n :: Int
n ->
do AbiValue
a <- Int -> Gen AbiValue
genUInt Int
n
let AbiUInt _ x :: 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
- 2Word256 -> Int -> Word256
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)))
AbiAddressType ->
(\(AbiUInt _ x :: 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 20
AbiBoolType ->
[AbiValue] -> Gen AbiValue
forall a. [a] -> Gen a
elements [Bool -> AbiValue
AbiBool Bool
False, Bool -> AbiValue
AbiBool Bool
True]
AbiBytesType n :: 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))
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
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 t :: 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` 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 n :: Int
n t :: 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` 2) (AbiType -> Gen AbiValue
genAbiValue AbiType
t))
AbiTupleType ts :: 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 n :: 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 (2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-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
$
[ (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
* 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 (1, 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
* 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 (1, 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 (1,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` 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` 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 t :: AbiType
t v :: 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 b :: 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 b :: 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 n :: Int
n a :: ByteString
a | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
* 8) (ByteString -> Word256
word256 ByteString
a)
AbiBytes _ _ | Bool
otherwise -> []
AbiArray _ t :: AbiType
t v :: 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 (\x :: [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 v :: 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 n :: Int
n a :: 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 n :: Int
n a :: 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 b :: 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 a :: Addr
a -> [Addr -> AbiValue
AbiAddress 0xacab, Addr -> AbiValue
AbiAddress 0xdeadbeef, Addr -> AbiValue
AbiAddress 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)
data Boolz = Boolz Bool
instance Read Boolz where
readsPrec :: Int -> ReadS Boolz
readsPrec _ ('T':'r':'u':'e':x :: String
x) = [(Bool -> Boolz
Boolz Bool
True, String
x)]
readsPrec _ ('t':'r':'u':'e':x :: String
x) = [(Bool -> Boolz
Boolz Bool
True, String
x)]
readsPrec _ ('f':'a':'l':'s':'e':x :: String
x) = [(Bool -> Boolz
Boolz Bool
False, String
x)]
readsPrec _ ('F':'a':'l':'s':'e':x :: String
x) = [(Bool -> Boolz
Boolz Bool
False, String
x)]
readsPrec _ [] = []
readsPrec n :: Int
n (_:t :: 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 typ :: AbiType
typ str :: String
str = case ReadP AbiValue -> ReadS AbiValue
forall a. ReadP a -> ReadS a
readP_to_S (AbiType -> ReadP AbiValue
parseAbiValue AbiType
typ) String
str of
[(val :: AbiValue
val,"")] -> AbiValue
val
_ -> String -> AbiValue
forall a. HasCallStack => String -> a
error (String -> AbiValue) -> String -> AbiValue
forall a b. (a -> b) -> a -> b
$ "could not parse abi argument: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ " : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AbiType -> String
forall a. Show a => a -> String
show AbiType
typ
parseAbiValue :: AbiType -> ReadP AbiValue
parseAbiValue :: AbiType -> ReadP AbiValue
parseAbiValue (AbiUIntType n :: Int
n) = do W256 w :: 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 n :: Int
n) = do W256 w :: 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 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 AbiBoolType = (do W256 w :: 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
/= 0))
ReadP AbiValue -> ReadP AbiValue -> ReadP AbiValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do Boolz b :: 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 n :: 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 bytes :: ByteString
bytes <- ReadS ByteStringS -> ReadP ByteStringS
forall a. ReadS a -> ReadP a
readS_to_P ReadS ByteStringS
forall a. Read a => ReadS a
reads
ByteString -> ReadP ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes
parseAbiValue AbiBytesDynamicType = ByteString -> AbiValue
AbiBytesDynamic (ByteString -> AbiValue) -> ReadP ByteString -> ReadP AbiValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do ByteStringS bytes :: ByteString
bytes <- ReadS ByteStringS -> ReadP ByteStringS
forall a. ReadS a -> ReadP a
readS_to_P ReadS ByteStringS
forall a. Read a => ReadS a
reads
ByteString -> ReadP ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes
parseAbiValue 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 typ :: 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 n :: Int
n typ :: 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 _) = String -> ReadP AbiValue
forall a. HasCallStack => String -> a
error "tuple types not supported"
listP :: ReadP a -> ReadP [a]
listP :: ReadP a -> ReadP [a]
listP parser :: 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 -> ReadP 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 ','))
data AbiVals = NoVals | CAbi [AbiValue] | SAbi [SymWord]
decodeBuffer :: [AbiType] -> Buffer -> AbiVals
decodeBuffer :: [AbiType] -> Buffer -> AbiVals
decodeBuffer tps :: [AbiType]
tps (ConcreteBuffer b :: 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 ("", _, args :: 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
_ -> AbiVals
NoVals
decodeBuffer tps :: [AbiType]
tps b :: Buffer
b@(SymbolicBuffer _)
= 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 t :: 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
buffer = let
bs :: [SWord 8]
bs = case Buffer
buffer of
ConcreteBuffer b :: ByteString
b -> ByteString -> [SWord 8]
litBytes ByteString
b
SymbolicBuffer b :: [SWord 8]
b -> [SWord 8]
b
in (Int -> SymWord) -> [Int] -> [SymWord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\i :: 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 32 (Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*32) [SWord 8]
bs)) [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` 32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)]
arbitraryIntegralWithMax :: (Integral a) => Integer -> Gen a
arbitraryIntegralWithMax :: Integer -> Gen a
arbitraryIntegralWithMax maxbound :: 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
$ \s :: Int
s ->
do let mn :: Int
mn = 0 :: Int
mx :: Integer
mx = Integer
maxbound
bits :: t -> p
bits n :: t
n | t
n t -> t -> t
forall a. Integral a => a -> a -> a
`quot` 2 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 0
| Bool
otherwise = 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` 2)
k :: Integer
k = 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` 40) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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 (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))]