{-# Language CPP #-}
{-# Language UndecidableInstances #-}
{-# Language TemplateHaskell #-}
{-# Language TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}

{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}

module EVM.Types where

import Prelude hiding  (Word, LT, GT)

import Control.Arrow ((>>>))
import Control.Monad.State.Strict hiding (state)
import Crypto.Hash hiding (SHA256)
import Data.Aeson
import Data.Aeson qualified as JSON
import Data.Aeson.Types qualified as JSON
import Data.Bifunctor (first)
import Data.Bits (Bits, FiniteBits, shiftR, shift, shiftL, (.&.), (.|.))
import Data.ByteArray qualified as BA
import Data.Char
import Data.List (foldl')
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as BS16
import Data.ByteString.Builder (byteStringHex, toLazyByteString)
import Data.ByteString.Char8 qualified as Char8
import Data.ByteString.Lazy (toStrict)
import Data.Data
import Data.Word (Word8, Word32, Word64)
import Data.DoubleWord
import Data.DoubleWord.TH
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Sequence qualified as Seq
import Data.Serialize qualified as Cereal
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Vector qualified as V
import Data.Vector.Storable qualified as SV
import Numeric (readHex, showHex)
import Options.Generic
import Optics.TH
import EVM.Hexdump (paddedShowHex)
import EVM.FeeSchedule (FeeSchedule (..))
import Data.Tree.Zipper qualified as Zipper

import qualified Text.Regex.TDFA      as Regex
import qualified Text.Read


-- Template Haskell --------------------------------------------------------------------------


-- We need a 512-bit word for doing ADDMOD and MULMOD with full precision.
mkUnpackedDoubleWord "Word512" ''Word256 "Int512" ''Int256 ''Word256
  [''Typeable, ''Data, ''Generic]


-- Symbolic IR -------------------------------------------------------------------------------------

-- phantom type tags for AST construction
data EType
  = Buf
  | Storage
  | Log
  | EWord
  | Byte
  | End
  deriving (Typeable)


-- Variables refering to a global environment
data GVar (a :: EType) where
  BufVar :: Int -> GVar Buf
  StoreVar :: Int -> GVar Storage

deriving instance Show (GVar a)
deriving instance Eq (GVar a)
deriving instance Ord (GVar a)


{- |
  Expr implements an abstract respresentation of an EVM program

  This type can give insight into the provenance of a term which is useful,
  both for the aesthetic purpose of printing terms in a richer way, but also to
  allow optimizations on the AST instead of letting the SMT solver do all the
  heavy lifting.

  Memory, calldata, and returndata are all represented as a Buf. Semantically
  speaking a Buf is a byte array with of size 2^256.

  Bufs have two base constructors:
    - AbstractBuf:    all elements are fully abstract values
    - ConcreteBuf bs: all elements past (length bs) are zero

  Bufs can be read from with:
    - ReadByte idx buf: read the byte at idx from buf
    - ReadWord idx buf: read the byte at idx from buf

  Bufs can be written to with:
    - WriteByte idx val buf: write val to idx in buf
    - WriteWord idx val buf: write val to idx in buf
    - CopySlice srcOffset dstOffset size src dst:
        overwrite dstOffset -> dstOffset + size in dst with srcOffset -> srcOffset + size from src

  Note that the shared usage of `Buf` does allow for the construction of some
  badly typed Expr instances (e.g. an MSTORE on top of the contents of calldata
  instead of some previous instance of memory), we accept this for the
  sake of simplifying pattern matches against a Buf expression.

  Storage expressions are similar, but instead of writing regions of bytes, we
  write a word to a particular key in a given addresses storage. Note that as
  with a Buf, writes can be sequenced on top of concrete, empty and fully
  abstract starting states.

  One important principle is that of local context: e.g. each term representing
  a write to a Buf / Storage / Logs will always contain a copy of the state
  that is being added to, this ensures that all context relevant to a given
  operation is contained within the term that represents that operation.

  When dealing with Expr instances we assume that concrete expressions have
  been reduced to their smallest possible representation (i.e. a `Lit`,
  `ConcreteBuf`, or `ConcreteStore`). Failure to adhere to this invariant will
  result in your concrete term being treated as symbolic, and may produce
  unexpected errors. In the future we may wish to consider encoding the
  concreteness of a given term directly in the type of that term, since such
  type level shenanigans tends to complicate implementation, we skip this for
  now.
-}
data Expr (a :: EType) where

  -- identifiers

  Lit            :: {-# UNPACK #-} !W256 -> Expr EWord
  Var            :: Text -> Expr EWord
  GVar           :: GVar a -> Expr a

  -- bytes

  LitByte        :: {-# UNPACK #-} !Word8 -> Expr Byte
  IndexWord      :: Expr EWord -> Expr EWord -> Expr Byte
  EqByte         :: Expr Byte  -> Expr Byte  -> Expr EWord

  JoinBytes      :: Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr Byte -> Expr Byte -> Expr Byte -> Expr Byte
                 -> Expr EWord

  -- control flow

  Partial        :: [Prop] -> PartialExec -> Expr End
  Failure        :: [Prop] -> EvmError -> Expr End
  Success        :: [Prop] -> Expr Buf -> Expr Storage -> Expr End
  ITE            :: Expr EWord -> Expr End -> Expr End -> Expr End

  -- integers

  Add            :: Expr EWord -> Expr EWord -> Expr EWord
  Sub            :: Expr EWord -> Expr EWord -> Expr EWord
  Mul            :: Expr EWord -> Expr EWord -> Expr EWord
  Div            :: Expr EWord -> Expr EWord -> Expr EWord
  SDiv           :: Expr EWord -> Expr EWord -> Expr EWord
  Mod            :: Expr EWord -> Expr EWord -> Expr EWord
  SMod           :: Expr EWord -> Expr EWord -> Expr EWord
  AddMod         :: Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord
  MulMod         :: Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord
  Exp            :: Expr EWord -> Expr EWord -> Expr EWord
  SEx            :: Expr EWord -> Expr EWord -> Expr EWord
  Min            :: Expr EWord -> Expr EWord -> Expr EWord
  Max            :: Expr EWord -> Expr EWord -> Expr EWord

  -- booleans

  LT             :: Expr EWord -> Expr EWord -> Expr EWord
  GT             :: Expr EWord -> Expr EWord -> Expr EWord
  LEq            :: Expr EWord -> Expr EWord -> Expr EWord
  GEq            :: Expr EWord -> Expr EWord -> Expr EWord
  SLT            :: Expr EWord -> Expr EWord -> Expr EWord
  SGT            :: Expr EWord -> Expr EWord -> Expr EWord
  Eq             :: Expr EWord -> Expr EWord -> Expr EWord
  IsZero         :: Expr EWord -> Expr EWord

  -- bits

  And            :: Expr EWord -> Expr EWord -> Expr EWord
  Or             :: Expr EWord -> Expr EWord -> Expr EWord
  Xor            :: Expr EWord -> Expr EWord -> Expr EWord
  Not            :: Expr EWord -> Expr EWord
  SHL            :: Expr EWord -> Expr EWord -> Expr EWord
  SHR            :: Expr EWord -> Expr EWord -> Expr EWord
  SAR            :: Expr EWord -> Expr EWord -> Expr EWord

  -- Hashes

  Keccak         :: Expr Buf -> Expr EWord
  SHA256         :: Expr Buf -> Expr EWord

  -- block context

  Origin         :: Expr EWord
  BlockHash      :: Expr EWord -> Expr EWord
  Coinbase       :: Expr EWord
  Timestamp      :: Expr EWord
  BlockNumber    :: Expr EWord
  PrevRandao     :: Expr EWord
  GasLimit       :: Expr EWord
  ChainId        :: Expr EWord
  BaseFee        :: Expr EWord

  -- frame context

  CallValue      :: Int                -- frame idx
                 -> Expr EWord

  Caller         :: Int                -- frame idx
                 -> Expr EWord

  Address        :: Int                -- frame idx
                 -> Expr EWord

  Balance        :: Int                -- frame idx
                 -> Int                -- PC (in case we're checking the current contract)
                 -> Expr EWord         -- address
                 -> Expr EWord

  SelfBalance    :: Int                -- frame idx
                 -> Int                -- PC
                 -> Expr EWord

  Gas            :: Int                -- frame idx
                 -> Int                -- PC
                 -> Expr EWord

  -- code

  CodeSize       :: Expr EWord         -- address
                 -> Expr EWord         -- size

  ExtCodeHash    :: Expr EWord         -- address
                 -> Expr EWord         -- size

  -- logs

  LogEntry       :: Expr EWord         -- address
                 -> Expr Buf           -- data
                 -> [Expr EWord]       -- topics
                 -> Expr Log

  -- Contract Creation

  Create         :: Expr EWord         -- value
                 -> Expr EWord         -- offset
                 -> Expr EWord         -- size
                 -> Expr Buf           -- memory
                 -> [Expr Log]          -- logs
                 -> Expr Storage       -- storage
                 -> Expr EWord         -- address

  Create2        :: Expr EWord         -- value
                 -> Expr EWord         -- offset
                 -> Expr EWord         -- size
                 -> Expr EWord         -- salt
                 -> Expr Buf           -- memory
                 -> [Expr Log]          -- logs
                 -> Expr Storage       -- storage
                 -> Expr EWord         -- address

  -- Calls

  Call           :: Expr EWord         -- gas
                 -> Maybe (Expr EWord) -- target
                 -> Expr EWord         -- value
                 -> Expr EWord         -- args offset
                 -> Expr EWord         -- args size
                 -> Expr EWord         -- ret offset
                 -> Expr EWord         -- ret size
                 -> [Expr Log]          -- logs
                 -> Expr Storage       -- storage
                 -> Expr EWord         -- success

  CallCode       :: Expr EWord         -- gas
                 -> Expr EWord         -- address
                 -> Expr EWord         -- value
                 -> Expr EWord         -- args offset
                 -> Expr EWord         -- args size
                 -> Expr EWord         -- ret offset
                 -> Expr EWord         -- ret size
                 -> [Expr Log]         -- logs
                 -> Expr Storage       -- storage
                 -> Expr EWord         -- success

  DelegeateCall  :: Expr EWord         -- gas
                 -> Expr EWord         -- address
                 -> Expr EWord         -- value
                 -> Expr EWord         -- args offset
                 -> Expr EWord         -- args size
                 -> Expr EWord         -- ret offset
                 -> Expr EWord         -- ret size
                 -> [Expr Log]         -- logs
                 -> Expr Storage       -- storage
                 -> Expr EWord         -- success

  -- storage

  EmptyStore     :: Expr Storage
  ConcreteStore  :: Map W256 (Map W256 W256) -> Expr Storage
  AbstractStore  :: Expr Storage

  SLoad          :: Expr EWord         -- address
                 -> Expr EWord         -- index
                 -> Expr Storage       -- storage
                 -> Expr EWord         -- result

  SStore         :: Expr EWord         -- address
                 -> Expr EWord         -- index
                 -> Expr EWord         -- value
                 -> Expr Storage       -- old storage
                 -> Expr Storage       -- new storae

  -- buffers

  ConcreteBuf    :: ByteString -> Expr Buf
  AbstractBuf    :: Text -> Expr Buf

  ReadWord       :: Expr EWord         -- index
                 -> Expr Buf           -- src
                 -> Expr EWord

  ReadByte       :: Expr EWord         -- index
                 -> Expr Buf           -- src
                 -> Expr Byte

  WriteWord      :: Expr EWord         -- dst offset
                 -> Expr EWord         -- value
                 -> Expr Buf           -- prev
                 -> Expr Buf

  WriteByte      :: Expr EWord         -- dst offset
                 -> Expr Byte          -- value
                 -> Expr Buf           -- prev
                 -> Expr Buf

  CopySlice      :: Expr EWord         -- src offset
                 -> Expr EWord         -- dst offset
                 -> Expr EWord         -- size
                 -> Expr Buf           -- src
                 -> Expr Buf           -- dst
                 -> Expr Buf

  BufLength      :: Expr Buf -> Expr EWord

deriving instance Show (Expr a)
deriving instance Eq (Expr a)
deriving instance Ord (Expr a)


-- Existential Wrapper -----------------------------------------------------------------------------


data SomeExpr = forall a . Typeable a => SomeExpr (Expr a)

deriving instance Show SomeExpr

instance Eq SomeExpr where
  SomeExpr (Expr a
a :: Expr b) == :: SomeExpr -> SomeExpr -> Bool
== SomeExpr (Expr a
c :: Expr d) =
    case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @b @d of
      Just a :~: a
Refl -> Expr a
a forall a. Eq a => a -> a -> Bool
== Expr a
c
      Maybe (a :~: a)
Nothing -> Bool
False

instance Ord SomeExpr where
  compare :: SomeExpr -> SomeExpr -> Ordering
compare (SomeExpr (Expr a
a :: Expr b)) (SomeExpr (Expr a
c :: Expr d)) =
    case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @b @d of
      Just a :~: a
Refl -> forall a. Ord a => a -> a -> Ordering
compare Expr a
a Expr a
c
      Maybe (a :~: a)
Nothing -> forall a. Ord a => a -> a -> Ordering
compare (forall (a :: EType). Typeable a => Expr a -> Int
toNum Expr a
a) (forall (a :: EType). Typeable a => Expr a -> Int
toNum Expr a
c)

toNum :: (Typeable a) => Expr a -> Int
toNum :: forall (a :: EType). Typeable a => Expr a -> Int
toNum (Expr a
_ :: Expr a) =
  case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @Buf of
    Just a :~: 'Buf
Refl -> Int
1
    Maybe (a :~: 'Buf)
Nothing -> case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @Storage of
      Just a :~: 'Storage
Refl -> Int
2
      Maybe (a :~: 'Storage)
Nothing -> case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @Log of
        Just a :~: 'Log
Refl -> Int
3
        Maybe (a :~: 'Log)
Nothing -> case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @EWord of
          Just a :~: 'EWord
Refl -> Int
4
          Maybe (a :~: 'EWord)
Nothing -> case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @Byte of
            Just a :~: 'Byte
Refl -> Int
5
            Maybe (a :~: 'Byte)
Nothing -> Int
6


-- Propostions -------------------------------------------------------------------------------------


-- The language of assertable expressions.
-- This is useful when generating SMT queries based on Expr instances, since
-- the translation of Eq and other boolean operators from Expr to SMT is an
-- (ite (eq a b) 1 0). We can use the boolean operators here to remove some
-- unescessary `ite` statements from our SMT encoding.
data Prop where
  PEq :: forall a . Typeable a => Expr a -> Expr a -> Prop
  PLT :: Expr EWord -> Expr EWord -> Prop
  PGT :: Expr EWord -> Expr EWord -> Prop
  PGEq :: Expr EWord -> Expr EWord -> Prop
  PLEq :: Expr EWord -> Expr EWord -> Prop
  PNeg :: Prop -> Prop
  PAnd :: Prop -> Prop -> Prop
  POr :: Prop -> Prop -> Prop
  PImpl :: Prop -> Prop -> Prop
  PBool :: Bool -> Prop
deriving instance (Show Prop)

infixr 3 .&&
(.&&) :: Prop -> Prop -> Prop
Prop
x .&& :: Prop -> Prop -> Prop
.&& Prop
y = Prop -> Prop -> Prop
PAnd Prop
x Prop
y

infixr 2 .||
(.||) :: Prop -> Prop -> Prop
Prop
x .|| :: Prop -> Prop -> Prop
.|| Prop
y = Prop -> Prop -> Prop
POr Prop
x Prop
y

infix 4 .<, .<=, .>, .>=
(.<) :: Expr EWord -> Expr EWord -> Prop
Expr 'EWord
x .< :: Expr 'EWord -> Expr 'EWord -> Prop
.< Expr 'EWord
y = Expr 'EWord -> Expr 'EWord -> Prop
PLT Expr 'EWord
x Expr 'EWord
y
(.<=) :: Expr EWord -> Expr EWord -> Prop
Expr 'EWord
x .<= :: Expr 'EWord -> Expr 'EWord -> Prop
.<= Expr 'EWord
y = Expr 'EWord -> Expr 'EWord -> Prop
PLEq Expr 'EWord
x Expr 'EWord
y
(.>) :: Expr EWord -> Expr EWord -> Prop
Expr 'EWord
x .> :: Expr 'EWord -> Expr 'EWord -> Prop
.> Expr 'EWord
y = Expr 'EWord -> Expr 'EWord -> Prop
PGT Expr 'EWord
x Expr 'EWord
y
(.>=) :: Expr EWord -> Expr EWord -> Prop
Expr 'EWord
x .>= :: Expr 'EWord -> Expr 'EWord -> Prop
.>= Expr 'EWord
y = Expr 'EWord -> Expr 'EWord -> Prop
PGEq Expr 'EWord
x Expr 'EWord
y

infix 4 .==, ./=
(.==) :: (Typeable a) => Expr a -> Expr a -> Prop
Expr a
x .== :: forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
.== Expr a
y = forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
PEq Expr a
x Expr a
y
(./=) :: (Typeable a) => Expr a -> Expr a -> Prop
Expr a
x ./= :: forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
./= Expr a
y = Prop -> Prop
PNeg (forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
PEq Expr a
x Expr a
y)

pand :: [Prop] -> Prop
pand :: [Prop] -> Prop
pand = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Prop -> Prop -> Prop
PAnd (Bool -> Prop
PBool Bool
True)

por :: [Prop] -> Prop
por :: [Prop] -> Prop
por = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Prop -> Prop -> Prop
POr (Bool -> Prop
PBool Bool
False)

instance Eq Prop where
  PBool Bool
a == :: Prop -> Prop -> Bool
== PBool Bool
b = Bool
a forall a. Eq a => a -> a -> Bool
== Bool
b
  PEq (Expr a
a :: Expr x) (Expr a
b :: Expr x) == PEq (Expr a
c :: Expr y) (Expr a
d :: Expr y)
    = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @x @y of
       Just a :~: a
Refl -> Expr a
a forall a. Eq a => a -> a -> Bool
== Expr a
c Bool -> Bool -> Bool
&& Expr a
b forall a. Eq a => a -> a -> Bool
== Expr a
d
       Maybe (a :~: a)
Nothing -> Bool
False
  PLT Expr 'EWord
a Expr 'EWord
b == PLT Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Eq a => a -> a -> Bool
== Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Eq a => a -> a -> Bool
== Expr 'EWord
d
  PGT Expr 'EWord
a Expr 'EWord
b == PGT Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Eq a => a -> a -> Bool
== Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Eq a => a -> a -> Bool
== Expr 'EWord
d
  PGEq Expr 'EWord
a Expr 'EWord
b == PGEq Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Eq a => a -> a -> Bool
== Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Eq a => a -> a -> Bool
== Expr 'EWord
d
  PLEq Expr 'EWord
a Expr 'EWord
b == PLEq Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Eq a => a -> a -> Bool
== Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Eq a => a -> a -> Bool
== Expr 'EWord
d
  PNeg Prop
a == PNeg Prop
b = Prop
a forall a. Eq a => a -> a -> Bool
== Prop
b
  PAnd Prop
a Prop
b == PAnd Prop
c Prop
d = Prop
a forall a. Eq a => a -> a -> Bool
== Prop
c Bool -> Bool -> Bool
&& Prop
b forall a. Eq a => a -> a -> Bool
== Prop
d
  POr Prop
a Prop
b == POr Prop
c Prop
d = Prop
a forall a. Eq a => a -> a -> Bool
== Prop
c Bool -> Bool -> Bool
&& Prop
b forall a. Eq a => a -> a -> Bool
== Prop
d
  PImpl Prop
a Prop
b == PImpl Prop
c Prop
d = Prop
a forall a. Eq a => a -> a -> Bool
== Prop
c Bool -> Bool -> Bool
&& Prop
b forall a. Eq a => a -> a -> Bool
== Prop
d
  Prop
_ == Prop
_ = Bool
False

instance Ord Prop where
  PBool Bool
a <= :: Prop -> Prop -> Bool
<= PBool Bool
b = Bool
a forall a. Ord a => a -> a -> Bool
<= Bool
b
  PEq (Expr a
a :: Expr x) (Expr a
b :: Expr x) <= PEq (Expr a
c :: Expr y) (Expr a
d :: Expr y)
    = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @x @y of
       Just a :~: a
Refl -> Expr a
a forall a. Ord a => a -> a -> Bool
<= Expr a
c Bool -> Bool -> Bool
&& Expr a
b forall a. Ord a => a -> a -> Bool
<= Expr a
d
       Maybe (a :~: a)
Nothing -> Bool
False
  PLT Expr 'EWord
a Expr 'EWord
b <= PLT Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
d
  PGT Expr 'EWord
a Expr 'EWord
b <= PGT Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
d
  PGEq Expr 'EWord
a Expr 'EWord
b <= PGEq Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
d
  PLEq Expr 'EWord
a Expr 'EWord
b <= PLEq Expr 'EWord
c Expr 'EWord
d = Expr 'EWord
a forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
c Bool -> Bool -> Bool
&& Expr 'EWord
b forall a. Ord a => a -> a -> Bool
<= Expr 'EWord
d
  PNeg Prop
a <= PNeg Prop
b = Prop
a forall a. Ord a => a -> a -> Bool
<= Prop
b
  PAnd Prop
a Prop
b <= PAnd Prop
c Prop
d = Prop
a forall a. Ord a => a -> a -> Bool
<= Prop
c Bool -> Bool -> Bool
&& Prop
b forall a. Ord a => a -> a -> Bool
<= Prop
d
  POr Prop
a Prop
b <= POr Prop
c Prop
d = Prop
a forall a. Ord a => a -> a -> Bool
<= Prop
c Bool -> Bool -> Bool
&& Prop
b forall a. Ord a => a -> a -> Bool
<= Prop
d
  PImpl Prop
a Prop
b <= PImpl Prop
c Prop
d = Prop
a forall a. Ord a => a -> a -> Bool
<= Prop
c Bool -> Bool -> Bool
&& Prop
b forall a. Ord a => a -> a -> Bool
<= Prop
d
  Prop
_ <= Prop
_ = Bool
False


-- Errors ------------------------------------------------------------------------------------------


-- | Core EVM Error Types
data EvmError
  = BalanceTooLow W256 W256
  | UnrecognizedOpcode Word8
  | SelfDestruction
  | StackUnderrun
  | BadJumpDestination
  | Revert (Expr Buf)
  | OutOfGas Word64 Word64
  | StackLimitExceeded
  | IllegalOverflow
  | StateChangeWhileStatic
  | InvalidMemoryAccess
  | CallDepthLimitReached
  | MaxCodeSizeExceeded W256 W256
  | MaxInitCodeSizeExceeded W256 W256
  | InvalidFormat
  | PrecompileFailure
  | ReturnDataOutOfBounds
  | NonceOverflow
  | BadCheatCode FunctionSelector
  deriving (Int -> EvmError -> ShowS
[EvmError] -> ShowS
EvmError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvmError] -> ShowS
$cshowList :: [EvmError] -> ShowS
show :: EvmError -> String
$cshow :: EvmError -> String
showsPrec :: Int -> EvmError -> ShowS
$cshowsPrec :: Int -> EvmError -> ShowS
Show, EvmError -> EvmError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvmError -> EvmError -> Bool
$c/= :: EvmError -> EvmError -> Bool
== :: EvmError -> EvmError -> Bool
$c== :: EvmError -> EvmError -> Bool
Eq, Eq EvmError
EvmError -> EvmError -> Bool
EvmError -> EvmError -> Ordering
EvmError -> EvmError -> EvmError
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 :: EvmError -> EvmError -> EvmError
$cmin :: EvmError -> EvmError -> EvmError
max :: EvmError -> EvmError -> EvmError
$cmax :: EvmError -> EvmError -> EvmError
>= :: EvmError -> EvmError -> Bool
$c>= :: EvmError -> EvmError -> Bool
> :: EvmError -> EvmError -> Bool
$c> :: EvmError -> EvmError -> Bool
<= :: EvmError -> EvmError -> Bool
$c<= :: EvmError -> EvmError -> Bool
< :: EvmError -> EvmError -> Bool
$c< :: EvmError -> EvmError -> Bool
compare :: EvmError -> EvmError -> Ordering
$ccompare :: EvmError -> EvmError -> Ordering
Ord)

-- | Sometimes we can only partially execute a given program
data PartialExec
  = UnexpectedSymbolicArg  { PartialExec -> Int
pc :: Int, PartialExec -> String
msg  :: String, PartialExec -> [SomeExpr]
args  :: [SomeExpr] }
  | MaxIterationsReached  { pc :: Int, PartialExec -> Addr
addr :: Addr }
  deriving (Int -> PartialExec -> ShowS
[PartialExec] -> ShowS
PartialExec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialExec] -> ShowS
$cshowList :: [PartialExec] -> ShowS
show :: PartialExec -> String
$cshow :: PartialExec -> String
showsPrec :: Int -> PartialExec -> ShowS
$cshowsPrec :: Int -> PartialExec -> ShowS
Show, PartialExec -> PartialExec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialExec -> PartialExec -> Bool
$c/= :: PartialExec -> PartialExec -> Bool
== :: PartialExec -> PartialExec -> Bool
$c== :: PartialExec -> PartialExec -> Bool
Eq, Eq PartialExec
PartialExec -> PartialExec -> Bool
PartialExec -> PartialExec -> Ordering
PartialExec -> PartialExec -> PartialExec
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 :: PartialExec -> PartialExec -> PartialExec
$cmin :: PartialExec -> PartialExec -> PartialExec
max :: PartialExec -> PartialExec -> PartialExec
$cmax :: PartialExec -> PartialExec -> PartialExec
>= :: PartialExec -> PartialExec -> Bool
$c>= :: PartialExec -> PartialExec -> Bool
> :: PartialExec -> PartialExec -> Bool
$c> :: PartialExec -> PartialExec -> Bool
<= :: PartialExec -> PartialExec -> Bool
$c<= :: PartialExec -> PartialExec -> Bool
< :: PartialExec -> PartialExec -> Bool
$c< :: PartialExec -> PartialExec -> Bool
compare :: PartialExec -> PartialExec -> Ordering
$ccompare :: PartialExec -> PartialExec -> Ordering
Ord)

-- | Effect types used by the vm implementation for side effects & control flow
data Effect
  = Query Query
  | Choose Choose
deriving instance Show Effect

-- | Queries halt execution until resolved through RPC calls or SMT queries
data Query where
  PleaseFetchContract :: Addr -> (Contract -> EVM ()) -> Query
  PleaseFetchSlot     :: Addr -> W256 -> (W256 -> EVM ()) -> Query
  PleaseAskSMT        :: Expr EWord -> [Prop] -> (BranchCondition -> EVM ()) -> Query
  PleaseDoFFI         :: [String] -> (ByteString -> EVM ()) -> Query

-- | Execution could proceed down one of two branches
data Choose where
  PleaseChoosePath    :: Expr EWord -> (Bool -> EVM ()) -> Choose

-- | The possible return values of a SMT query
data BranchCondition = Case Bool | Unknown
  deriving Int -> BranchCondition -> ShowS
[BranchCondition] -> ShowS
BranchCondition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BranchCondition] -> ShowS
$cshowList :: [BranchCondition] -> ShowS
show :: BranchCondition -> String
$cshow :: BranchCondition -> String
showsPrec :: Int -> BranchCondition -> ShowS
$cshowsPrec :: Int -> BranchCondition -> ShowS
Show

instance Show Query where
  showsPrec :: Int -> Query -> ShowS
showsPrec Int
_ = \case
    PleaseFetchContract Addr
addr Contract -> EVM ()
_ ->
      ((String
"<EVM.Query: fetch contract " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Addr
addr forall a. [a] -> [a] -> [a]
++ String
">") ++)
    PleaseFetchSlot Addr
addr W256
slot W256 -> EVM ()
_ ->
      ((String
"<EVM.Query: fetch slot "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show W256
slot forall a. [a] -> [a] -> [a]
++ String
" for "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Addr
addr forall a. [a] -> [a] -> [a]
++ String
">") ++)
    PleaseAskSMT Expr 'EWord
condition [Prop]
constraints BranchCondition -> EVM ()
_ ->
      ((String
"<EVM.Query: ask SMT about "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr 'EWord
condition forall a. [a] -> [a] -> [a]
++ String
" in context "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Prop]
constraints forall a. [a] -> [a] -> [a]
++ String
">") ++)
    PleaseDoFFI [String]
cmd ByteString -> EVM ()
_ ->
      ((String
"<EVM.Query: do ffi: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show [String]
cmd)) ++)

instance Show Choose where
  showsPrec :: Int -> Choose -> ShowS
showsPrec Int
_ = \case
    PleaseChoosePath Expr 'EWord
_ Bool -> EVM ()
_ ->
      ((String
"<EVM.Choice: waiting for user to select path (0,1)") ++)

-- | The possible result states of a VM
data VMResult
  = VMFailure EvmError     -- ^ An operation failed
  | VMSuccess (Expr Buf)   -- ^ Reached STOP, RETURN, or end-of-code
  | HandleEffect Effect    -- ^ An effect must be handled for execution to continue
  | Unfinished PartialExec -- ^ Execution could not continue further

deriving instance Show VMResult


-- VM State ----------------------------------------------------------------------------------------


-- | The state of a stepwise EVM execution
data VM = VM
  { VM -> Maybe VMResult
result         :: Maybe VMResult
  , VM -> FrameState
state          :: FrameState
  , VM -> [Frame]
frames         :: [Frame]
  , VM -> Env
env            :: Env
  , VM -> Block
block          :: Block
  , VM -> TxState
tx             :: TxState
  , VM -> [Expr 'Log]
logs           :: [Expr Log]
  , VM -> TreePos Empty Trace
traces         :: Zipper.TreePos Zipper.Empty Trace
  , VM -> Cache
cache          :: Cache
  , VM -> Word64
burned         :: {-# UNPACK #-} !Word64
  , VM -> Map CodeLocation (Int, [Expr 'EWord])
iterations     :: Map CodeLocation (Int, [Expr EWord]) -- ^ how many times we've visited a loc, and what the contents of the stack were when we were there last
  , VM -> [Prop]
constraints    :: [Prop]
  , VM -> [Prop]
keccakEqs      :: [Prop]
  , VM -> Bool
allowFFI       :: Bool
  , VM -> Maybe Addr
overrideCaller :: Maybe Addr
  }
  deriving (Int -> VM -> ShowS
[VM] -> ShowS
VM -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VM] -> ShowS
$cshowList :: [VM] -> ShowS
show :: VM -> String
$cshow :: VM -> String
showsPrec :: Int -> VM -> ShowS
$cshowsPrec :: Int -> VM -> ShowS
Show, forall x. Rep VM x -> VM
forall x. VM -> Rep VM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VM x -> VM
$cfrom :: forall x. VM -> Rep VM x
Generic)

-- | Alias for the type of e.g. @exec1@.
type EVM a = State VM a

-- | An entry in the VM's "call/create stack"
data Frame = Frame
  { Frame -> FrameContext
context :: FrameContext
  , Frame -> FrameState
state   :: FrameState
  }
  deriving (Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show)

-- | Call/create info
data FrameContext
  = CreationContext
    { FrameContext -> Addr
address         :: Addr
    , FrameContext -> Expr 'EWord
codehash        :: Expr EWord
    , FrameContext -> Map Addr Contract
createreversion :: Map Addr Contract
    , FrameContext -> SubState
substate        :: SubState
    }
  | CallContext
    { FrameContext -> Addr
target        :: Addr
    , FrameContext -> Addr
context       :: Addr
    , FrameContext -> W256
offset        :: W256
    , FrameContext -> W256
size          :: W256
    , codehash      :: Expr EWord
    , FrameContext -> Maybe W256
abi           :: Maybe W256
    , FrameContext -> Expr 'Buf
calldata      :: Expr Buf
    , FrameContext -> (Map Addr Contract, Expr 'Storage)
callreversion :: (Map Addr Contract, Expr Storage)
    , FrameContext -> SubState
subState      :: SubState
    }
  deriving (Int -> FrameContext -> ShowS
[FrameContext] -> ShowS
FrameContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameContext] -> ShowS
$cshowList :: [FrameContext] -> ShowS
show :: FrameContext -> String
$cshow :: FrameContext -> String
showsPrec :: Int -> FrameContext -> ShowS
$cshowsPrec :: Int -> FrameContext -> ShowS
Show, forall x. Rep FrameContext x -> FrameContext
forall x. FrameContext -> Rep FrameContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FrameContext x -> FrameContext
$cfrom :: forall x. FrameContext -> Rep FrameContext x
Generic)

-- | The "accrued substate" across a transaction
data SubState = SubState
  { SubState -> [Addr]
selfdestructs       :: [Addr]
  , SubState -> [Addr]
touchedAccounts     :: [Addr]
  , SubState -> Set Addr
accessedAddresses   :: Set Addr
  , SubState -> Set (Addr, W256)
accessedStorageKeys :: Set (Addr, W256)
  , SubState -> [(Addr, Word64)]
refunds             :: [(Addr, Word64)]
  -- in principle we should include logs here, but do not for now
  }
  deriving (Int -> SubState -> ShowS
[SubState] -> ShowS
SubState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubState] -> ShowS
$cshowList :: [SubState] -> ShowS
show :: SubState -> String
$cshow :: SubState -> String
showsPrec :: Int -> SubState -> ShowS
$cshowsPrec :: Int -> SubState -> ShowS
Show)

-- | The "registers" of the VM along with memory and data stack
data FrameState = FrameState
  { FrameState -> Addr
contract     :: Addr
  , FrameState -> Addr
codeContract :: Addr
  , FrameState -> ContractCode
code         :: ContractCode
  , FrameState -> Int
pc           :: {-# UNPACK #-} !Int
  , FrameState -> [Expr 'EWord]
stack        :: [Expr EWord]
  , FrameState -> Expr 'Buf
memory       :: Expr Buf
  , FrameState -> Word64
memorySize   :: Word64
  , FrameState -> Expr 'Buf
calldata     :: Expr Buf
  , FrameState -> Expr 'EWord
callvalue    :: Expr EWord
  , FrameState -> Expr 'EWord
caller       :: Expr EWord
  , FrameState -> Word64
gas          :: {-# UNPACK #-} !Word64
  , FrameState -> Expr 'Buf
returndata   :: Expr Buf
  , FrameState -> Bool
static       :: Bool
  }
  deriving (Int -> FrameState -> ShowS
[FrameState] -> ShowS
FrameState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameState] -> ShowS
$cshowList :: [FrameState] -> ShowS
show :: FrameState -> String
$cshow :: FrameState -> String
showsPrec :: Int -> FrameState -> ShowS
$cshowsPrec :: Int -> FrameState -> ShowS
Show, forall x. Rep FrameState x -> FrameState
forall x. FrameState -> Rep FrameState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FrameState x -> FrameState
$cfrom :: forall x. FrameState -> Rep FrameState x
Generic)

-- | The state that spans a whole transaction
data TxState = TxState
  { TxState -> W256
gasprice    :: W256
  , TxState -> Word64
gaslimit    :: Word64
  , TxState -> W256
priorityFee :: W256
  , TxState -> Addr
origin      :: Addr
  , TxState -> Addr
toAddr      :: Addr
  , TxState -> Expr 'EWord
value       :: Expr EWord
  , TxState -> SubState
substate    :: SubState
  , TxState -> Bool
isCreate    :: Bool
  , TxState -> Map Addr Contract
txReversion :: Map Addr Contract
  }
  deriving (Int -> TxState -> ShowS
[TxState] -> ShowS
TxState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxState] -> ShowS
$cshowList :: [TxState] -> ShowS
show :: TxState -> String
$cshow :: TxState -> String
showsPrec :: Int -> TxState -> ShowS
$cshowsPrec :: Int -> TxState -> ShowS
Show)

-- | When doing symbolic execution, we have three different
-- ways to model the storage of contracts. This determines
-- not only the initial contract storage model but also how
-- RPC or state fetched contracts will be modeled.
data StorageModel
  = ConcreteS    -- ^ Uses `Concrete` Storage. Reading / Writing from abstract
                 -- locations causes a runtime failure. Can be nicely combined with RPC.

  | SymbolicS    -- ^ Uses `Symbolic` Storage. Reading / Writing never reaches RPC,
                 -- but always done using an SMT array with no default value.

  | InitialS     -- ^ Uses `Symbolic` Storage. Reading / Writing never reaches RPC,
                 -- but always done using an SMT array with 0 as the default value.

  deriving (ReadPrec [StorageModel]
ReadPrec StorageModel
Int -> ReadS StorageModel
ReadS [StorageModel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StorageModel]
$creadListPrec :: ReadPrec [StorageModel]
readPrec :: ReadPrec StorageModel
$creadPrec :: ReadPrec StorageModel
readList :: ReadS [StorageModel]
$creadList :: ReadS [StorageModel]
readsPrec :: Int -> ReadS StorageModel
$creadsPrec :: Int -> ReadS StorageModel
Read, Int -> StorageModel -> ShowS
[StorageModel] -> ShowS
StorageModel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageModel] -> ShowS
$cshowList :: [StorageModel] -> ShowS
show :: StorageModel -> String
$cshow :: StorageModel -> String
showsPrec :: Int -> StorageModel -> ShowS
$cshowsPrec :: Int -> StorageModel -> ShowS
Show)

instance ParseField StorageModel

-- | Various environmental data
data Env = Env
  { Env -> Map Addr Contract
contracts    :: Map Addr Contract
  , Env -> W256
chainId      :: W256
  , Env -> Expr 'Storage
storage      :: Expr Storage
  , Env -> Map W256 (Map W256 W256)
origStorage  :: Map W256 (Map W256 W256)
  , Env -> Map W256 ByteString
sha3Crack    :: Map W256 ByteString
  }
  deriving (Int -> Env -> ShowS
[Env] -> ShowS
Env -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Env] -> ShowS
$cshowList :: [Env] -> ShowS
show :: Env -> String
$cshow :: Env -> String
showsPrec :: Int -> Env -> ShowS
$cshowsPrec :: Int -> Env -> ShowS
Show, forall x. Rep Env x -> Env
forall x. Env -> Rep Env x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Env x -> Env
$cfrom :: forall x. Env -> Rep Env x
Generic)

-- | Data about the block
data Block = Block
  { Block -> Addr
coinbase    :: Addr
  , Block -> Expr 'EWord
timestamp   :: Expr EWord
  , Block -> W256
number      :: W256
  , Block -> W256
prevRandao  :: W256
  , Block -> Word64
gaslimit    :: Word64
  , Block -> W256
baseFee     :: W256
  , Block -> W256
maxCodeSize :: W256
  , Block -> FeeSchedule Word64
schedule    :: FeeSchedule Word64
  } deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic)

-- | The state of a contract
data Contract = Contract
  { Contract -> ContractCode
contractcode :: ContractCode
  , Contract -> W256
balance      :: W256
  , Contract -> W256
nonce        :: W256
  , Contract -> Expr 'EWord
codehash     :: Expr EWord
  , Contract -> Vector Int
opIxMap      :: SV.Vector Int
  , Contract -> Vector (Int, Op)
codeOps      :: V.Vector (Int, Op)
  , Contract -> Bool
external     :: Bool
  }
  deriving (Int -> Contract -> ShowS
[Contract] -> ShowS
Contract -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contract] -> ShowS
$cshowList :: [Contract] -> ShowS
show :: Contract -> String
$cshow :: Contract -> String
showsPrec :: Int -> Contract -> ShowS
$cshowsPrec :: Int -> Contract -> ShowS
Show)


-- Bytecode Representations ------------------------------------------------------------------------


-- | A unique id for a given pc
type CodeLocation = (Addr, Int)

-- | The cache is data that can be persisted for efficiency:
-- any expensive query that is constant at least within a block.
data Cache = Cache
  { Cache -> Map Addr Contract
fetchedContracts :: Map Addr Contract
  , Cache -> Map W256 (Map W256 W256)
fetchedStorage :: Map W256 (Map W256 W256)
  , Cache -> Map (CodeLocation, Int) Bool
path :: Map (CodeLocation, Int) Bool
  } deriving (Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cache] -> ShowS
$cshowList :: [Cache] -> ShowS
show :: Cache -> String
$cshow :: Cache -> String
showsPrec :: Int -> Cache -> ShowS
$cshowsPrec :: Int -> Cache -> ShowS
Show, forall x. Rep Cache x -> Cache
forall x. Cache -> Rep Cache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cache x -> Cache
$cfrom :: forall x. Cache -> Rep Cache x
Generic)

instance Semigroup Cache where
  Cache
a <> :: Cache -> Cache -> Cache
<> Cache
b = Cache
    { $sel:fetchedContracts:Cache :: Map Addr Contract
fetchedContracts = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Contract -> Contract -> Contract
unifyCachedContract Cache
a.fetchedContracts Cache
b.fetchedContracts
    , $sel:fetchedStorage:Cache :: Map W256 (Map W256 W256)
fetchedStorage = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map W256 W256 -> Map W256 W256 -> Map W256 W256
unifyCachedStorage Cache
a.fetchedStorage Cache
b.fetchedStorage
    , $sel:path:Cache :: Map (CodeLocation, Int) Bool
path = forall a. Monoid a => a -> a -> a
mappend Cache
a.path Cache
b.path
    }

instance Monoid Cache where
  mempty :: Cache
mempty = Cache { $sel:fetchedContracts:Cache :: Map Addr Contract
fetchedContracts = forall a. Monoid a => a
mempty
                 , $sel:fetchedStorage:Cache :: Map W256 (Map W256 W256)
fetchedStorage = forall a. Monoid a => a
mempty
                 , $sel:path:Cache :: Map (CodeLocation, Int) Bool
path = forall a. Monoid a => a
mempty
                 }

unifyCachedStorage :: Map W256 W256 -> Map W256 W256 -> Map W256 W256
unifyCachedStorage :: Map W256 W256 -> Map W256 W256 -> Map W256 W256
unifyCachedStorage Map W256 W256
_ Map W256 W256
_ = forall a. HasCallStack => a
undefined

-- only intended for use in Cache merges, where we expect
-- everything to be Concrete
unifyCachedContract :: Contract -> Contract -> Contract
unifyCachedContract :: Contract -> Contract -> Contract
unifyCachedContract Contract
_ Contract
_ = forall a. HasCallStack => a
undefined
  {-
unifyCachedContract a b = a & set storage merged
  where merged = case (view storage a, view storage b) of
                   (ConcreteStore sa, ConcreteStore sb) ->
                     ConcreteStore (mappend sa sb)
                   _ ->
                     view storage a
   -}


-- Bytecode Representations ------------------------------------------------------------------------


{- |
  A contract is either in creation (running its "constructor") or
  post-creation, and code in these two modes is treated differently
  by instructions like @EXTCODEHASH@, so we distinguish these two
  code types.

  The definition follows the structure of code output by solc. We need to use
  some heuristics here to deal with symbolic data regions that may be present
  in the bytecode since the fully abstract case is impractical:

  - initcode has concrete code, followed by an abstract data "section"
  - runtimecode has a fixed length, but may contain fixed size symbolic regions (due to immutable)

  hopefully we do not have to deal with dynamic immutable before we get a real data section...
-}
data ContractCode
  = InitCode ByteString (Expr Buf) -- ^ "Constructor" code, during contract creation
  | RuntimeCode RuntimeCode -- ^ "Instance" code, after contract creation
  deriving (Int -> ContractCode -> ShowS
[ContractCode] -> ShowS
ContractCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContractCode] -> ShowS
$cshowList :: [ContractCode] -> ShowS
show :: ContractCode -> String
$cshow :: ContractCode -> String
showsPrec :: Int -> ContractCode -> ShowS
$cshowsPrec :: Int -> ContractCode -> ShowS
Show, Eq ContractCode
ContractCode -> ContractCode -> Bool
ContractCode -> ContractCode -> Ordering
ContractCode -> ContractCode -> ContractCode
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 :: ContractCode -> ContractCode -> ContractCode
$cmin :: ContractCode -> ContractCode -> ContractCode
max :: ContractCode -> ContractCode -> ContractCode
$cmax :: ContractCode -> ContractCode -> ContractCode
>= :: ContractCode -> ContractCode -> Bool
$c>= :: ContractCode -> ContractCode -> Bool
> :: ContractCode -> ContractCode -> Bool
$c> :: ContractCode -> ContractCode -> Bool
<= :: ContractCode -> ContractCode -> Bool
$c<= :: ContractCode -> ContractCode -> Bool
< :: ContractCode -> ContractCode -> Bool
$c< :: ContractCode -> ContractCode -> Bool
compare :: ContractCode -> ContractCode -> Ordering
$ccompare :: ContractCode -> ContractCode -> Ordering
Ord)

-- | We have two variants here to optimize the fully concrete case.
-- ConcreteRuntimeCode just wraps a ByteString
-- SymbolicRuntimeCode is a fixed length vector of potentially symbolic bytes, which lets us handle symbolic pushdata (e.g. from immutable variables in solidity).
data RuntimeCode
  = ConcreteRuntimeCode ByteString
  | SymbolicRuntimeCode (V.Vector (Expr Byte))
  deriving (Int -> RuntimeCode -> ShowS
[RuntimeCode] -> ShowS
RuntimeCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuntimeCode] -> ShowS
$cshowList :: [RuntimeCode] -> ShowS
show :: RuntimeCode -> String
$cshow :: RuntimeCode -> String
showsPrec :: Int -> RuntimeCode -> ShowS
$cshowsPrec :: Int -> RuntimeCode -> ShowS
Show, RuntimeCode -> RuntimeCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuntimeCode -> RuntimeCode -> Bool
$c/= :: RuntimeCode -> RuntimeCode -> Bool
== :: RuntimeCode -> RuntimeCode -> Bool
$c== :: RuntimeCode -> RuntimeCode -> Bool
Eq, Eq RuntimeCode
RuntimeCode -> RuntimeCode -> Bool
RuntimeCode -> RuntimeCode -> Ordering
RuntimeCode -> RuntimeCode -> RuntimeCode
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 :: RuntimeCode -> RuntimeCode -> RuntimeCode
$cmin :: RuntimeCode -> RuntimeCode -> RuntimeCode
max :: RuntimeCode -> RuntimeCode -> RuntimeCode
$cmax :: RuntimeCode -> RuntimeCode -> RuntimeCode
>= :: RuntimeCode -> RuntimeCode -> Bool
$c>= :: RuntimeCode -> RuntimeCode -> Bool
> :: RuntimeCode -> RuntimeCode -> Bool
$c> :: RuntimeCode -> RuntimeCode -> Bool
<= :: RuntimeCode -> RuntimeCode -> Bool
$c<= :: RuntimeCode -> RuntimeCode -> Bool
< :: RuntimeCode -> RuntimeCode -> Bool
$c< :: RuntimeCode -> RuntimeCode -> Bool
compare :: RuntimeCode -> RuntimeCode -> Ordering
$ccompare :: RuntimeCode -> RuntimeCode -> Ordering
Ord)

-- runtime err when used for symbolic code
instance Eq ContractCode where
  InitCode ByteString
a Expr 'Buf
b  == :: ContractCode -> ContractCode -> Bool
== InitCode ByteString
c Expr 'Buf
d  = ByteString
a forall a. Eq a => a -> a -> Bool
== ByteString
c Bool -> Bool -> Bool
&& Expr 'Buf
b forall a. Eq a => a -> a -> Bool
== Expr 'Buf
d
  RuntimeCode RuntimeCode
x == RuntimeCode RuntimeCode
y = RuntimeCode
x forall a. Eq a => a -> a -> Bool
== RuntimeCode
y
  ContractCode
_ == ContractCode
_ = Bool
False


-- Execution Traces --------------------------------------------------------------------------------


data Trace = Trace
  { Trace -> Int
opIx      :: Int
  , Trace -> Contract
contract  :: Contract
  , Trace -> TraceData
tracedata :: TraceData
  }
  deriving (Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> String
$cshow :: Trace -> String
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show, forall x. Rep Trace x -> Trace
forall x. Trace -> Rep Trace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Trace x -> Trace
$cfrom :: forall x. Trace -> Rep Trace x
Generic)

data TraceData
  = EventTrace (Expr EWord) (Expr Buf) [Expr EWord]
  | FrameTrace FrameContext
  | QueryTrace Query
  | ErrorTrace EvmError
  | EntryTrace Text
  | ReturnTrace (Expr Buf) FrameContext
  deriving (Int -> TraceData -> ShowS
[TraceData] -> ShowS
TraceData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceData] -> ShowS
$cshowList :: [TraceData] -> ShowS
show :: TraceData -> String
$cshow :: TraceData -> String
showsPrec :: Int -> TraceData -> ShowS
$cshowsPrec :: Int -> TraceData -> ShowS
Show, forall x. Rep TraceData x -> TraceData
forall x. TraceData -> Rep TraceData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TraceData x -> TraceData
$cfrom :: forall x. TraceData -> Rep TraceData x
Generic)


-- VM Initialization -------------------------------------------------------------------------------


-- | A specification for an initial VM state
data VMOpts = VMOpts
  { VMOpts -> Contract
contract :: Contract
  , VMOpts -> (Expr 'Buf, [Prop])
calldata :: (Expr Buf, [Prop])
  , VMOpts -> Expr 'Storage
initialStorage :: Expr Storage
  , VMOpts -> Expr 'EWord
value :: Expr EWord
  , VMOpts -> W256
priorityFee :: W256
  , VMOpts -> Addr
address :: Addr
  , VMOpts -> Expr 'EWord
caller :: Expr EWord
  , VMOpts -> Addr
origin :: Addr
  , VMOpts -> Word64
gas :: Word64
  , VMOpts -> Word64
gaslimit :: Word64
  , VMOpts -> W256
number :: W256
  , VMOpts -> Expr 'EWord
timestamp :: Expr EWord
  , VMOpts -> Addr
coinbase :: Addr
  , VMOpts -> W256
prevRandao :: W256
  , VMOpts -> W256
maxCodeSize :: W256
  , VMOpts -> Word64
blockGaslimit :: Word64
  , VMOpts -> W256
gasprice :: W256
  , VMOpts -> W256
baseFee :: W256
  , VMOpts -> FeeSchedule Word64
schedule :: FeeSchedule Word64
  , VMOpts -> W256
chainId :: W256
  , VMOpts -> Bool
create :: Bool
  , VMOpts -> Map Addr [W256]
txAccessList :: Map Addr [W256]
  , VMOpts -> Bool
allowFFI :: Bool
  } deriving Int -> VMOpts -> ShowS
[VMOpts] -> ShowS
VMOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VMOpts] -> ShowS
$cshowList :: [VMOpts] -> ShowS
show :: VMOpts -> String
$cshow :: VMOpts -> String
showsPrec :: Int -> VMOpts -> ShowS
$cshowsPrec :: Int -> VMOpts -> ShowS
Show


-- Opcodes -----------------------------------------------------------------------------------------


type Op = GenericOp (Expr EWord)

data GenericOp a
  = OpStop
  | OpAdd
  | OpMul
  | OpSub
  | OpDiv
  | OpSdiv
  | OpMod
  | OpSmod
  | OpAddmod
  | OpMulmod
  | OpExp
  | OpSignextend
  | OpLt
  | OpGt
  | OpSlt
  | OpSgt
  | OpEq
  | OpIszero
  | OpAnd
  | OpOr
  | OpXor
  | OpNot
  | OpByte
  | OpShl
  | OpShr
  | OpSar
  | OpSha3
  | OpAddress
  | OpBalance
  | OpOrigin
  | OpCaller
  | OpCallvalue
  | OpCalldataload
  | OpCalldatasize
  | OpCalldatacopy
  | OpCodesize
  | OpCodecopy
  | OpGasprice
  | OpExtcodesize
  | OpExtcodecopy
  | OpReturndatasize
  | OpReturndatacopy
  | OpExtcodehash
  | OpBlockhash
  | OpCoinbase
  | OpTimestamp
  | OpNumber
  | OpPrevRandao
  | OpGaslimit
  | OpChainid
  | OpSelfbalance
  | OpBaseFee
  | OpPop
  | OpMload
  | OpMstore
  | OpMstore8
  | OpSload
  | OpSstore
  | OpJump
  | OpJumpi
  | OpPc
  | OpMsize
  | OpGas
  | OpJumpdest
  | OpCreate
  | OpCall
  | OpStaticcall
  | OpCallcode
  | OpReturn
  | OpDelegatecall
  | OpCreate2
  | OpRevert
  | OpSelfdestruct
  | OpDup !Word8
  | OpSwap !Word8
  | OpLog !Word8
  | OpPush0
  | OpPush a
  | OpUnknown Word8
  deriving (Int -> GenericOp a -> ShowS
forall a. Show a => Int -> GenericOp a -> ShowS
forall a. Show a => [GenericOp a] -> ShowS
forall a. Show a => GenericOp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericOp a] -> ShowS
$cshowList :: forall a. Show a => [GenericOp a] -> ShowS
show :: GenericOp a -> String
$cshow :: forall a. Show a => GenericOp a -> String
showsPrec :: Int -> GenericOp a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GenericOp a -> ShowS
Show, GenericOp a -> GenericOp a -> Bool
forall a. Eq a => GenericOp a -> GenericOp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericOp a -> GenericOp a -> Bool
$c/= :: forall a. Eq a => GenericOp a -> GenericOp a -> Bool
== :: GenericOp a -> GenericOp a -> Bool
$c== :: forall a. Eq a => GenericOp a -> GenericOp a -> Bool
Eq, forall a b. a -> GenericOp b -> GenericOp a
forall a b. (a -> b) -> GenericOp a -> GenericOp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GenericOp b -> GenericOp a
$c<$ :: forall a b. a -> GenericOp b -> GenericOp a
fmap :: forall a b. (a -> b) -> GenericOp a -> GenericOp b
$cfmap :: forall a b. (a -> b) -> GenericOp a -> GenericOp b
Functor)


-- Function Selectors ------------------------------------------------------------------------------


-- | https://docs.soliditylang.org/en/v0.8.19/abi-spec.html#function-selector
newtype FunctionSelector = FunctionSelector { FunctionSelector -> Word32
unFunctionSelector :: Word32 }
  deriving (Integer -> FunctionSelector
FunctionSelector -> FunctionSelector
FunctionSelector -> FunctionSelector -> FunctionSelector
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> FunctionSelector
$cfromInteger :: Integer -> FunctionSelector
signum :: FunctionSelector -> FunctionSelector
$csignum :: FunctionSelector -> FunctionSelector
abs :: FunctionSelector -> FunctionSelector
$cabs :: FunctionSelector -> FunctionSelector
negate :: FunctionSelector -> FunctionSelector
$cnegate :: FunctionSelector -> FunctionSelector
* :: FunctionSelector -> FunctionSelector -> FunctionSelector
$c* :: FunctionSelector -> FunctionSelector -> FunctionSelector
- :: FunctionSelector -> FunctionSelector -> FunctionSelector
$c- :: FunctionSelector -> FunctionSelector -> FunctionSelector
+ :: FunctionSelector -> FunctionSelector -> FunctionSelector
$c+ :: FunctionSelector -> FunctionSelector -> FunctionSelector
Num, FunctionSelector -> FunctionSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionSelector -> FunctionSelector -> Bool
$c/= :: FunctionSelector -> FunctionSelector -> Bool
== :: FunctionSelector -> FunctionSelector -> Bool
$c== :: FunctionSelector -> FunctionSelector -> Bool
Eq, Eq FunctionSelector
FunctionSelector -> FunctionSelector -> Bool
FunctionSelector -> FunctionSelector -> Ordering
FunctionSelector -> FunctionSelector -> FunctionSelector
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 :: FunctionSelector -> FunctionSelector -> FunctionSelector
$cmin :: FunctionSelector -> FunctionSelector -> FunctionSelector
max :: FunctionSelector -> FunctionSelector -> FunctionSelector
$cmax :: FunctionSelector -> FunctionSelector -> FunctionSelector
>= :: FunctionSelector -> FunctionSelector -> Bool
$c>= :: FunctionSelector -> FunctionSelector -> Bool
> :: FunctionSelector -> FunctionSelector -> Bool
$c> :: FunctionSelector -> FunctionSelector -> Bool
<= :: FunctionSelector -> FunctionSelector -> Bool
$c<= :: FunctionSelector -> FunctionSelector -> Bool
< :: FunctionSelector -> FunctionSelector -> Bool
$c< :: FunctionSelector -> FunctionSelector -> Bool
compare :: FunctionSelector -> FunctionSelector -> Ordering
$ccompare :: FunctionSelector -> FunctionSelector -> Ordering
Ord, Num FunctionSelector
Ord FunctionSelector
FunctionSelector -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: FunctionSelector -> Rational
$ctoRational :: FunctionSelector -> Rational
Real, Int -> FunctionSelector
FunctionSelector -> Int
FunctionSelector -> [FunctionSelector]
FunctionSelector -> FunctionSelector
FunctionSelector -> FunctionSelector -> [FunctionSelector]
FunctionSelector
-> FunctionSelector -> FunctionSelector -> [FunctionSelector]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FunctionSelector
-> FunctionSelector -> FunctionSelector -> [FunctionSelector]
$cenumFromThenTo :: FunctionSelector
-> FunctionSelector -> FunctionSelector -> [FunctionSelector]
enumFromTo :: FunctionSelector -> FunctionSelector -> [FunctionSelector]
$cenumFromTo :: FunctionSelector -> FunctionSelector -> [FunctionSelector]
enumFromThen :: FunctionSelector -> FunctionSelector -> [FunctionSelector]
$cenumFromThen :: FunctionSelector -> FunctionSelector -> [FunctionSelector]
enumFrom :: FunctionSelector -> [FunctionSelector]
$cenumFrom :: FunctionSelector -> [FunctionSelector]
fromEnum :: FunctionSelector -> Int
$cfromEnum :: FunctionSelector -> Int
toEnum :: Int -> FunctionSelector
$ctoEnum :: Int -> FunctionSelector
pred :: FunctionSelector -> FunctionSelector
$cpred :: FunctionSelector -> FunctionSelector
succ :: FunctionSelector -> FunctionSelector
$csucc :: FunctionSelector -> FunctionSelector
Enum, Enum FunctionSelector
Real FunctionSelector
FunctionSelector -> Integer
FunctionSelector
-> FunctionSelector -> (FunctionSelector, FunctionSelector)
FunctionSelector -> FunctionSelector -> FunctionSelector
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: FunctionSelector -> Integer
$ctoInteger :: FunctionSelector -> Integer
divMod :: FunctionSelector
-> FunctionSelector -> (FunctionSelector, FunctionSelector)
$cdivMod :: FunctionSelector
-> FunctionSelector -> (FunctionSelector, FunctionSelector)
quotRem :: FunctionSelector
-> FunctionSelector -> (FunctionSelector, FunctionSelector)
$cquotRem :: FunctionSelector
-> FunctionSelector -> (FunctionSelector, FunctionSelector)
mod :: FunctionSelector -> FunctionSelector -> FunctionSelector
$cmod :: FunctionSelector -> FunctionSelector -> FunctionSelector
div :: FunctionSelector -> FunctionSelector -> FunctionSelector
$cdiv :: FunctionSelector -> FunctionSelector -> FunctionSelector
rem :: FunctionSelector -> FunctionSelector -> FunctionSelector
$crem :: FunctionSelector -> FunctionSelector -> FunctionSelector
quot :: FunctionSelector -> FunctionSelector -> FunctionSelector
$cquot :: FunctionSelector -> FunctionSelector -> FunctionSelector
Integral)
instance Show FunctionSelector where show :: FunctionSelector -> String
show FunctionSelector
s = String
"0x" forall a. Semigroup a => a -> a -> a
<> forall a. (Integral a, Show a) => a -> ShowS
showHex FunctionSelector
s String
""


-- ByteString wrapper ------------------------------------------------------------------------------


-- Newtype wrapper for ByteString to allow custom instances
newtype ByteStringS = ByteStringS ByteString deriving (ByteStringS -> ByteStringS -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteStringS -> ByteStringS -> Bool
$c/= :: ByteStringS -> ByteStringS -> Bool
== :: ByteStringS -> ByteStringS -> Bool
$c== :: ByteStringS -> ByteStringS -> Bool
Eq, forall x. Rep ByteStringS x -> ByteStringS
forall x. ByteStringS -> Rep ByteStringS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ByteStringS x -> ByteStringS
$cfrom :: forall x. ByteStringS -> Rep ByteStringS x
Generic)

instance Show ByteStringS where
  show :: ByteStringS -> String
show (ByteStringS ByteString
x) = (String
"0x" ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
fromBinary forall a b. (a -> b) -> a -> b
$ ByteString
x
    where
      fromBinary :: ByteString -> Text
fromBinary =
        ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteStringHex

instance JSON.FromJSON ByteStringS where
  parseJSON :: Value -> Parser ByteStringS
parseJSON (JSON.String Text
x) = case Text -> Either Text ByteString
BS16.decodeBase16' Text
x of
                                Left Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
                                Right ByteString
bs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteStringS
ByteStringS ByteString
bs)
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance JSON.ToJSON ByteStringS where
  toJSON :: ByteStringS -> Value
toJSON (ByteStringS ByteString
x) = Text -> Value
JSON.String (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"0x" forall a. [a] -> [a] -> [a]
++ (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. (Show a, Integral a) => Int -> a -> String
paddedShowHex Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack forall a b. (a -> b) -> a -> b
$ ByteString
x))


-- Word256 wrapper ---------------------------------------------------------------------------------


-- Newtype wrapper around Word256 to allow custom instances
newtype W256 = W256 Word256
  deriving
    ( Integer -> W256
W256 -> W256
W256 -> W256 -> W256
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> W256
$cfromInteger :: Integer -> W256
signum :: W256 -> W256
$csignum :: W256 -> W256
abs :: W256 -> W256
$cabs :: W256 -> W256
negate :: W256 -> W256
$cnegate :: W256 -> W256
* :: W256 -> W256 -> W256
$c* :: W256 -> W256 -> W256
- :: W256 -> W256 -> W256
$c- :: W256 -> W256 -> W256
+ :: W256 -> W256 -> W256
$c+ :: W256 -> W256 -> W256
Num, Enum W256
Real W256
W256 -> Integer
W256 -> W256 -> (W256, W256)
W256 -> W256 -> W256
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: W256 -> Integer
$ctoInteger :: W256 -> Integer
divMod :: W256 -> W256 -> (W256, W256)
$cdivMod :: W256 -> W256 -> (W256, W256)
quotRem :: W256 -> W256 -> (W256, W256)
$cquotRem :: W256 -> W256 -> (W256, W256)
mod :: W256 -> W256 -> W256
$cmod :: W256 -> W256 -> W256
div :: W256 -> W256 -> W256
$cdiv :: W256 -> W256 -> W256
rem :: W256 -> W256 -> W256
$crem :: W256 -> W256 -> W256
quot :: W256 -> W256 -> W256
$cquot :: W256 -> W256 -> W256
Integral, Num W256
Ord W256
W256 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: W256 -> Rational
$ctoRational :: W256 -> Rational
Real, Eq W256
W256 -> W256 -> Bool
W256 -> W256 -> Ordering
W256 -> W256 -> W256
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 :: W256 -> W256 -> W256
$cmin :: W256 -> W256 -> W256
max :: W256 -> W256 -> W256
$cmax :: W256 -> W256 -> W256
>= :: W256 -> W256 -> Bool
$c>= :: W256 -> W256 -> Bool
> :: W256 -> W256 -> Bool
$c> :: W256 -> W256 -> Bool
<= :: W256 -> W256 -> Bool
$c<= :: W256 -> W256 -> Bool
< :: W256 -> W256 -> Bool
$c< :: W256 -> W256 -> Bool
compare :: W256 -> W256 -> Ordering
$ccompare :: W256 -> W256 -> Ordering
Ord, Eq W256
W256
Int -> W256
W256 -> Bool
W256 -> Int
W256 -> Maybe Int
W256 -> W256
W256 -> Int -> Bool
W256 -> Int -> W256
W256 -> W256 -> W256
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: W256 -> Int
$cpopCount :: W256 -> Int
rotateR :: W256 -> Int -> W256
$crotateR :: W256 -> Int -> W256
rotateL :: W256 -> Int -> W256
$crotateL :: W256 -> Int -> W256
unsafeShiftR :: W256 -> Int -> W256
$cunsafeShiftR :: W256 -> Int -> W256
shiftR :: W256 -> Int -> W256
$cshiftR :: W256 -> Int -> W256
unsafeShiftL :: W256 -> Int -> W256
$cunsafeShiftL :: W256 -> Int -> W256
shiftL :: W256 -> Int -> W256
$cshiftL :: W256 -> Int -> W256
isSigned :: W256 -> Bool
$cisSigned :: W256 -> Bool
bitSize :: W256 -> Int
$cbitSize :: W256 -> Int
bitSizeMaybe :: W256 -> Maybe Int
$cbitSizeMaybe :: W256 -> Maybe Int
testBit :: W256 -> Int -> Bool
$ctestBit :: W256 -> Int -> Bool
complementBit :: W256 -> Int -> W256
$ccomplementBit :: W256 -> Int -> W256
clearBit :: W256 -> Int -> W256
$cclearBit :: W256 -> Int -> W256
setBit :: W256 -> Int -> W256
$csetBit :: W256 -> Int -> W256
bit :: Int -> W256
$cbit :: Int -> W256
zeroBits :: W256
$czeroBits :: W256
rotate :: W256 -> Int -> W256
$crotate :: W256 -> Int -> W256
shift :: W256 -> Int -> W256
$cshift :: W256 -> Int -> W256
complement :: W256 -> W256
$ccomplement :: W256 -> W256
xor :: W256 -> W256 -> W256
$cxor :: W256 -> W256 -> W256
.|. :: W256 -> W256 -> W256
$c.|. :: W256 -> W256 -> W256
.&. :: W256 -> W256 -> W256
$c.&. :: W256 -> W256 -> W256
Bits
    , forall x. Rep W256 x -> W256
forall x. W256 -> Rep W256 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep W256 x -> W256
$cfrom :: forall x. W256 -> Rep W256 x
Generic, Bits W256
W256 -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: W256 -> Int
$ccountTrailingZeros :: W256 -> Int
countLeadingZeros :: W256 -> Int
$ccountLeadingZeros :: W256 -> Int
finiteBitSize :: W256 -> Int
$cfiniteBitSize :: W256 -> Int
FiniteBits, Int -> W256
W256 -> Int
W256 -> [W256]
W256 -> W256
W256 -> W256 -> [W256]
W256 -> W256 -> W256 -> [W256]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: W256 -> W256 -> W256 -> [W256]
$cenumFromThenTo :: W256 -> W256 -> W256 -> [W256]
enumFromTo :: W256 -> W256 -> [W256]
$cenumFromTo :: W256 -> W256 -> [W256]
enumFromThen :: W256 -> W256 -> [W256]
$cenumFromThen :: W256 -> W256 -> [W256]
enumFrom :: W256 -> [W256]
$cenumFrom :: W256 -> [W256]
fromEnum :: W256 -> Int
$cfromEnum :: W256 -> Int
toEnum :: Int -> W256
$ctoEnum :: Int -> W256
pred :: W256 -> W256
$cpred :: W256 -> W256
succ :: W256 -> W256
$csucc :: W256 -> W256
Enum, W256 -> W256 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: W256 -> W256 -> Bool
$c/= :: W256 -> W256 -> Bool
== :: W256 -> W256 -> Bool
$c== :: W256 -> W256 -> Bool
Eq , W256
forall a. a -> a -> Bounded a
maxBound :: W256
$cmaxBound :: W256
minBound :: W256
$cminBound :: W256
Bounded
    )

instance Read W256 where
  readsPrec :: Int -> ReadS W256
readsPrec Int
_ String
"0x" = [(W256
0, String
"")]
  readsPrec Int
n String
s = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Word256 -> W256
W256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s

instance Show W256 where
  showsPrec :: Int -> W256 -> ShowS
showsPrec Int
_ W256
s = (String
"0x" ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex W256
s

instance JSON.ToJSON W256 where
  toJSON :: W256 -> Value
toJSON W256
x = Text -> Value
JSON.String  forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String
"0x" forall a. [a] -> [a] -> [a]
++ String
pad forall a. [a] -> [a] -> [a]
++ String
cutshow)
    where
      cutshow :: String
cutshow = forall a. Int -> [a] -> [a]
drop Int
2 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show W256
x
      pad :: String
pad = forall a. Int -> a -> [a]
replicate (Int
64 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
cutshow)) Char
'0'

instance FromJSON W256 where
  parseJSON :: Value -> Parser W256
parseJSON Value
v = do
    String
s <- Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case forall a. Read a => ReadS a
reads String
s of
      [(W256
x, String
"")]  -> forall (m :: * -> *) a. Monad m => a -> m a
return W256
x
      [(W256, String)]
_          -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid hex word (" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")"

instance FromJSONKey W256 where
  fromJSONKey :: FromJSONKeyFunction W256
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
s ->
    case forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
s) of
      [(W256
x, String
"")]  -> forall (m :: * -> *) a. Monad m => a -> m a
return W256
x
      [(W256, String)]
