{-# Language CPP #-}
{-# Language TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}

module EVM.Types where

import Prelude hiding  (Word, LT, GT)

import Data.Aeson (FromJSONKey (..), FromJSONKeyFunction (..))
import Data.Aeson
import Crypto.Hash
import Data.SBV hiding (Word)
import Data.Kind
import Data.Bifunctor (first)
import Data.Char
import Data.List (intercalate)
import Data.Bifunctor (bimap)
import Data.ByteString (ByteString)
import Data.ByteString.Base16 as BS16
import Data.ByteString.Builder (byteStringHex, toLazyByteString)
import Data.ByteString.Lazy (toStrict)
import Control.Monad.State.Strict (liftM)
import qualified Data.ByteString.Char8  as Char8
import Data.DoubleWord
import Data.DoubleWord.TH
import Data.Maybe (fromMaybe)
import Numeric (readHex, showHex)
import Options.Generic
import Control.Arrow ((>>>))

import qualified Data.ByteArray       as BA
import qualified Data.Aeson           as JSON
import qualified Data.Aeson.Types     as JSON
import qualified Data.ByteString      as BS
import qualified Data.Serialize.Get   as Cereal
import qualified Data.Text            as Text
import qualified Data.Text.Encoding   as Text
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]


data Buffer
  = ConcreteBuffer ByteString
  | SymbolicBuffer [SWord 8]

newtype W256 = W256 Word256
  deriving
    ( Integer -> W256
W256 -> W256
W256 -> W256 -> W256
(W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> (W256 -> W256)
-> (W256 -> W256)
-> (W256 -> W256)
-> (Integer -> W256)
-> Num 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
(Real W256, Enum W256) =>
(W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> (W256 -> W256 -> (W256, W256))
-> (W256 -> W256 -> (W256, W256))
-> (W256 -> Integer)
-> Integral 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
$cp2Integral :: Enum W256
$cp1Integral :: Real W256
Integral, Num W256
Ord W256
(Num W256, Ord W256) => (W256 -> Rational) -> Real W256
W256 -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
toRational :: W256 -> Rational
$ctoRational :: W256 -> Rational
$cp2Real :: Ord W256
$cp1Real :: Num W256
Real, Eq W256
Eq W256 =>
(W256 -> W256 -> Ordering)
-> (W256 -> W256 -> Bool)
-> (W256 -> W256 -> Bool)
-> (W256 -> W256 -> Bool)
-> (W256 -> W256 -> Bool)
-> (W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> Ord 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
$cp1Ord :: Eq W256
Ord, Int -> W256
W256 -> Int
W256 -> [W256]
W256 -> W256
W256 -> W256 -> [W256]
W256 -> W256 -> W256 -> [W256]
(W256 -> W256)
-> (W256 -> W256)
-> (Int -> W256)
-> (W256 -> Int)
-> (W256 -> [W256])
-> (W256 -> W256 -> [W256])
-> (W256 -> W256 -> [W256])
-> (W256 -> W256 -> W256 -> [W256])
-> Enum 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
(W256 -> W256 -> Bool) -> (W256 -> W256 -> Bool) -> Eq W256
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
    , Eq W256
W256
Eq W256 =>
(W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> (W256 -> W256 -> W256)
-> (W256 -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> W256
-> (Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> Bool)
-> (W256 -> Maybe Int)
-> (W256 -> Int)
-> (W256 -> Bool)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int -> W256)
-> (W256 -> Int)
-> Bits 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
$cp1Bits :: Eq W256
Bits, Bits W256
Bits W256 =>
(W256 -> Int) -> (W256 -> Int) -> (W256 -> Int) -> FiniteBits 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
$cp1FiniteBits :: Bits W256
FiniteBits, W256
W256 -> W256 -> Bounded W256
forall a. a -> a -> Bounded a
maxBound :: W256
$cmaxBound :: W256
minBound :: W256
$cminBound :: W256
Bounded, (forall x. W256 -> Rep W256 x)
-> (forall x. Rep W256 x -> W256) -> Generic W256
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
    )

data Word = C Whiff W256 --maybe to remove completely in the future

instance Show Word where
  show :: Word -> String
show (C _ x :: W256
x) = W256 -> String
forall a. Show a => a -> String
show W256
x

instance Read Word where
  readsPrec :: Int -> ReadS Word
readsPrec n :: Int
n s :: String
s =
    case Int -> ReadS W256
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s of
      [(x :: W256
x, r :: String
r)] -> [(Whiff -> W256 -> Word
C (W256 -> Whiff
Literal W256
x) W256
x, String
r)]
      _ -> []

w256 :: W256 -> Word
w256 :: W256 -> Word
w256 w :: W256
w = Whiff -> W256 -> Word
C (W256 -> Whiff
Literal W256
w) W256
w

instance Bits Word where
  (C a :: Whiff
a x :: W256
x) .&. :: Word -> Word -> Word
.&. (C b :: Whiff
b y :: W256
y) = Whiff -> W256 -> Word
C (Whiff -> Whiff -> Whiff
And Whiff
a Whiff
b) (W256
x W256 -> W256 -> W256
forall a. Bits a => a -> a -> a
.&. W256
y)
  (C a :: Whiff
a x :: W256
x) .|. :: Word -> Word -> Word
.|. (C b :: Whiff
b y :: W256
y) = Whiff -> W256 -> Word
C (Whiff -> Whiff -> Whiff
Or  Whiff
a Whiff
b) (W256
x W256 -> W256 -> W256
forall a. Bits a => a -> a -> a
.|. W256
y)
  (C a :: Whiff
a x :: W256
x) xor :: Word -> Word -> Word
`xor` (C b :: Whiff
b y :: W256
y) = Whiff -> W256 -> Word
C (String -> [Whiff] -> Whiff
Todo "xor" [Whiff
a, Whiff
b]) (W256
x W256 -> W256 -> W256
forall a. Bits a => a -> a -> a
`xor` W256
y)
  complement :: Word -> Word
complement (C a :: Whiff
a x :: W256
x) = Whiff -> W256 -> Word
C (Whiff -> Whiff
Neg Whiff
a) (W256 -> W256
forall a. Bits a => a -> a
complement W256
x)
  shiftL :: Word -> Int -> Word
shiftL (C a :: Whiff
a x :: W256
x) i :: Int
i = Whiff -> W256 -> Word
C (Whiff -> Whiff -> Whiff
SHL Whiff
a (W256 -> Whiff
Literal (W256 -> Whiff) -> W256 -> Whiff
forall a b. (a -> b) -> a -> b
$ Int -> W256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) (W256 -> Int -> W256
forall a. Bits a => a -> Int -> a
shiftL W256
x Int
i)
  shiftR :: Word -> Int -> Word
shiftR (C a :: Whiff
a x :: W256
x) i :: Int
i = Whiff -> W256 -> Word
C (Whiff -> Whiff -> Whiff
SHR Whiff
a (W256 -> Whiff
Literal (W256 -> Whiff) -> W256 -> Whiff
forall a b. (a -> b) -> a -> b
$ Int -> W256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) (W256 -> Int -> W256
forall a. Bits a => a -> Int -> a
shiftR W256
x Int
i)
  rotate :: Word -> Int -> Word
rotate (C a :: Whiff
a x :: W256
x) i :: Int
i = Whiff -> W256 -> Word
C (String -> [Whiff] -> Whiff
Todo "rotate " [Whiff
a]) (W256 -> Int -> W256
forall a. Bits a => a -> Int -> a
rotate W256
x Int
i) -- unused.
  bitSize :: Word -> Int
bitSize (C _ x :: W256
x) = W256 -> Int
forall a. Bits a => a -> Int
bitSize W256
x
  bitSizeMaybe :: Word -> Maybe Int
bitSizeMaybe (C _ x :: W256
x) = W256 -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe W256
x
  isSigned :: Word -> Bool
isSigned (C _ x :: W256
x) = W256 -> Bool
forall a. Bits a => a -> Bool
isSigned W256
x
  testBit :: Word -> Int -> Bool
testBit (C _ x :: W256
x) i :: Int
i = W256 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit W256
x Int
i
  bit :: Int -> Word
bit i :: Int
i = W256 -> Word
w256 (Int -> W256
forall a. Bits a => Int -> a
bit Int
i)
  popCount :: Word -> Int
popCount (C _ x :: W256
x) = W256 -> Int
forall a. Bits a => a -> Int
popCount W256
x

instance FiniteBits Word where
  finiteBitSize :: Word -> Int
finiteBitSize (C _ x :: W256
x) = W256 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize W256
x
  countLeadingZeros :: Word -> Int
countLeadingZeros (C _ x :: W256
x) = W256 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros W256
x
  countTrailingZeros :: Word -> Int
countTrailingZeros (C _ x :: W256
x) = W256 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros W256
x

instance Bounded Word where
  minBound :: Word
minBound = W256 -> Word
w256 W256
forall a. Bounded a => a
minBound
  maxBound :: Word
maxBound = W256 -> Word
w256 W256
forall a. Bounded a => a
maxBound

instance Eq Word where
  (C _ x :: W256
x) == :: Word -> Word -> Bool
== (C _ y :: W256
y) = W256
x W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
y

instance Enum Word where
  toEnum :: Int -> Word
toEnum i :: Int
i = W256 -> Word
w256 (Int -> W256
forall a. Enum a => Int -> a
toEnum Int
i)
  fromEnum :: Word -> Int
fromEnum (C _ x :: W256
x) = W256 -> Int
forall a. Enum a => a -> Int
fromEnum W256
x

instance Integral Word where
  quotRem :: Word -> Word -> (Word, Word)
quotRem (C _ x :: W256
x) (C _ y :: W256
y) =
    let (a :: W256
a, b :: W256
b) = W256 -> W256 -> (W256, W256)
forall a. Integral a => a -> a -> (a, a)
quotRem W256
x W256
y
    in (W256 -> Word
w256 W256
a, W256 -> Word
w256 W256
b)
  toInteger :: Word -> Integer
toInteger (C _ x :: W256
x) = W256 -> Integer
forall a. Integral a => a -> Integer
toInteger W256
x

instance Num Word where
  (C a :: Whiff
a x :: W256
x) + :: Word -> Word -> Word
+ (C b :: Whiff
b y :: W256
y) = Whiff -> W256 -> Word
C (Whiff -> Whiff -> Whiff
Add Whiff
a Whiff
b) (W256
x W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
y)
  (C a :: Whiff
a x :: W256
x) * :: Word -> Word -> Word
* (C b :: Whiff
b y :: W256
y) = Whiff -> W256 -> Word
C (Whiff -> Whiff -> Whiff
Mul Whiff
a Whiff
b) (W256
x W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* W256
y)
  abs :: Word -> Word
abs (C a :: Whiff
a x :: W256
x) = Whiff -> W256 -> Word
C (String -> [Whiff] -> Whiff
Todo "abs" [Whiff
a]) (W256 -> W256
forall a. Num a => a -> a
abs W256
x)
  signum :: Word -> Word
signum (C a :: Whiff
a x :: W256
x) = Whiff -> W256 -> Word
C (String -> [Whiff] -> Whiff
Todo "signum" [Whiff
a]) (W256 -> W256
forall a. Num a => a -> a
signum W256
x)
  fromInteger :: Integer -> Word
fromInteger x :: Integer
x = Whiff -> W256 -> Word
C (W256 -> Whiff
Literal (Integer -> W256
forall a. Num a => Integer -> a
fromInteger Integer
x)) (Integer -> W256
forall a. Num a => Integer -> a
fromInteger Integer
x)
  negate :: Word -> Word
negate (C a :: Whiff
a x :: W256
x) = Whiff -> W256 -> Word
C (Whiff -> Whiff -> Whiff
Sub (W256 -> Whiff
Literal 0) Whiff
a) (W256 -> W256
forall a. Num a => a -> a
negate W256
x)

instance Real Word where
  toRational :: Word -> Rational
toRational (C _ x :: W256
x) = W256 -> Rational
forall a. Real a => a -> Rational
toRational W256
x

instance Ord Word where
  compare :: Word -> Word -> Ordering
compare (C _ x :: W256
x) (C _ y :: W256
y) = W256 -> W256 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare W256
x W256
y

newtype ByteStringS = ByteStringS ByteString deriving (ByteStringS -> ByteStringS -> Bool
(ByteStringS -> ByteStringS -> Bool)
-> (ByteStringS -> ByteStringS -> Bool) -> Eq ByteStringS
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)

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

instance Read ByteStringS where
    readsPrec :: Int -> ReadS ByteStringS
readsPrec _ ('0':'x':x :: String
x) = [(ByteString -> ByteStringS)
-> (ByteString -> String)
-> (ByteString, ByteString)
-> (ByteStringS, String)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ByteString -> ByteStringS
ByteStringS (Text -> String
Text.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8) (ByteString, ByteString)
bytes]
       where bytes :: (ByteString, ByteString)
bytes = ByteString -> (ByteString, ByteString)
BS16.decode (Text -> ByteString
Text.encodeUtf8 (String -> Text
Text.pack String
x))
    readsPrec _ _ = []

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

-- | Symbolic words of 256 bits, possibly annotated with additional
--   "insightful" information
data SymWord = S Whiff (SWord 256)

instance Show SymWord where
  show :: SymWord -> String
show (S w :: Whiff
w _) = Whiff -> String
forall a. Show a => a -> String
show Whiff
w

var :: String -> SWord 256 -> SymWord
var :: String -> SWord 256 -> SymWord
var name :: String
name x :: SWord 256
x = Whiff -> SWord 256 -> SymWord
S (String -> SWord 256 -> Whiff
Var String
name SWord 256
x) SWord 256
x

-- | Custom instances for SymWord, many of which have direct
-- analogues for concrete words defined in Concrete.hs
instance EqSymbolic SymWord where
  .== :: SymWord -> SymWord -> SBool
(.==) (S _ x :: SWord 256
x) (S _ y :: SWord 256
y) = SWord 256
x SWord 256 -> SWord 256 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SWord 256
y

instance Num SymWord where
  (S a :: Whiff
a x :: SWord 256
x) + :: SymWord -> SymWord -> SymWord
+ (S b :: Whiff
b y :: SWord 256
y) = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
Add Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. Num a => a -> a -> a
+ SWord 256
y)
  (S a :: Whiff
a x :: SWord 256
x) * :: SymWord -> SymWord -> SymWord
* (S b :: Whiff
b y :: SWord 256
y) = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
Mul Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. Num a => a -> a -> a
* SWord 256
y)
  abs :: SymWord -> SymWord
abs (S a :: Whiff
a x :: SWord 256
x) = Whiff -> SWord 256 -> SymWord
S (String -> [Whiff] -> Whiff
Todo "abs" [Whiff
a]) (SWord 256 -> SWord 256
forall a. Num a => a -> a
abs SWord 256
x)
  signum :: SymWord -> SymWord
signum (S a :: Whiff
a x :: SWord 256
x) = Whiff -> SWord 256 -> SymWord
S (String -> [Whiff] -> Whiff
Todo "signum" [Whiff
a]) (SWord 256 -> SWord 256
forall a. Num a => a -> a
signum SWord 256
x)
  fromInteger :: Integer -> SymWord
fromInteger x :: Integer
x = Whiff -> SWord 256 -> SymWord
S (W256 -> Whiff
Literal (Integer -> W256
forall a. Num a => Integer -> a
fromInteger Integer
x)) (Integer -> SWord 256
forall a. Num a => Integer -> a
fromInteger Integer
x)
  negate :: SymWord -> SymWord
negate (S a :: Whiff
a x :: SWord 256
x) = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff
Neg Whiff
a) (SWord 256 -> SWord 256
forall a. Num a => a -> a
negate SWord 256
x)

instance Bits SymWord where
  (S a :: Whiff
a x :: SWord 256
x) .&. :: SymWord -> SymWord -> SymWord
.&. (S b :: Whiff
b y :: SWord 256
y) = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
And Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. Bits a => a -> a -> a
.&. SWord 256
y)
  (S a :: Whiff
a x :: SWord 256
x) .|. :: SymWord -> SymWord -> SymWord
.|. (S b :: Whiff
b y :: SWord 256
y) = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
Or  Whiff
a Whiff
b) (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. Bits a => a -> a -> a
.|. SWord 256
y)
  (S a :: Whiff
a x :: SWord 256
x) xor :: SymWord -> SymWord -> SymWord
`xor` (S b :: Whiff
b y :: SWord 256
y) = Whiff -> SWord 256 -> SymWord
S (String -> [Whiff] -> Whiff
Todo "xor" [Whiff
a, Whiff
b]) (SWord 256
x SWord 256 -> SWord 256 -> SWord 256
forall a. Bits a => a -> a -> a
`xor` SWord 256
y)
  complement :: SymWord -> SymWord
complement (S a :: Whiff
a x :: SWord 256
x) = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff
Neg Whiff
a) (SWord 256 -> SWord 256
forall a. Bits a => a -> a
complement SWord 256
x)
  shiftL :: SymWord -> Int -> SymWord
shiftL (S a :: Whiff
a x :: SWord 256
x) i :: Int
i = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
SHL Whiff
a (W256 -> Whiff
Literal (W256 -> Whiff) -> W256 -> Whiff
forall a b. (a -> b) -> a -> b
$ Int -> W256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) (SWord 256 -> Int -> SWord 256
forall a. Bits a => a -> Int -> a
shiftL SWord 256
x Int
i)
  shiftR :: SymWord -> Int -> SymWord
shiftR (S a :: Whiff
a x :: SWord 256
x) i :: Int
i = Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
SHR Whiff
a (W256 -> Whiff
Literal (W256 -> Whiff) -> W256 -> Whiff
forall a b. (a -> b) -> a -> b
$ Int -> W256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) (SWord 256 -> Int -> SWord 256
forall a. Bits a => a -> Int -> a
shiftR SWord 256
x Int
i)
  rotate :: SymWord -> Int -> SymWord
rotate (S a :: Whiff
a x :: SWord 256
x) i :: Int
i = Whiff -> SWord 256 -> SymWord
S (String -> [Whiff] -> Whiff
Todo "rotate " [Whiff
a]) (SWord 256 -> Int -> SWord 256
forall a. Bits a => a -> Int -> a
rotate SWord 256
x Int
i) -- unused.
  bitSize :: SymWord -> Int
bitSize (S _ x :: SWord 256
x) = SWord 256 -> Int
forall a. Bits a => a -> Int
bitSize SWord 256
x
  bitSizeMaybe :: SymWord -> Maybe Int
bitSizeMaybe (S _ x :: SWord 256
x) = SWord 256 -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe SWord 256
x
  isSigned :: SymWord -> Bool
isSigned (S _ x :: SWord 256
x) = SWord 256 -> Bool
forall a. Bits a => a -> Bool
isSigned SWord 256
x
  testBit :: SymWord -> Int -> Bool
testBit (S _ x :: SWord 256
x) i :: Int
i = SWord 256 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit SWord 256
x Int
i
  bit :: Int -> SymWord
bit i :: Int
i = W256 -> SymWord
w256lit (Int -> W256
forall a. Bits a => Int -> a
bit Int
i)
  popCount :: SymWord -> Int
popCount (S _ x :: SWord 256
x) = SWord 256 -> Int
forall a. Bits a => a -> Int
popCount SWord 256
x

-- sQuotRem and sDivMod are identical for SWord 256
-- prove $ \x y -> x `sQuotRem` (y :: SWord 256) .== x `sDivMod` y
-- Q.E.D.
instance SDivisible SymWord where
  sQuotRem :: SymWord -> SymWord -> (SymWord, SymWord)
sQuotRem (S x' :: Whiff
x' x :: SWord 256
x) (S y' :: Whiff
y' y :: SWord 256
y) = let (a :: SWord 256
a, b :: SWord 256
b) = SWord 256
x SWord 256 -> SWord 256 -> (SWord 256, SWord 256)
forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` SWord 256
y
                               in (Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
Div Whiff
x' Whiff
y') SWord 256
a, Whiff -> SWord 256 -> SymWord
S (Whiff -> Whiff -> Whiff
Mod Whiff
x' Whiff
y') SWord 256
b)
  sDivMod :: SymWord -> SymWord -> (SymWord, SymWord)
sDivMod = SymWord -> SymWord -> (SymWord, SymWord)
forall a. SDivisible a => a -> a -> (a, a)
sQuotRem

-- | Instead of supporting a Mergeable instance directly,
-- we use one which carries the Whiff around:
iteWhiff :: Whiff -> SBool -> SWord 256 -> SWord 256 -> SymWord
iteWhiff :: Whiff -> SBool -> SWord 256 -> SWord 256 -> SymWord
iteWhiff w :: Whiff
w b :: SBool
b x :: SWord 256
x y :: SWord 256
y = Whiff -> SWord 256 -> SymWord
S Whiff
w (SBool -> SWord 256 -> SWord 256 -> SWord 256
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
b SWord 256
x SWord 256
y)

instance Bounded SymWord where
  minBound :: SymWord
minBound = W256 -> SymWord
w256lit W256
forall a. Bounded a => a
minBound
  maxBound :: SymWord
maxBound = W256 -> SymWord
w256lit W256
forall a. Bounded a => a
maxBound

instance Eq SymWord where
  (S _ x :: SWord 256
x) == :: SymWord -> SymWord -> Bool
== (S _ y :: SWord 256
y) = SWord 256
x SWord 256 -> SWord 256 -> Bool
forall a. Eq a => a -> a -> Bool
== SWord 256
y

instance Enum SymWord where
  toEnum :: Int -> SymWord
toEnum i :: Int
i = W256 -> SymWord
w256lit (Int -> W256
forall a. Enum a => Int -> a
toEnum Int
i)
  fromEnum :: SymWord -> Int
fromEnum (S _ x :: SWord 256
x) = SWord 256 -> Int
forall a. Enum a => a -> Int
fromEnum SWord 256
x

-- | 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 do optimizations on the AST
-- instead of letting the SMT solver do all the heavy lifting.
data Whiff =
  Todo String [Whiff]
  -- booleans / bits
  | And  Whiff Whiff
  | Or   Whiff Whiff
  | Eq   Whiff Whiff
  | LT   Whiff Whiff
  | GT   Whiff Whiff
  | SLT  Whiff Whiff
  | SGT  Whiff Whiff
  | IsZero Whiff
  | ITE Whiff Whiff Whiff
  -- bits
  | SHL Whiff Whiff
  | SHR Whiff Whiff
  | SAR Whiff Whiff

  -- integers
  | Add  Whiff Whiff
  | Sub  Whiff Whiff
  | Mul  Whiff Whiff
  | Div  Whiff Whiff
  | Mod  Whiff Whiff
  | Exp  Whiff Whiff
  | Neg  Whiff
  | FromKeccak Buffer
  | FromBytes Buffer
  | FromStorage Whiff (SArray (WordN 256) (WordN 256))
  | Literal W256
  | Var String (SWord 256)

instance Show Whiff where
  show :: Whiff -> String
show w :: Whiff
w =
    let
      infix' :: String -> a -> a -> String
infix' s :: String
s x :: a
x y :: a
y = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y
    in case Whiff
w of
      Todo s :: String
s args :: [Whiff]
args -> String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," (Whiff -> String
forall a. Show a => a -> String
show (Whiff -> String) -> [Whiff] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Whiff]
args)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
      And x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " and " Whiff
x Whiff
y
      Or x :: Whiff
x y :: Whiff
y      -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " or " Whiff
x Whiff
y
      ITE b :: Whiff
b x :: Whiff
x y :: Whiff
y  -> "if " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Whiff -> String
forall a. Show a => a -> String
show Whiff
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ " then " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Whiff -> String
forall a. Show a => a -> String
show Whiff
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ " else " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Whiff -> String
forall a. Show a => a -> String
show Whiff
y
      Eq x :: Whiff
x y :: Whiff
y      -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " == " Whiff
x Whiff
y
      LT x :: Whiff
x y :: Whiff
y      -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " < " Whiff
x Whiff
y
      GT x :: Whiff
x y :: Whiff
y      -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " > " Whiff
x Whiff
y
      SLT x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " s< " Whiff
x Whiff
y
      SGT x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " s> " Whiff
x Whiff
y
      IsZero x :: Whiff
x    -> "IsZero(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Whiff -> String
forall a. Show a => a -> String
show Whiff
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
      SHL x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " << " Whiff
x Whiff
y
      SHR x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " << " Whiff
x Whiff
y
      SAR x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " a<< " Whiff
x Whiff
y
      Add x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " + " Whiff
x Whiff
y
      Sub x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " - " Whiff
x Whiff
y
      Mul x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " * " Whiff
x Whiff
y
      Div x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " / " Whiff
x Whiff
y
      Mod x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " % " Whiff
x Whiff
y
      Exp x :: Whiff
x y :: Whiff
y     -> String -> Whiff -> Whiff -> String
forall a a. (Show a, Show a) => String -> a -> a -> String
infix' " ** " Whiff
x Whiff
y
      Neg x :: Whiff
x       -> "not " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Whiff -> String
forall a. Show a => a -> String
show Whiff
x
      Var v :: String
v _     -> String
v
      FromKeccak buf :: Buffer
buf -> "keccak(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Buffer -> String
forall a. Show a => a -> String
show Buffer
buf String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
      Literal x :: W256
x -> W256 -> String
forall a. Show a => a -> String
show W256
x
      FromBytes buf :: Buffer
buf -> "FromBuffer " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Buffer -> String
forall a. Show a => a -> String
show Buffer
buf
      FromStorage l :: Whiff
l _ -> "SLOAD(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Whiff -> String
forall a. Show a => a -> String
show Whiff
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"

newtype Addr = Addr { Addr -> Word160
addressWord160 :: Word160 }
  deriving (Integer -> Addr
Addr -> Addr
Addr -> Addr -> Addr
(Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr)
-> (Addr -> Addr)
-> (Addr -> Addr)
-> (Integer -> Addr)
-> Num 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
(Real Addr, Enum Addr) =>
(Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> (Addr, Addr))
-> (Addr -> Addr -> (Addr, Addr))
-> (Addr -> Integer)
-> Integral 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
$cp2Integral :: Enum Addr
$cp1Integral :: Real Addr
Integral, Num Addr
Ord Addr
(Num Addr, Ord Addr) => (Addr -> Rational) -> Real Addr
Addr -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
toRational :: Addr -> Rational
$ctoRational :: Addr -> Rational
$cp2Real :: Ord Addr
$cp1Real :: Num Addr
Real, Eq Addr
Eq Addr =>
(Addr -> Addr -> Ordering)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> Ord 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
$cp1Ord :: Eq Addr
Ord, Int -> Addr
Addr -> Int
Addr -> [Addr]
Addr -> Addr
Addr -> Addr -> [Addr]
Addr -> Addr -> Addr -> [Addr]
(Addr -> Addr)
-> (Addr -> Addr)
-> (Int -> Addr)
-> (Addr -> Int)
-> (Addr -> [Addr])
-> (Addr -> Addr -> [Addr])
-> (Addr -> Addr -> [Addr])
-> (Addr -> Addr -> Addr -> [Addr])
-> Enum 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
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
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, Eq Addr
Addr
Eq Addr =>
(Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> Addr
-> (Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Bool)
-> (Addr -> Maybe Int)
-> (Addr -> Int)
-> (Addr -> Bool)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int -> Addr)
-> (Addr -> Int)
-> Bits 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
$cp1Bits :: Eq Addr
Bits, (forall x. Addr -> Rep Addr x)
-> (forall x. Rep Addr x -> Addr) -> Generic Addr
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)

newtype SAddr = SAddr { SAddr -> SWord 160
saddressWord160 :: SWord 160 }
  deriving (Integer -> SAddr
SAddr -> SAddr
SAddr -> SAddr -> SAddr
(SAddr -> SAddr -> SAddr)
-> (SAddr -> SAddr -> SAddr)
-> (SAddr -> SAddr -> SAddr)
-> (SAddr -> SAddr)
-> (SAddr -> SAddr)
-> (SAddr -> SAddr)
-> (Integer -> SAddr)
-> Num SAddr
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SAddr
$cfromInteger :: Integer -> SAddr
signum :: SAddr -> SAddr
$csignum :: SAddr -> SAddr
abs :: SAddr -> SAddr
$cabs :: SAddr -> SAddr
negate :: SAddr -> SAddr
$cnegate :: SAddr -> SAddr
* :: SAddr -> SAddr -> SAddr
$c* :: SAddr -> SAddr -> SAddr
- :: SAddr -> SAddr -> SAddr
$c- :: SAddr -> SAddr -> SAddr
+ :: SAddr -> SAddr -> SAddr
$c+ :: SAddr -> SAddr -> SAddr
Num)

-- | Capture the correspondence between sized and fixed-sized BVs
-- (This is blatant copypasta of `FromSized` from sbv, which just
-- happens to be defined up to 64 bits)
type family FromSizzle (t :: Type) :: Type where
   FromSizzle (WordN 256) = W256
   FromSizzle (WordN 160) = Addr

-- | Conversion from a sized BV to a fixed-sized bit-vector.
class FromSizzleBV a where
   -- | Convert a sized bit-vector to the corresponding fixed-sized bit-vector,
   -- for instance 'SWord 16' to 'SWord16'. See also 'toSized'.
   fromSizzle :: a -> FromSizzle a

   default fromSizzle :: (Num (FromSizzle a), Integral a) => a -> FromSizzle a
   fromSizzle = a -> FromSizzle a
forall a b. (Integral a, Num b) => a -> b
fromIntegral


maybeLitWord :: SymWord -> Maybe Word
maybeLitWord :: SymWord -> Maybe Word
maybeLitWord (S whiff :: Whiff
whiff a :: SWord 256
a) = (WordN 256 -> Word) -> Maybe (WordN 256) -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Whiff -> W256 -> Word
C Whiff
whiff (W256 -> Word) -> (WordN 256 -> W256) -> WordN 256 -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordN 256 -> W256
forall a. FromSizzleBV a => a -> FromSizzle a
fromSizzle) (SWord 256 -> Maybe (WordN 256)
forall a. SymVal a => SBV a -> Maybe a
unliteral SWord 256
a)

-- | convert between (WordN 256) and Word256
type family ToSizzle (t :: Type) :: Type where
    ToSizzle W256 = (WordN 256)
    ToSizzle Addr = (WordN 160)

-- | Conversion from a fixed-sized BV to a sized bit-vector.
class ToSizzleBV a where
   -- | Convert a fixed-sized bit-vector to the corresponding sized bit-vector,
   toSizzle :: a -> ToSizzle a

   default toSizzle :: (Num (ToSizzle a), Integral a) => (a -> ToSizzle a)
   toSizzle = a -> ToSizzle a
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance (ToSizzleBV W256)
instance (FromSizzleBV (WordN 256))
instance (ToSizzleBV Addr)
instance (FromSizzleBV (WordN 160))

w256lit :: W256 -> SymWord
w256lit :: W256 -> SymWord
w256lit x :: W256
x = Whiff -> SWord 256 -> SymWord
S (W256 -> Whiff
Literal W256
x) (SWord 256 -> SymWord) -> SWord 256 -> SymWord
forall a b. (a -> b) -> a -> b
$ WordN 256 -> SWord 256
forall a. SymVal a => a -> SBV a
literal (WordN 256 -> SWord 256) -> WordN 256 -> SWord 256
forall a b. (a -> b) -> a -> b
$ W256 -> ToSizzle W256
forall a. ToSizzleBV a => a -> ToSizzle a
toSizzle W256
x

litBytes :: ByteString -> [SWord 8]
litBytes :: ByteString -> [SWord 8]
litBytes bs :: ByteString
bs = (Word8 -> SWord 8) -> [Word8] -> [SWord 8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SBV Word8 -> SWord 8
forall a. ToSizedBV a => a -> ToSized a
toSized (SBV Word8 -> SWord 8) -> (Word8 -> SBV Word8) -> Word8 -> SWord 8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> SBV Word8
forall a. SymVal a => a -> SBV a
literal) (ByteString -> [Word8]
BS.unpack ByteString
bs)

-- | Operations over buffers (concrete or symbolic)

-- | A buffer is a list of bytes. For concrete execution, this is simply `ByteString`.
-- In symbolic settings, it is a list of symbolic bitvectors of size 8.
instance Show Buffer where
  show :: Buffer -> String
show (ConcreteBuffer b :: ByteString
b) = ByteStringS -> String
forall a. Show a => a -> String
show (ByteStringS -> String) -> ByteStringS -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringS
ByteStringS ByteString
b
  show (SymbolicBuffer b :: [SWord 8]
b) = Int -> String
forall a. Show a => a -> String
show ([SWord 8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SWord 8]
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " bytes"


instance Semigroup Buffer where
  ConcreteBuffer a :: ByteString
a <> :: Buffer -> Buffer -> Buffer
<> ConcreteBuffer b :: ByteString
b = ByteString -> Buffer
ConcreteBuffer (ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b)
  ConcreteBuffer a :: ByteString
a <> SymbolicBuffer b :: [SWord 8]
b = [SWord 8] -> Buffer
SymbolicBuffer (ByteString -> [SWord 8]
litBytes ByteString
a [SWord 8] -> [SWord 8] -> [SWord 8]
forall a. Semigroup a => a -> a -> a
<> [SWord 8]
b)
  SymbolicBuffer a :: [SWord 8]
a <> ConcreteBuffer b :: ByteString
b = [SWord 8] -> Buffer
SymbolicBuffer ([SWord 8]
a [SWord 8] -> [SWord 8] -> [SWord 8]
forall a. Semigroup a => a -> a -> a
<> ByteString -> [SWord 8]
litBytes ByteString
b)
  SymbolicBuffer a :: [SWord 8]
a <> SymbolicBuffer b :: [SWord 8]
b = [SWord 8] -> Buffer
SymbolicBuffer ([SWord 8]
a [SWord 8] -> [SWord 8] -> [SWord 8]
forall a. Semigroup a => a -> a -> a
<> [SWord 8]
b)

instance Monoid Buffer where
  mempty :: Buffer
mempty = ByteString -> Buffer
ConcreteBuffer ByteString
forall a. Monoid a => a
mempty

instance EqSymbolic Buffer where
  ConcreteBuffer a :: ByteString
a .== :: Buffer -> Buffer -> SBool
.== ConcreteBuffer b :: ByteString
b = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b)
  ConcreteBuffer a :: ByteString
a .== SymbolicBuffer b :: [SWord 8]
b = ByteString -> [SWord 8]
litBytes ByteString
a [SWord 8] -> [SWord 8] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== [SWord 8]
b
  SymbolicBuffer a :: [SWord 8]
a .== ConcreteBuffer b :: ByteString
b = [SWord 8]
a [SWord 8] -> [SWord 8] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== ByteString -> [SWord 8]
litBytes ByteString
b
  SymbolicBuffer a :: [SWord 8]
a .== SymbolicBuffer b :: [SWord 8]
b = [SWord 8]
a [SWord 8] -> [SWord 8] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== [SWord 8]
b


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

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

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

instance JSON.ToJSON Word where
  toJSON :: Word -> Value
toJSON (C _ x :: W256
x) = W256 -> Value
forall a. ToJSON a => a -> Value
toJSON W256
x

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

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

instance Show SAddr where
  show :: SAddr -> String
show (SAddr a :: SWord 160
a) = case SWord 160 -> Maybe (WordN 160)
forall a. SymVal a => SBV a -> Maybe a
unliteral SWord 160
a of
    Nothing -> "<symbolic addr>"
    Just c :: WordN 160
c -> Addr -> String
forall a. Show a => a -> String
show (Addr -> String) -> Addr -> String
forall a b. (a -> b) -> a -> b
$ WordN 160 -> FromSizzle (WordN 160)
forall a. FromSizzleBV a => a -> FromSizzle a
fromSizzle WordN 160
c

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

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

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

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

#if MIN_VERSION_aeson(1, 0, 0)

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

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

#endif

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

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

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

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

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

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

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

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

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

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

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

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

{-# SPECIALIZE num :: Word8 -> W256 #-}
num :: (Integral a, Num b) => a -> b
num :: a -> b
num = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

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

-- | Right padding  / truncating
truncpad :: Int -> [SWord 8] -> [SWord 8]
truncpad :: Int -> [SWord 8] -> [SWord 8]
truncpad n :: Int
n xs :: [SWord 8]
xs = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n then Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
take Int
n [SWord 8]
xs
                else [SWord 8] -> [SWord 8] -> [SWord 8]
forall a. Monoid a => a -> a -> a
mappend [SWord 8]
xs (Int -> SWord 8 -> [SWord 8]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) 0)
  where m :: Int
m = [SWord 8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SWord 8]
xs

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

word256 :: ByteString -> Word256
word256 :: ByteString -> Word256
word256 xs :: ByteString
xs = case Get Word256 -> ByteString -> Either String Word256
forall a. Get a -> ByteString -> Either String a
Cereal.runGet Get Word256
m (Int -> ByteString -> ByteString
padLeft 32 ByteString
xs) of
               Left _ -> String -> Word256
forall a. HasCallStack => String -> a
error "internal error"
               Right x :: 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
           Word256 -> Get Word256
forall (m :: * -> *) a. Monad m => a -> m a
return (Word256 -> Get Word256) -> Word256 -> Get Word256
forall a b. (a -> b) -> a -> b
$ HiWord Word256 -> LoWord Word256 -> Word256
forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo (HiWord (HiWord Word256)
-> LoWord (HiWord Word256) -> HiWord Word256
forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word64
HiWord (HiWord Word256)
a Word64
LoWord (HiWord Word256)
b) (HiWord (LoWord Word256)
-> LoWord (LoWord Word256) -> LoWord Word256
forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word64
HiWord (LoWord Word256)
c Word64
LoWord (LoWord Word256)
d)

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

byteAt :: (Bits a, Bits b, Integral a, Num b) => a -> Int -> b
byteAt :: a -> Int -> b
byteAt x :: a
x j :: Int
j = a -> b
forall a b. (Integral a, Num b) => a -> b
num (a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) b -> b -> b
forall a. Bits a => a -> a -> a
.&. 0xff

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

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

word256Bytes :: W256 -> ByteString
word256Bytes :: W256 -> ByteString
word256Bytes x :: W256
x = [Word8] -> ByteString
BS.pack [W256 -> Int -> Word8
forall a b. (Bits a, Bits b, Integral a, Num b) => a -> Int -> b
byteAt W256
x (31 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) | Int
i <- [0..31]]

word160Bytes :: Addr -> ByteString
word160Bytes :: Addr -> ByteString
word160Bytes x :: Addr
x = [Word8] -> ByteString
BS.pack [Word160 -> Int -> Word8
forall a b. (Bits a, Bits b, Integral a, Num b) => a -> Int -> b
byteAt (Addr -> Word160
addressWord160 Addr
x) (19 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) | Int
i <- [0..19]]

newtype Nibble = Nibble Word8
  deriving ( Integer -> Nibble
Nibble -> Nibble
Nibble -> Nibble -> Nibble
(Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble)
-> (Nibble -> Nibble)
-> (Nibble -> Nibble)
-> (Integer -> Nibble)
-> Num 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
(Real Nibble, Enum Nibble) =>
(Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> (Nibble, Nibble))
-> (Nibble -> Nibble -> (Nibble, Nibble))
-> (Nibble -> Integer)
-> Integral 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
$cp2Integral :: Enum Nibble
$cp1Integral :: Real Nibble
Integral, Num Nibble
Ord Nibble
(Num Nibble, Ord Nibble) => (Nibble -> Rational) -> Real Nibble
Nibble -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
toRational :: Nibble -> Rational
$ctoRational :: Nibble -> Rational
$cp2Real :: Ord Nibble
$cp1Real :: Num Nibble
Real, Eq Nibble
Eq Nibble =>
(Nibble -> Nibble -> Ordering)
-> (Nibble -> Nibble -> Bool)
-> (Nibble -> Nibble -> Bool)
-> (Nibble -> Nibble -> Bool)
-> (Nibble -> Nibble -> Bool)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> Ord 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
$cp1Ord :: Eq Nibble
Ord, Int -> Nibble
Nibble -> Int
Nibble -> [Nibble]
Nibble -> Nibble
Nibble -> Nibble -> [Nibble]
Nibble -> Nibble -> Nibble -> [Nibble]
(Nibble -> Nibble)
-> (Nibble -> Nibble)
-> (Int -> Nibble)
-> (Nibble -> Int)
-> (Nibble -> [Nibble])
-> (Nibble -> Nibble -> [Nibble])
-> (Nibble -> Nibble -> [Nibble])
-> (Nibble -> Nibble -> Nibble -> [Nibble])
-> Enum 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
(Nibble -> Nibble -> Bool)
-> (Nibble -> Nibble -> Bool) -> Eq Nibble
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
    , Eq Nibble
Nibble
Eq Nibble =>
(Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble -> Nibble)
-> (Nibble -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> Nibble
-> (Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Bool)
-> (Nibble -> Maybe Int)
-> (Nibble -> Int)
-> (Nibble -> Bool)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int -> Nibble)
-> (Nibble -> Int)
-> Bits Nibble
Int -> Nibble
Nibble -> Bool
Nibble -> Int
Nibble -> Maybe Int
Nibble -> Nibble
Nibble -> Int -> Bool
Nibble -> Int -> Nibble
Nibble -> Nibble -> Nibble
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 :: Nibble -> Int
$cpopCount :: Nibble -> Int
rotateR :: Nibble -> Int -> Nibble
$crotateR :: Nibble -> Int -> Nibble
rotateL :: Nibble -> Int -> Nibble
$crotateL :: Nibble -> Int -> Nibble
unsafeShiftR :: Nibble -> Int -> Nibble
$cunsafeShiftR :: Nibble -> Int -> Nibble
shiftR :: Nibble -> Int -> Nibble
$cshiftR :: Nibble -> Int -> Nibble
unsafeShiftL :: Nibble -> Int -> Nibble
$cunsafeShiftL :: Nibble -> Int -> Nibble
shiftL :: Nibble -> Int -> Nibble
$cshiftL :: Nibble -> Int -> Nibble
isSigned :: Nibble -> Bool
$cisSigned :: Nibble -> Bool
bitSize :: Nibble -> Int
$cbitSize :: Nibble -> Int
bitSizeMaybe :: Nibble -> Maybe Int
$cbitSizeMaybe :: Nibble -> Maybe Int
testBit :: Nibble -> Int -> Bool
$ctestBit :: Nibble -> Int -> Bool
complementBit :: Nibble -> Int -> Nibble
$ccomplementBit :: Nibble -> Int -> Nibble
clearBit :: Nibble -> Int -> Nibble
$cclearBit :: Nibble -> Int -> Nibble
setBit :: Nibble -> Int -> Nibble
$csetBit :: Nibble -> Int -> Nibble
bit :: Int -> Nibble
$cbit :: Int -> Nibble
zeroBits :: Nibble
$czeroBits :: Nibble
rotate :: Nibble -> Int -> Nibble
$crotate :: Nibble -> Int -> Nibble
shift :: Nibble -> Int -> Nibble
$cshift :: Nibble -> Int -> Nibble
complement :: Nibble -> Nibble
$ccomplement :: Nibble -> Nibble
xor :: Nibble -> Nibble -> Nibble
$cxor :: Nibble -> Nibble -> Nibble
.|. :: Nibble -> Nibble -> Nibble
$c.|. :: Nibble -> Nibble -> Nibble
.&. :: Nibble -> Nibble -> Nibble
$c.&. :: Nibble -> Nibble -> Nibble
$cp1Bits :: Eq Nibble
Bits, Bits Nibble
Bits Nibble =>
(Nibble -> Int)
-> (Nibble -> Int) -> (Nibble -> Int) -> FiniteBits Nibble
Nibble -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Nibble -> Int
$ccountTrailingZeros :: Nibble -> Int
countLeadingZeros :: Nibble -> Int
$ccountLeadingZeros :: Nibble -> Int
finiteBitSize :: Nibble -> Int
$cfiniteBitSize :: Nibble -> Int
$cp1FiniteBits :: Bits Nibble
FiniteBits, Nibble
Nibble -> Nibble -> Bounded Nibble
forall a. a -> a -> Bounded a
maxBound :: Nibble
$cmaxBound :: Nibble
minBound :: Nibble
$cminBound :: Nibble
Bounded, (forall x. Nibble -> Rep Nibble x)
-> (forall x. Rep Nibble x -> Nibble) -> Generic Nibble
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 = (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> (Nibble -> Char) -> Nibble -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
intToDigit (Int -> Char) -> (Nibble -> Int) -> Nibble -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nibble -> Int
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 b :: Word8
b = Word8 -> Nibble
Nibble (Word8 -> Nibble) -> Word8 -> Nibble
forall a b. (a -> b) -> a -> b
$ Word8
b Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 4
lo :: Word8 -> Nibble
lo b :: Word8
b = Word8 -> Nibble
Nibble (Word8 -> Nibble) -> Word8 -> Nibble
forall a b. (a -> b) -> a -> b
$ Word8
b Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x0f

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

unpackNibbles :: ByteString -> [Nibble]
unpackNibbles :: ByteString -> [Nibble]
unpackNibbles bs :: ByteString
bs = ByteString -> [Word8]
BS.unpack ByteString
bs [Word8] -> (Word8 -> [Nibble]) -> [Nibble]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> [Nibble]
unpackByte
  where unpackByte :: Word8 -> [Nibble]
unpackByte b :: 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 [] = ByteString
forall a. Monoid a => a
mempty
packNibbles (n1 :: Nibble
n1:n2 :: Nibble
n2:ns :: [Nibble]
ns) = Word8 -> ByteString
BS.singleton (Nibble -> Nibble -> Word8
toByte Nibble
n1 Nibble
n2) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Nibble] -> ByteString
packNibbles [Nibble]
ns
packNibbles _ = String -> ByteString
forall a. HasCallStack => String -> a
error "can't pack odd number of nibbles"

-- Keccak hashing

keccakBytes :: ByteString -> ByteString
keccakBytes :: ByteString -> ByteString
keccakBytes =
  (ByteString -> Digest Keccak_256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest Keccak_256)
    (ByteString -> Digest Keccak_256)
-> (Digest Keccak_256 -> ByteString) -> ByteString -> ByteString
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Digest Keccak_256 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack
    (Digest Keccak_256 -> [Word8])
-> ([Word8] -> ByteString) -> Digest Keccak_256 -> ByteString
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Word8] -> ByteString
BS.pack

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

keccak :: ByteString -> W256
keccak :: ByteString -> W256
keccak =
  ByteString -> ByteString
keccakBytes
    (ByteString -> ByteString)
-> (ByteString -> W256) -> ByteString -> W256
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 32
    (ByteString -> ByteString)
-> (ByteString -> W256) -> ByteString -> W256
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
    (ByteString -> ByteString)
-> (ByteString -> Word32) -> ByteString -> Word32
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 4
    (ByteString -> ByteString)
-> (ByteString -> Word32) -> ByteString -> Word32
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
    (ByteString -> [Word8])
-> ([Word8] -> Word32) -> ByteString -> Word32
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


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