{-# Language CPP #-}
{-# 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 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 (isPrefixOf, 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.Word (Word8, Word32, Word64)
import Data.DoubleWord
import Data.DoubleWord.TH
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Sequence qualified as Seq
import Data.Serialize qualified as Cereal
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Vector qualified as V
import Numeric (readHex, showHex)
import Options.Generic
import EVM.Hexdump (paddedShowHex)
import Control.Monad

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

-- Some stuff for "generic programming", needed to create Word512
import Data.Data

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


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, 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
    , 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 , 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
    )

{- |
  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.
-}

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

-- EVM errors
data Error
  = Invalid
  | IllegalOverflow
  | StackLimitExceeded
  | InvalidMemoryAccess
  | BadJumpDestination
  | StackUnderrun
  | SelfDestruct
  | TmpErr String
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Eq Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
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 :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c< :: Error -> Error -> Bool
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
Ord)

-- 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)


-- add type level list of constraints
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

  -- TODO: rm readWord in favour of this?
  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

  Revert         :: [Prop] -> Expr Buf -> Expr End
  Failure        :: [Prop] -> Error -> Expr End
  Return         :: [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)

-- 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


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

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

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
Text.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
Text.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
Text.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))

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 JSON.ToJSON Addr where
  toJSON :: Addr -> Value
toJSON = Text -> Value
JSON.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

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

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
Text.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'

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
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show W64
x

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

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
Text.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

-- 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

strip0x :: ByteString -> ByteString
strip0x :: ByteString -> ByteString
strip0x ByteString
bs = if ByteString
"0x" ByteString -> ByteString -> Bool
`Char8.isPrefixOf` ByteString
bs then Int -> ByteString -> ByteString
Char8.drop Int
2 ByteString
bs else ByteString
bs

strip0x' :: String -> String
strip0x' :: ShowS
strip0x' String
s = if String
"0x" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s then forall a. Int -> [a] -> [a]
drop Int
2 String
s else String
s

instance FromJSON W256 where
  parseJSON :: Value -> Parser W256
parseJSON Value
v = do
    String
s <- Text -> String
Text.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 FromJSON Addr where
  parseJSON :: Value -> Parser Addr
parseJSON Value
v = do
    String
s <- Text -> String
Text.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
")"

#if MIN_VERSION_aeson(1, 0, 0)

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
Text.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
Text.unpack Text
s forall a. [a] -> [a] -> [a]
++ String
")"

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
Text.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
Text.unpack Text
s forall a. [a] -> [a] -> [a]
++ String
")"

#endif

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

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

hexByteString :: String -> ByteString -> ByteString
hexByteString :: String -> ByteString -> ByteString
hexByteString String
msg ByteString
bs =
  case ByteString -> Either Text ByteString
BS16.decodeBase16 ByteString
bs of
    Right ByteString
x -> ByteString
x
    Either Text ByteString
_ -> forall a. HasCallStack => String -> a
error (String
"invalid hex bytestring for " forall a. [a] -> [a] -> [a]
++ String
msg)

hexText :: Text -> ByteString
hexText :: Text -> ByteString
hexText Text
t =
  case ByteString -> Either Text ByteString
BS16.decodeBase16 (Text -> ByteString
Text.encodeUtf8 (Int -> Text -> Text
Text.drop Int
2 Text
t)) of
    Right ByteString
x -> ByteString
x
    Either Text ByteString
_ -> forall a. HasCallStack => String -> a
error (String
"invalid hex bytestring " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t)

readN :: Integral a => String -> a
readN :: forall a. Integral a => String -> a
readN String
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Read a => String -> a
read String
s :: Integer)

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

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
Text.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)

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
Text.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)

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
Text.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
Text.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)

dataField :: JSON.Object -> Key -> JSON.Parser ByteString
dataField :: Object -> Key -> Parser ByteString
dataField Object
x Key
f = Text -> ByteString
hexText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
.: Key
f)

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)

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

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

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'

-- | Right padding  / truncating
--truncpad :: Int -> [SWord 8] -> [SWord 8]
--truncpad n xs = if m > n then take n xs
                --else mappend xs (replicate (n - m) 0)
  --where m = length 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

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

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

-- 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

-- 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 -> Word32
abiKeccak :: ByteString -> Word32
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

-- 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
Text.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
Text.unpack

data VMTrace =
  VMTrace
  { VMTrace -> Int
tracePc      :: Int
  , VMTrace -> Int
traceOp      :: Int
  , VMTrace -> [W256]
traceStack   :: [W256]
  , VMTrace -> Word64
traceMemSize :: Data.Word.Word64
  , VMTrace -> Int
traceDepth   :: Int
  , VMTrace -> Word64
traceGas     :: Data.Word.Word64
  , VMTrace -> Maybe String
traceError   :: Maybe String
  } deriving (forall x. Rep VMTrace x -> VMTrace
forall x. VMTrace -> Rep VMTrace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VMTrace x -> VMTrace
$cfrom :: forall x. VMTrace -> Rep VMTrace x
Generic, Int -> VMTrace -> ShowS
[VMTrace] -> ShowS
VMTrace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VMTrace] -> ShowS
$cshowList :: [VMTrace] -> ShowS
show :: VMTrace -> String
$cshow :: VMTrace -> String
showsPrec :: Int -> VMTrace -> ShowS
$cshowsPrec :: Int -> VMTrace -> ShowS
Show)
instance JSON.ToJSON VMTrace where
  toEncoding :: VMTrace -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
JSON.genericToEncoding Options
JSON.defaultOptions
instance JSON.FromJSON VMTrace

bsToHex :: ByteString -> String
bsToHex :: ByteString -> String
bsToHex ByteString
bs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. (Show a, Integral a) => Int -> a -> String
paddedShowHex Int
2) (ByteString -> [Word8]
BS.unpack ByteString
bs)

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