_          -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid word (" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s forall a. [a] -> [a] -> [a]
++ String
")"

wordField :: JSON.Object -> Key -> JSON.Parser W256
wordField :: Object -> Key -> Parser W256
wordField Object
x Key
f = ((forall a. Read a => a -> String -> a
readNull W256
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
.: Key
f)

instance ParseField W256
instance ParseFields W256
instance ParseRecord W256 where
  parseRecord :: Parser W256
parseRecord = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Only a -> a
getOnly forall a. ParseRecord a => Parser a
parseRecord


-- Word64 wrapper ----------------------------------------------------------------------------------


newtype W64 = W64 Data.Word.Word64
  deriving
    ( Integer -> W64
W64 -> W64
W64 -> W64 -> W64
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> W64
$cfromInteger :: Integer -> W64
signum :: W64 -> W64
$csignum :: W64 -> W64
abs :: W64 -> W64
$cabs :: W64 -> W64
negate :: W64 -> W64
$cnegate :: W64 -> W64
* :: W64 -> W64 -> W64
$c* :: W64 -> W64 -> W64
- :: W64 -> W64 -> W64
$c- :: W64 -> W64 -> W64
+ :: W64 -> W64 -> W64
$c+ :: W64 -> W64 -> W64
Num, Enum W64
Real W64
W64 -> Integer
W64 -> W64 -> (W64, W64)
W64 -> W64 -> W64
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: W64 -> Integer
$ctoInteger :: W64 -> Integer
divMod :: W64 -> W64 -> (W64, W64)
$cdivMod :: W64 -> W64 -> (W64, W64)
quotRem :: W64 -> W64 -> (W64, W64)
$cquotRem :: W64 -> W64 -> (W64, W64)
mod :: W64 -> W64 -> W64
$cmod :: W64 -> W64 -> W64
div :: W64 -> W64 -> W64
$cdiv :: W64 -> W64 -> W64
rem :: W64 -> W64 -> W64
$crem :: W64 -> W64 -> W64
quot :: W64 -> W64 -> W64
$cquot :: W64 -> W64 -> W64
Integral, Num W64
Ord W64
W64 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: W64 -> Rational
$ctoRational :: W64 -> Rational
Real, Eq W64
W64 -> W64 -> Bool
W64 -> W64 -> Ordering
W64 -> W64 -> W64
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 :: W64 -> W64 -> W64
$cmin :: W64 -> W64 -> W64
max :: W64 -> W64 -> W64
$cmax :: W64 -> W64 -> W64
>= :: W64 -> W64 -> Bool
$c>= :: W64 -> W64 -> Bool
> :: W64 -> W64 -> Bool
$c> :: W64 -> W64 -> Bool
<= :: W64 -> W64 -> Bool
$c<= :: W64 -> W64 -> Bool
< :: W64 -> W64 -> Bool
$c< :: W64 -> W64 -> Bool
compare :: W64 -> W64 -> Ordering
$ccompare :: W64 -> W64 -> Ordering
Ord, forall x. Rep W64 x -> W64
forall x. W64 -> Rep W64 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep W64 x -> W64
$cfrom :: forall x. W64 -> Rep W64 x
Generic
    , Eq W64
W64
Int -> W64
W64 -> Bool
W64 -> Int
W64 -> Maybe Int
W64 -> W64
W64 -> Int -> Bool
W64 -> Int -> W64
W64 -> W64 -> W64
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: W64 -> Int
$cpopCount :: W64 -> Int
rotateR :: W64 -> Int -> W64
$crotateR :: W64 -> Int -> W64
rotateL :: W64 -> Int -> W64
$crotateL :: W64 -> Int -> W64
unsafeShiftR :: W64 -> Int -> W64
$cunsafeShiftR :: W64 -> Int -> W64
shiftR :: W64 -> Int -> W64
$cshiftR :: W64 -> Int -> W64
unsafeShiftL :: W64 -> Int -> W64
$cunsafeShiftL :: W64 -> Int -> W64
shiftL :: W64 -> Int -> W64
$cshiftL :: W64 -> Int -> W64
isSigned :: W64 -> Bool
$cisSigned :: W64 -> Bool
bitSize :: W64 -> Int
$cbitSize :: W64 -> Int
bitSizeMaybe :: W64 -> Maybe Int
$cbitSizeMaybe :: W64 -> Maybe Int
testBit :: W64 -> Int -> Bool
$ctestBit :: W64 -> Int -> Bool
complementBit :: W64 -> Int -> W64
$ccomplementBit :: W64 -> Int -> W64
clearBit :: W64 -> Int -> W64
$cclearBit :: W64 -> Int -> W64
setBit :: W64 -> Int -> W64
$csetBit :: W64 -> Int -> W64
bit :: Int -> W64
$cbit :: Int -> W64
zeroBits :: W64
$czeroBits :: W64
rotate :: W64 -> Int -> W64
$crotate :: W64 -> Int -> W64
shift :: W64 -> Int -> W64
$cshift :: W64 -> Int -> W64
complement :: W64 -> W64
$ccomplement :: W64 -> W64
xor :: W64 -> W64 -> W64
$cxor :: W64 -> W64 -> W64
.|. :: W64 -> W64 -> W64
$c.|. :: W64 -> W64 -> W64
.&. :: W64 -> W64 -> W64
$c.&. :: W64 -> W64 -> W64
Bits , Bits W64
W64 -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: W64 -> Int
$ccountTrailingZeros :: W64 -> Int
countLeadingZeros :: W64 -> Int
$ccountLeadingZeros :: W64 -> Int
finiteBitSize :: W64 -> Int
$cfiniteBitSize :: W64 -> Int
FiniteBits, Int -> W64
W64 -> Int
W64 -> [W64]
W64 -> W64
W64 -> W64 -> [W64]
W64 -> W64 -> W64 -> [W64]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: W64 -> W64 -> W64 -> [W64]
$cenumFromThenTo :: W64 -> W64 -> W64 -> [W64]
enumFromTo :: W64 -> W64 -> [W64]
$cenumFromTo :: W64 -> W64 -> [W64]
enumFromThen :: W64 -> W64 -> [W64]
$cenumFromThen :: W64 -> W64 -> [W64]
enumFrom :: W64 -> [W64]
$cenumFrom :: W64 -> [W64]
fromEnum :: W64 -> Int
$cfromEnum :: W64 -> Int
toEnum :: Int -> W64
$ctoEnum :: Int -> W64
pred :: W64 -> W64
$cpred :: W64 -> W64
succ :: W64 -> W64
$csucc :: W64 -> W64
Enum, W64 -> W64 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: W64 -> W64 -> Bool
$c/= :: W64 -> W64 -> Bool
== :: W64 -> W64 -> Bool
$c== :: W64 -> W64 -> Bool
Eq , W64
forall a. a -> a -> Bounded a
maxBound :: W64
$cmaxBound :: W64
minBound :: W64
$cminBound :: W64
Bounded
    )
instance JSON.FromJSON W64

instance Read W64 where
  readsPrec :: Int -> ReadS W64
readsPrec Int
_ String
"0x" = [(W64
0, String
"")]
  readsPrec Int
n String
s = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Word64 -> W64
W64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s

instance Show W64 where
  showsPrec :: Int -> W64 -> ShowS
showsPrec Int
_ W64
s = (String
"0x" ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex W64
s

instance JSON.ToJSON W64 where
  toJSON :: W64 -> Value
toJSON W64
x = Text -> Value
JSON.String  forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show W64
x

word64Field :: JSON.Object -> Key -> JSON.Parser Word64
word64Field :: Object -> Key -> Parser Word64
word64Field Object
x Key
f = ((forall a. Read a => a -> String -> a
readNull Word64
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
.: Key
f)


-- Addresses ---------------------------------------------------------------------------------------


newtype Addr = Addr { Addr -> Word160
addressWord160 :: Word160 }
  deriving
    ( Integer -> Addr
Addr -> Addr
Addr -> Addr -> Addr
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Addr
$cfromInteger :: Integer -> Addr
signum :: Addr -> Addr
$csignum :: Addr -> Addr
abs :: Addr -> Addr
$cabs :: Addr -> Addr
negate :: Addr -> Addr
$cnegate :: Addr -> Addr
* :: Addr -> Addr -> Addr
$c* :: Addr -> Addr -> Addr
- :: Addr -> Addr -> Addr
$c- :: Addr -> Addr -> Addr
+ :: Addr -> Addr -> Addr
$c+ :: Addr -> Addr -> Addr
Num, Enum Addr
Real Addr
Addr -> Integer
Addr -> Addr -> (Addr, Addr)
Addr -> Addr -> Addr
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Addr -> Integer
$ctoInteger :: Addr -> Integer
divMod :: Addr -> Addr -> (Addr, Addr)
$cdivMod :: Addr -> Addr -> (Addr, Addr)
quotRem :: Addr -> Addr -> (Addr, Addr)
$cquotRem :: Addr -> Addr -> (Addr, Addr)
mod :: Addr -> Addr -> Addr
$cmod :: Addr -> Addr -> Addr
div :: Addr -> Addr -> Addr
$cdiv :: Addr -> Addr -> Addr
rem :: Addr -> Addr -> Addr
$crem :: Addr -> Addr -> Addr
quot :: Addr -> Addr -> Addr
$cquot :: Addr -> Addr -> Addr
Integral, Num Addr
Ord Addr
Addr -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Addr -> Rational
$ctoRational :: Addr -> Rational
Real, Eq Addr
Addr -> Addr -> Bool
Addr -> Addr -> Ordering
Addr -> Addr -> Addr
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 :: Addr -> Addr -> Addr
$cmin :: Addr -> Addr -> Addr
max :: Addr -> Addr -> Addr
$cmax :: Addr -> Addr -> Addr
>= :: Addr -> Addr -> Bool
$c>= :: Addr -> Addr -> Bool
> :: Addr -> Addr -> Bool
$c> :: Addr -> Addr -> Bool
<= :: Addr -> Addr -> Bool
$c<= :: Addr -> Addr -> Bool
< :: Addr -> Addr -> Bool
$c< :: Addr -> Addr -> Bool
compare :: Addr -> Addr -> Ordering
$ccompare :: Addr -> Addr -> Ordering
Ord, Int -> Addr
Addr -> Int
Addr -> [Addr]
Addr -> Addr
Addr -> Addr -> [Addr]
Addr -> Addr -> Addr -> [Addr]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Addr -> Addr -> Addr -> [Addr]
$cenumFromThenTo :: Addr -> Addr -> Addr -> [Addr]
enumFromTo :: Addr -> Addr -> [Addr]
$cenumFromTo :: Addr -> Addr -> [Addr]
enumFromThen :: Addr -> Addr -> [Addr]
$cenumFromThen :: Addr -> Addr -> [Addr]
enumFrom :: Addr -> [Addr]
$cenumFrom :: Addr -> [Addr]
fromEnum :: Addr -> Int
$cfromEnum :: Addr -> Int
toEnum :: Int -> Addr
$ctoEnum :: Int -> Addr
pred :: Addr -> Addr
$cpred :: Addr -> Addr
succ :: Addr -> Addr
$csucc :: Addr -> Addr
Enum
    , Addr -> Addr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c== :: Addr -> Addr -> Bool
Eq, forall x. Rep Addr x -> Addr
forall x. Addr -> Rep Addr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Addr x -> Addr
$cfrom :: forall x. Addr -> Rep Addr x
Generic, Eq Addr
Addr
Int -> Addr
Addr -> Bool
Addr -> Int
Addr -> Maybe Int
Addr -> Addr
Addr -> Int -> Bool
Addr -> Int -> Addr
Addr -> Addr -> Addr
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Addr -> Int
$cpopCount :: Addr -> Int
rotateR :: Addr -> Int -> Addr
$crotateR :: Addr -> Int -> Addr
rotateL :: Addr -> Int -> Addr
$crotateL :: Addr -> Int -> Addr
unsafeShiftR :: Addr -> Int -> Addr
$cunsafeShiftR :: Addr -> Int -> Addr
shiftR :: Addr -> Int -> Addr
$cshiftR :: Addr -> Int -> Addr
unsafeShiftL :: Addr -> Int -> Addr
$cunsafeShiftL :: Addr -> Int -> Addr
shiftL :: Addr -> Int -> Addr
$cshiftL :: Addr -> Int -> Addr
isSigned :: Addr -> Bool
$cisSigned :: Addr -> Bool
bitSize :: Addr -> Int
$cbitSize :: Addr -> Int
bitSizeMaybe :: Addr -> Maybe Int
$cbitSizeMaybe :: Addr -> Maybe Int
testBit :: Addr -> Int -> Bool
$ctestBit :: Addr -> Int -> Bool
complementBit :: Addr -> Int -> Addr
$ccomplementBit :: Addr -> Int -> Addr
clearBit :: Addr -> Int -> Addr
$cclearBit :: Addr -> Int -> Addr
setBit :: Addr -> Int -> Addr
$csetBit :: Addr -> Int -> Addr
bit :: Int -> Addr
$cbit :: Int -> Addr
zeroBits :: Addr
$czeroBits :: Addr
rotate :: Addr -> Int -> Addr
$crotate :: Addr -> Int -> Addr
shift :: Addr -> Int -> Addr
$cshift :: Addr -> Int -> Addr
complement :: Addr -> Addr
$ccomplement :: Addr -> Addr
xor :: Addr -> Addr -> Addr
$cxor :: Addr -> Addr -> Addr
.|. :: Addr -> Addr -> Addr
$c.|. :: Addr -> Addr -> Addr
.&. :: Addr -> Addr -> Addr
$c.&. :: Addr -> Addr -> Addr
Bits, Bits Addr
Addr -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Addr -> Int
$ccountTrailingZeros :: Addr -> Int
countLeadingZeros :: Addr -> Int
$ccountLeadingZeros :: Addr -> Int
finiteBitSize :: Addr -> Int
$cfiniteBitSize :: Addr -> Int
FiniteBits
    )

instance Read Addr where
  readsPrec :: Int -> ReadS Addr
readsPrec Int
_ (Char
'0':Char
'x':String
s) = forall a. (Eq a, Num a) => ReadS a
readHex String
s
  readsPrec Int
_ String
s = forall a. (Eq a, Num a) => ReadS a
readHex String
s

instance Show Addr where
  showsPrec :: Int -> Addr -> ShowS
showsPrec Int
_ Addr
addr String
next =
    let hex :: String
hex = forall a. (Integral a, Show a) => a -> ShowS
showHex Addr
addr String
next
        str :: String
str = forall a. Int -> a -> [a]
replicate (Int
40 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex) Char
'0' forall a. [a] -> [a] -> [a]
++ String
hex
    in String
"0x" forall a. [a] -> [a] -> [a]
++ ShowS
toChecksumAddress String
str forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
40 String
str

-- https://eips.ethereum.org/EIPS/eip-55
toChecksumAddress :: String -> String
toChecksumAddress :: ShowS
toChecksumAddress String
addr = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. (Ord a, Num a) => a -> Char -> Char
transform [Nibble]
nibbles String
addr
  where
    nibbles :: [Nibble]
nibbles = ByteString -> [Nibble]
unpackNibbles forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
20 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
keccakBytes (String -> ByteString
Char8.pack String
addr)
    transform :: a -> Char -> Char
transform a
nibble = if a
nibble forall a. Ord a => a -> a -> Bool
>= a
8 then Char -> Char
toUpper else forall a. a -> a
id

instance JSON.ToJSON Addr where
  toJSON :: Addr -> Value
toJSON = Text -> Value
JSON.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance FromJSON Addr where
  parseJSON :: Value -> Parser Addr
parseJSON Value
v = do
    String
s <- Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case forall a. Read a => ReadS a
reads String
s of
      [(Addr
x, String
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return Addr
x
      [(Addr, String)]
_         -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid address (" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")"

instance JSON.ToJSONKey Addr where
  toJSONKey :: ToJSONKeyFunction Addr
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
JSON.toJSONKeyText (Addr -> Text
addrKey)
    where
      addrKey :: Addr -> Text
      addrKey :: Addr -> Text
addrKey Addr
addr = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
40 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex) Char
'0' forall a. [a] -> [a] -> [a]
++ String
hex
        where
          hex :: String
hex = forall a. Show a => a -> String
show Addr
addr

instance FromJSONKey Addr where
  fromJSONKey :: FromJSONKeyFunction Addr
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
s ->
    case forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
s) of
      [(Addr
x, String
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return Addr
x
      [(Addr, String)]
_         -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid word (" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s forall a. [a] -> [a] -> [a]
++ String
")"

addrField :: JSON.Object -> Key -> JSON.Parser Addr
addrField :: Object -> Key -> Parser Addr
addrField Object
x Key
f = (forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
.: Key
f)

addrFieldMaybe :: JSON.Object -> Key -> JSON.Parser (Maybe Addr)
addrFieldMaybe :: Object -> Key -> Parser (Maybe Addr)
addrFieldMaybe Object
x Key
f = (forall a. Read a => String -> Maybe a
Text.Read.readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
.: Key
f)

instance ParseField Addr
instance ParseFields Addr
instance ParseRecord Addr where
  parseRecord :: Parser Addr
parseRecord = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Only a -> a
getOnly forall a. ParseRecord a => Parser a
parseRecord


-- Nibbles -----------------------------------------------------------------------------------------


-- | A four bit value
newtype Nibble = Nibble Word8
  deriving ( Integer -> Nibble
Nibble -> Nibble
Nibble -> Nibble -> Nibble
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Nibble
$cfromInteger :: Integer -> Nibble
signum :: Nibble -> Nibble
$csignum :: Nibble -> Nibble
abs :: Nibble -> Nibble
$cabs :: Nibble -> Nibble
negate :: Nibble -> Nibble
$cnegate :: Nibble -> Nibble
* :: Nibble -> Nibble -> Nibble
$c* :: Nibble -> Nibble -> Nibble
- :: Nibble -> Nibble -> Nibble
$c- :: Nibble -> Nibble -> Nibble
+ :: Nibble -> Nibble -> Nibble
$c+ :: Nibble -> Nibble -> Nibble
Num, Enum Nibble
Real Nibble
Nibble -> Integer
Nibble -> Nibble -> (Nibble, Nibble)
Nibble -> Nibble -> Nibble
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Nibble -> Integer
$ctoInteger :: Nibble -> Integer
divMod :: Nibble -> Nibble -> (Nibble, Nibble)
$cdivMod :: Nibble -> Nibble -> (Nibble, Nibble)
quotRem :: Nibble -> Nibble -> (Nibble, Nibble)
$cquotRem :: Nibble -> Nibble -> (Nibble, Nibble)
mod :: Nibble -> Nibble -> Nibble
$cmod :: Nibble -> Nibble -> Nibble
div :: Nibble -> Nibble -> Nibble
$cdiv :: Nibble -> Nibble -> Nibble
rem :: Nibble -> Nibble -> Nibble
$crem :: Nibble -> Nibble -> Nibble
quot :: Nibble -> Nibble -> Nibble
$cquot :: Nibble -> Nibble -> Nibble
Integral, Num Nibble
Ord Nibble
Nibble -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Nibble -> Rational
$ctoRational :: Nibble -> Rational
Real, Eq Nibble
Nibble -> Nibble -> Bool
Nibble -> Nibble -> Ordering
Nibble -> Nibble -> Nibble
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 :: Nibble -> Nibble -> Nibble
$cmin :: Nibble -> Nibble -> Nibble
max :: Nibble -> Nibble -> Nibble
$cmax :: Nibble -> Nibble -> Nibble
>= :: Nibble -> Nibble -> Bool
$c>= :: Nibble -> Nibble -> Bool
> :: Nibble -> Nibble -> Bool
$c> :: Nibble -> Nibble -> Bool
<= :: Nibble -> Nibble -> Bool
$c<= :: Nibble -> Nibble -> Bool
< :: Nibble -> Nibble -> Bool
$c< :: Nibble -> Nibble -> Bool
compare :: Nibble -> Nibble -> Ordering
$ccompare :: Nibble -> Nibble -> Ordering
Ord, Int -> Nibble
Nibble -> Int
Nibble -> [Nibble]
Nibble -> Nibble
Nibble -> Nibble -> [Nibble]
Nibble -> Nibble -> Nibble -> [Nibble]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Nibble -> Nibble -> Nibble -> [Nibble]
$cenumFromThenTo :: Nibble -> Nibble -> Nibble -> [Nibble]
enumFromTo :: Nibble -> Nibble -> [Nibble]
$cenumFromTo :: Nibble -> Nibble -> [Nibble]
enumFromThen :: Nibble -> Nibble -> [Nibble]
$cenumFromThen :: Nibble -> Nibble -> [Nibble]
enumFrom :: Nibble -> [Nibble]
$cenumFrom :: Nibble -> [Nibble]
fromEnum :: Nibble -> Int
$cfromEnum :: Nibble -> Int
toEnum :: Int -> Nibble
$ctoEnum :: Int -> Nibble
pred :: Nibble -> Nibble
$cpred :: Nibble -> Nibble
succ :: Nibble -> Nibble
$csucc :: Nibble -> Nibble
Enum, Nibble -> Nibble -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nibble -> Nibble -> Bool
$c/= :: Nibble -> Nibble -> Bool
== :: Nibble -> Nibble -> Bool
$c== :: Nibble -> Nibble -> Bool
Eq, Nibble
forall a. a -> a -> Bounded a
maxBound :: Nibble
$cmaxBound :: Nibble
minBound :: Nibble
$cminBound :: Nibble
Bounded, forall x. Rep Nibble x -> Nibble
forall x. Nibble -> Rep Nibble x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Nibble x -> Nibble
$cfrom :: forall x. Nibble -> Rep Nibble x
Generic)

instance Show Nibble where
  show :: Nibble -> String
show = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
intToDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
num


-- Conversions -------------------------------------------------------------------------------------


toWord512 :: W256 -> Word512
toWord512 :: W256 -> Word512
toWord512 (W256 Word256
x) = forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word256
0 Word256
x

fromWord512 :: Word512 -> W256
fromWord512 :: Word512 -> W256
fromWord512 Word512
x = Word256 -> W256
W256 (forall w. DoubleWord w => w -> LoWord w
loWord Word512
x)

maybeLitByte :: Expr Byte -> Maybe Word8
maybeLitByte :: Expr 'Byte -> Maybe Word8
maybeLitByte (LitByte Word8
x) = forall a. a -> Maybe a
Just Word8
x
maybeLitByte Expr 'Byte
_ = forall a. Maybe a
Nothing

maybeLitWord :: Expr EWord -> Maybe W256
maybeLitWord :: Expr 'EWord -> Maybe W256
maybeLitWord (Lit W256
w) = forall a. a -> Maybe a
Just W256
w
maybeLitWord Expr 'EWord
_ = forall a. Maybe a
Nothing

word256 :: ByteString -> Word256
word256 :: ByteString -> Word256
word256 ByteString
xs | ByteString -> Int
BS.length ByteString
xs forall a. Eq a => a -> a -> Bool
== Int
1 =
  -- optimize one byte pushes
  Word128 -> Word128 -> Word256
Word256 (Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
0) (Word64 -> Word64 -> Word128
Word128 Word64
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Word8
BS.head ByteString
xs))
word256 ByteString
xs = case forall a. Get a -> ByteString -> Either String a
Cereal.runGet Get Word256
m (Int -> ByteString -> ByteString
padLeft Int
32 ByteString
xs) of
               Left String
_ -> forall a. HasCallStack => String -> a
error String
"internal error"
               Right Word256
x -> Word256
x
  where
    m :: Get Word256
m = do Word64
a <- Get Word64
Cereal.getWord64be
           Word64
b <- Get Word64
Cereal.getWord64be
           Word64
c <- Get Word64
Cereal.getWord64be
           Word64
d <- Get Word64
Cereal.getWord64be
           forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word128 -> Word128 -> Word256
Word256 (Word64 -> Word64 -> Word128
Word128 Word64
a Word64
b) (Word64 -> Word64 -> Word128
Word128 Word64
c Word64
d)

word :: ByteString -> W256
word :: ByteString -> W256
word = Word256 -> W256
W256 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word256
word256

fromBE :: (Integral a) => ByteString -> a
fromBE :: forall a. Integral a => ByteString -> a
fromBE ByteString
xs = if ByteString
xs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then a
0
  else a
256 forall a. Num a => a -> a -> a
* forall a. Integral a => ByteString -> a
fromBE (HasCallStack => ByteString -> ByteString
BS.init ByteString
xs)
       forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Word8
BS.last ByteString
xs)

asBE :: (Integral a) => a -> ByteString
asBE :: forall a. Integral a => a -> ByteString
asBE a
0 = forall a. Monoid a => a
mempty
asBE a
x = forall a. Integral a => a -> ByteString
asBE (a
x forall a. Integral a => a -> a -> a
`div` a
256)
  forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack [forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ a
x forall a. Integral a => a -> a -> a
`mod` a
256]

word256Bytes :: W256 -> ByteString
word256Bytes :: W256 -> ByteString
word256Bytes (W256 (Word256 (Word128 Word64
a Word64
b) (Word128 Word64
c Word64
d))) =
  forall a. Serialize a => a -> ByteString
Cereal.encode Word64
a forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
Cereal.encode Word64
b forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
Cereal.encode Word64
c forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
Cereal.encode Word64
d

word160Bytes :: Addr -> ByteString
word160Bytes :: Addr -> ByteString
word160Bytes (Addr (Word160 Word32
a (Word128 Word64
b Word64
c))) =
  forall a. Serialize a => a -> ByteString
Cereal.encode Word32
a forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
Cereal.encode Word64
b forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
Cereal.encode Word64
c

-- Get first and second Nibble from byte
hi, lo :: Word8 -> Nibble
hi :: Word8 -> Nibble
hi Word8
b = Word8 -> Nibble
Nibble forall a b. (a -> b) -> a -> b
$ Word8
b forall a. Bits a => a -> Int -> a
`shiftR` Int
4
lo :: Word8 -> Nibble
lo Word8
b = Word8 -> Nibble
Nibble forall a b. (a -> b) -> a -> b
$ Word8
b forall a. Bits a => a -> a -> a
.&. Word8
0x0f

toByte :: Nibble -> Nibble -> Word8
toByte :: Nibble -> Nibble -> Word8
toByte  (Nibble Word8
high) (Nibble Word8
low) = Word8
high forall a. Bits a => a -> Int -> a
`shift` Int
4 forall a. Bits a => a -> a -> a
.|. Word8
low

unpackNibbles :: ByteString -> [Nibble]
unpackNibbles :: ByteString -> [Nibble]
unpackNibbles ByteString
bs = ByteString -> [Word8]
BS.unpack ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> [Nibble]
unpackByte
  where unpackByte :: Word8 -> [Nibble]
unpackByte Word8
b = [Word8 -> Nibble
hi Word8
b, Word8 -> Nibble
lo Word8
b]

-- Well-defined for even length lists only (plz dependent types)
packNibbles :: [Nibble] -> ByteString
packNibbles :: [Nibble] -> ByteString
packNibbles [] = forall a. Monoid a => a
mempty
packNibbles (Nibble
n1:Nibble
n2:[Nibble]
ns) = Word8 -> ByteString
BS.singleton (Nibble -> Nibble -> Word8
toByte Nibble
n1 Nibble
n2) forall a. Semigroup a => a -> a -> a
<> [Nibble] -> ByteString
packNibbles [Nibble]
ns
packNibbles [Nibble]
_ = forall a. HasCallStack => String -> a
error String
"can't pack odd number of nibbles"

toWord64 :: W256 -> Maybe Word64
toWord64 :: W256 -> Maybe Word64
toWord64 W256
n =
  if W256
n forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
num (forall a. Bounded a => a
maxBound :: Word64)
    then let (W256 (Word256 Word128
_ (Word128 Word64
_ Word64
n'))) = W256
n in forall a. a -> Maybe a
Just Word64
n'
    else forall a. Maybe a
Nothing

toInt :: W256 -> Maybe Int
toInt :: W256 -> Maybe Int
toInt W256
n =
  if W256
n forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
num (forall a. Bounded a => a
maxBound :: Int)
    then let (W256 (Word256 Word128
_ (Word128 Word64
_ Word64
n'))) = W256
n in forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n')
    else forall a. Maybe a
Nothing

bssToBs :: ByteStringS -> ByteString
bssToBs :: ByteStringS -> ByteString
bssToBs (ByteStringS ByteString
bs) = ByteString
bs

-- | This just overflows silently, and is generally a terrible footgun, should be removed
num :: (Integral a, Num b) => a -> b
num :: forall a b. (Integral a, Num b) => a -> b
num = forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- Keccak hashing ----------------------------------------------------------------------------------


keccakBytes :: ByteString -> ByteString
keccakBytes :: ByteString -> ByteString
keccakBytes =
  (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest Keccak_256)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

word32 :: [Word8] -> Word32
word32 :: [Word8] -> Word32
word32 [Word8]
xs = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Bits a => a -> Int -> a
`shiftL` (Int
8forall a. Num a => a -> a -> a
*Int
n)
                | (Int
n, Word8
x) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (forall a. [a] -> [a]
reverse [Word8]
xs) ]

keccak :: Expr Buf -> Expr EWord
keccak :: Expr 'Buf -> Expr 'EWord
keccak (ConcreteBuf ByteString
bs) = W256 -> Expr 'EWord
Lit forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' ByteString
bs
keccak Expr 'Buf
buf = Expr 'Buf -> Expr 'EWord
Keccak Expr 'Buf
buf

keccak' :: ByteString -> W256
keccak' :: ByteString -> W256
keccak' = ByteString -> ByteString
keccakBytes forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> ByteString -> ByteString
BS.take Int
32 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ByteString -> W256
word

abiKeccak :: ByteString -> FunctionSelector
abiKeccak :: ByteString -> FunctionSelector
abiKeccak =
  ByteString -> ByteString
keccakBytes
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> ByteString -> ByteString
BS.take Int
4
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ByteString -> [Word8]
BS.unpack
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Word8] -> Word32
word32
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Word32 -> FunctionSelector
FunctionSelector


-- Utils -------------------------------------------------------------------------------------------


concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f [a]
xs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f [a]
xs)

regexMatches :: Text -> Text -> Bool
regexMatches :: Text -> Text -> Bool
regexMatches Text
regexSource =
  let
    compOpts :: CompOption
compOpts =
      forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
Regex.defaultCompOpt { lastStarGreedy :: Bool
Regex.lastStarGreedy = Bool
True }
    execOpts :: ExecOption
execOpts =
      forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
Regex.defaultExecOpt { captureGroups :: Bool
Regex.captureGroups = Bool
False }
    regex :: Regex
regex = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
Regex.makeRegexOpts CompOption
compOpts ExecOption
execOpts (Text -> String
T.unpack Text
regexSource)
  in
    forall regex source.
RegexLike regex source =>
regex -> source -> Bool
Regex.matchTest Regex
regex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

readNull :: Read a => a -> String -> a
readNull :: forall a. Read a => a -> String -> a
readNull a
x = forall a. a -> Maybe a -> a
fromMaybe a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
Text.Read.readMaybe

padLeft :: Int -> ByteString -> ByteString
padLeft :: Int -> ByteString -> ByteString
padLeft Int
n ByteString
xs = Int -> Word8 -> ByteString
BS.replicate (Int
n forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
xs) Word8
0 forall a. Semigroup a => a -> a -> a
<> ByteString
xs

padLeft' :: Int -> V.Vector (Expr Byte) -> V.Vector (Expr Byte)
padLeft' :: Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
padLeft' Int
n Vector (Expr 'Byte)
xs = forall a. Int -> a -> Vector a
V.replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
xs) (Word8 -> Expr 'Byte
LitByte Word8
0) forall a. Semigroup a => a -> a -> a
<> Vector (Expr 'Byte)
xs

padRight :: Int -> ByteString -> ByteString
padRight :: Int -> ByteString -> ByteString
padRight Int
n ByteString
xs = ByteString
xs forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
n forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
xs) Word8
0

padRight' :: Int -> String -> String
padRight' :: Int -> ShowS
padRight' Int
n String
xs = String
xs forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs) Char
'0'

-- We need this here instead of Format for cyclic import reasons...
formatString :: ByteString -> String
formatString :: ByteString -> String
formatString ByteString
bs =
  case ByteString -> Either UnicodeException Text
T.decodeUtf8' (forall a b. (a, b) -> a
fst ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs)) of
    Right Text
s -> String
"\"" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s forall a. Semigroup a => a -> a -> a
<> String
"\""
    Left UnicodeException
_ -> String
"❮utf8 decode failed❯: " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
bs)

-- Optics ------------------------------------------------------------------------------------------


makeFieldLabelsNoPrefix ''VM
makeFieldLabelsNoPrefix ''FrameState
makeFieldLabelsNoPrefix ''TxState
makeFieldLabelsNoPrefix ''SubState
makeFieldLabelsNoPrefix ''Cache
makeFieldLabelsNoPrefix ''Trace
makeFieldLabelsNoPrefix ''VMOpts
makeFieldLabelsNoPrefix ''Frame
makeFieldLabelsNoPrefix ''FrameContext
makeFieldLabelsNoPrefix ''Contract
makeFieldLabelsNoPrefix ''Env
makeFieldLabelsNoPrefix ''Block