{-# Language DeriveAnyClass #-}
{-# Language DataKinds #-}
{-# Language QuasiQuotes #-}

module EVM.Solidity
  ( solidity
  , solcRuntime
  , solidity'
  , yul'
  , yul
  , yulRuntime
  , JumpType (..)
  , SolcContract (..)
  , StorageItem (..)
  , SourceCache (..)
  , SrcMap (..)
  , CodeType (..)
  , Method (..)
  , SlotType (..)
  , Reference(..)
  , Mutability(..)
  , functionAbi
  , makeSrcMaps
  , readSolc
  , readJSON
  , readStdJSON
  , readCombinedJSON
  , stripBytecodeMetadata
  , stripBytecodeMetadataSym
  , signature
  , solc
  , Language(..)
  , stdjson
  , parseMethodInput
  , lineSubrange
  , astIdMap
  , astSrcMap
  , containsLinkerHole
  , makeSourceCache
) where

import EVM.ABI
import EVM.Types

import Control.Applicative
import Control.Lens hiding (Indexed, (.=))
import Control.Monad
import Data.Aeson hiding (json)
import Data.Aeson.Types
import Data.Aeson.Lens
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Scientific
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as BS16
import Data.ByteString.Lazy (toStrict)
import Data.Char (isDigit)
import Data.Foldable
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.HashMap.Strict qualified as HMap
import Data.List (sort, isPrefixOf, isInfixOf, elemIndex, tails, findIndex)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe
import Data.Semigroup
import Data.Sequence (Seq)
import Data.String.Here qualified as Here
import Data.Text (Text, pack, intercalate)
import Data.Text qualified as Text
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Text.IO (readFile, writeFile)
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word8, Word32)
import GHC.Generics (Generic)
import Prelude hiding (readFile, writeFile)
import System.IO hiding (readFile, writeFile)
import System.IO.Temp
import System.Process
import Text.Read (readMaybe)

data StorageItem = StorageItem
  { StorageItem -> SlotType
slotType :: SlotType
  , StorageItem -> Int
offset :: Int
  , StorageItem -> Int
slot :: Int
  } deriving (Int -> StorageItem -> ShowS
[StorageItem] -> ShowS
StorageItem -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [StorageItem] -> ShowS
$cshowList :: [StorageItem] -> ShowS
show :: StorageItem -> FilePath
$cshow :: StorageItem -> FilePath
showsPrec :: Int -> StorageItem -> ShowS
$cshowsPrec :: Int -> StorageItem -> ShowS
Show, StorageItem -> StorageItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageItem -> StorageItem -> Bool
$c/= :: StorageItem -> StorageItem -> Bool
== :: StorageItem -> StorageItem -> Bool
$c== :: StorageItem -> StorageItem -> Bool
Eq)

data SlotType
  -- Note that mapping keys can only be elementary;
  -- that excludes arrays, contracts, and mappings.
  = StorageMapping (NonEmpty AbiType) AbiType
  | StorageValue AbiType
--  | StorageArray AbiType
  deriving SlotType -> SlotType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlotType -> SlotType -> Bool
$c/= :: SlotType -> SlotType -> Bool
== :: SlotType -> SlotType -> Bool
$c== :: SlotType -> SlotType -> Bool
Eq

instance Show SlotType where
 show :: SlotType -> FilePath
show (StorageValue AbiType
t) = forall a. Show a => a -> FilePath
show AbiType
t
 show (StorageMapping NonEmpty AbiType
s AbiType
t) =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
   (\AbiType
x FilePath
y ->
       FilePath
"mapping("
       forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show AbiType
x
       forall a. Semigroup a => a -> a -> a
<> FilePath
" => "
       forall a. Semigroup a => a -> a -> a
<> FilePath
y
       forall a. Semigroup a => a -> a -> a
<> FilePath
")")
   (forall a. Show a => a -> FilePath
show AbiType
t) NonEmpty AbiType
s

instance Read SlotType where
  readsPrec :: Int -> ReadS SlotType
readsPrec Int
_ (Char
'm':Char
'a':Char
'p':Char
'p':Char
'i':Char
'n':Char
'g':Char
'(':FilePath
s) =
    let (Text
lhs,[Text]
rhs) = case Text -> Text -> [Text]
Text.splitOn Text
" => " (FilePath -> Text
pack FilePath
s) of
          (Text
l:[Text]
r) -> (Text
l,[Text]
r)
          [Text]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"could not parse storage item"
        first :: AbiType
first = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Vector AbiType -> Text -> Maybe AbiType
parseTypeName forall a. Monoid a => a
mempty Text
lhs
        target :: AbiType
target = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Vector AbiType -> Text -> Maybe AbiType
parseTypeName forall a. Monoid a => a
mempty (Text -> Text -> Text -> Text
Text.replace Text
")" Text
"" (forall a. [a] -> a
last [Text]
rhs))
        rest :: [AbiType]
rest = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector AbiType -> Text -> Maybe AbiType
parseTypeName forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text -> Text
Text.replace Text
"mapping(" Text
""))) (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
rhs forall a. Num a => a -> a -> a
- Int
1) [Text]
rhs)
    in [(NonEmpty AbiType -> AbiType -> SlotType
StorageMapping (AbiType
first forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [AbiType]
rest) AbiType
target, FilePath
"")]
  readsPrec Int
_ FilePath
s = [(AbiType -> SlotType
StorageValue forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"could not parse storage item") (Vector AbiType -> Text -> Maybe AbiType
parseTypeName forall a. Monoid a => a
mempty (FilePath -> Text
pack FilePath
s)),FilePath
"")]

data SolcContract = SolcContract
  { SolcContract -> W256
runtimeCodehash  :: W256
  , SolcContract -> W256
creationCodehash :: W256
  , SolcContract -> ByteString
runtimeCode      :: ByteString
  , SolcContract -> ByteString
creationCode     :: ByteString
  , SolcContract -> Text
contractName     :: Text
  , SolcContract -> [(Text, AbiType)]
constructorInputs :: [(Text, AbiType)]
  , SolcContract -> Map Word32 Method
abiMap           :: Map Word32 Method
  , SolcContract -> Map W256 Event
eventMap         :: Map W256 Event
  , SolcContract -> Map W256 SolError
errorMap         :: Map W256 SolError
  , SolcContract -> Map W256 [Reference]
immutableReferences :: Map W256 [Reference]
  , SolcContract -> Maybe (Map Text StorageItem)
storageLayout    :: Maybe (Map Text StorageItem)
  , SolcContract -> Seq SrcMap
runtimeSrcmap    :: Seq SrcMap
  , SolcContract -> Seq SrcMap
creationSrcmap   :: Seq SrcMap
  } deriving (Int -> SolcContract -> ShowS
[SolcContract] -> ShowS
SolcContract -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SolcContract] -> ShowS
$cshowList :: [SolcContract] -> ShowS
show :: SolcContract -> FilePath
$cshow :: SolcContract -> FilePath
showsPrec :: Int -> SolcContract -> ShowS
$cshowsPrec :: Int -> SolcContract -> ShowS
Show, SolcContract -> SolcContract -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolcContract -> SolcContract -> Bool
$c/= :: SolcContract -> SolcContract -> Bool
== :: SolcContract -> SolcContract -> Bool
$c== :: SolcContract -> SolcContract -> Bool
Eq, forall x. Rep SolcContract x -> SolcContract
forall x. SolcContract -> Rep SolcContract x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolcContract x -> SolcContract
$cfrom :: forall x. SolcContract -> Rep SolcContract x
Generic)

data Method = Method
  { Method -> [(Text, AbiType)]
output :: [(Text, AbiType)]
  , Method -> [(Text, AbiType)]
inputs :: [(Text, AbiType)]
  , Method -> Text
name :: Text
  , Method -> Text
methodSignature :: Text
  , Method -> Mutability
mutability :: Mutability
  } deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> FilePath
$cshow :: Method -> FilePath
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show, Method -> Method -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Eq, Eq Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
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 :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmax :: Method -> Method -> Method
>= :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c< :: Method -> Method -> Bool
compare :: Method -> Method -> Ordering
$ccompare :: Method -> Method -> Ordering
Ord, forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Method x -> Method
$cfrom :: forall x. Method -> Rep Method x
Generic)

data Mutability
  = Pure       -- ^ specified to not read blockchain state
  | View       -- ^ specified to not modify the blockchain state
  | NonPayable -- ^ function does not accept Ether - the default
  | Payable    -- ^ function accepts Ether
 deriving (Int -> Mutability -> ShowS
[Mutability] -> ShowS
Mutability -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Mutability] -> ShowS
$cshowList :: [Mutability] -> ShowS
show :: Mutability -> FilePath
$cshow :: Mutability -> FilePath
showsPrec :: Int -> Mutability -> ShowS
$cshowsPrec :: Int -> Mutability -> ShowS
Show, Mutability -> Mutability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mutability -> Mutability -> Bool
$c/= :: Mutability -> Mutability -> Bool
== :: Mutability -> Mutability -> Bool
$c== :: Mutability -> Mutability -> Bool
Eq, Eq Mutability
Mutability -> Mutability -> Bool
Mutability -> Mutability -> Ordering
Mutability -> Mutability -> Mutability
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 :: Mutability -> Mutability -> Mutability
$cmin :: Mutability -> Mutability -> Mutability
max :: Mutability -> Mutability -> Mutability
$cmax :: Mutability -> Mutability -> Mutability
>= :: Mutability -> Mutability -> Bool
$c>= :: Mutability -> Mutability -> Bool
> :: Mutability -> Mutability -> Bool
$c> :: Mutability -> Mutability -> Bool
<= :: Mutability -> Mutability -> Bool
$c<= :: Mutability -> Mutability -> Bool
< :: Mutability -> Mutability -> Bool
$c< :: Mutability -> Mutability -> Bool
compare :: Mutability -> Mutability -> Ordering
$ccompare :: Mutability -> Mutability -> Ordering
Ord, forall x. Rep Mutability x -> Mutability
forall x. Mutability -> Rep Mutability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mutability x -> Mutability
$cfrom :: forall x. Mutability -> Rep Mutability x
Generic)

data SourceCache = SourceCache
  { SourceCache -> [(Text, ByteString)]
files  :: [(Text, ByteString)]
  , SourceCache -> [Vector ByteString]
lines  :: [(Vector ByteString)]
  , SourceCache -> Map Text Value
asts   :: Map Text Value
  } deriving (Int -> SourceCache -> ShowS
[SourceCache] -> ShowS
SourceCache -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SourceCache] -> ShowS
$cshowList :: [SourceCache] -> ShowS
show :: SourceCache -> FilePath
$cshow :: SourceCache -> FilePath
showsPrec :: Int -> SourceCache -> ShowS
$cshowsPrec :: Int -> SourceCache -> ShowS
Show, SourceCache -> SourceCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceCache -> SourceCache -> Bool
$c/= :: SourceCache -> SourceCache -> Bool
== :: SourceCache -> SourceCache -> Bool
$c== :: SourceCache -> SourceCache -> Bool
Eq, forall x. Rep SourceCache x -> SourceCache
forall x. SourceCache -> Rep SourceCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceCache x -> SourceCache
$cfrom :: forall x. SourceCache -> Rep SourceCache x
Generic)

data Reference = Reference
  { Reference -> Int
start :: Int,
    Reference -> Int
length :: Int
  } deriving (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Reference] -> ShowS
$cshowList :: [Reference] -> ShowS
show :: Reference -> FilePath
$cshow :: Reference -> FilePath
showsPrec :: Int -> Reference -> ShowS
$cshowsPrec :: Int -> Reference -> ShowS
Show, Reference -> Reference -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c== :: Reference -> Reference -> Bool
Eq)

instance FromJSON Reference where
  parseJSON :: Value -> Parser Reference
parseJSON (Object KeyMap Value
v) = Int -> Int -> Reference
Reference
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
v forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"start"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
v forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"length"
  parseJSON Value
invalid =
    forall a. FilePath -> Value -> Parser a
typeMismatch FilePath
"Transaction" Value
invalid

instance Semigroup SourceCache where
  SourceCache
_ <> :: SourceCache -> SourceCache -> SourceCache
<> SourceCache
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"lol"

instance Monoid SourceCache where
  mempty :: SourceCache
mempty = [(Text, ByteString)]
-> [Vector ByteString] -> Map Text Value -> SourceCache
SourceCache forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

data JumpType = JumpInto | JumpFrom | JumpRegular
  deriving (Int -> JumpType -> ShowS
[JumpType] -> ShowS
JumpType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [JumpType] -> ShowS
$cshowList :: [JumpType] -> ShowS
show :: JumpType -> FilePath
$cshow :: JumpType -> FilePath
showsPrec :: Int -> JumpType -> ShowS
$cshowsPrec :: Int -> JumpType -> ShowS
Show, JumpType -> JumpType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JumpType -> JumpType -> Bool
$c/= :: JumpType -> JumpType -> Bool
== :: JumpType -> JumpType -> Bool
$c== :: JumpType -> JumpType -> Bool
Eq, Eq JumpType
JumpType -> JumpType -> Bool
JumpType -> JumpType -> Ordering
JumpType -> JumpType -> JumpType
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 :: JumpType -> JumpType -> JumpType
$cmin :: JumpType -> JumpType -> JumpType
max :: JumpType -> JumpType -> JumpType
$cmax :: JumpType -> JumpType -> JumpType
>= :: JumpType -> JumpType -> Bool
$c>= :: JumpType -> JumpType -> Bool
> :: JumpType -> JumpType -> Bool
$c> :: JumpType -> JumpType -> Bool
<= :: JumpType -> JumpType -> Bool
$c<= :: JumpType -> JumpType -> Bool
< :: JumpType -> JumpType -> Bool
$c< :: JumpType -> JumpType -> Bool
compare :: JumpType -> JumpType -> Ordering
$ccompare :: JumpType -> JumpType -> Ordering
Ord, forall x. Rep JumpType x -> JumpType
forall x. JumpType -> Rep JumpType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JumpType x -> JumpType
$cfrom :: forall x. JumpType -> Rep JumpType x
Generic)

data SrcMap = SM {
  SrcMap -> Int
srcMapOffset :: {-# UNPACK #-} !Int,
  SrcMap -> Int
srcMapLength :: {-# UNPACK #-} !Int,
  SrcMap -> Int
srcMapFile   :: {-# UNPACK #-} !Int,
  SrcMap -> JumpType
srcMapJump   :: JumpType,
  SrcMap -> Int
srcMapModifierDepth :: {-# UNPACK #-} !Int
} deriving (Int -> SrcMap -> ShowS
[SrcMap] -> ShowS
SrcMap -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SrcMap] -> ShowS
$cshowList :: [SrcMap] -> ShowS
show :: SrcMap -> FilePath
$cshow :: SrcMap -> FilePath
showsPrec :: Int -> SrcMap -> ShowS
$cshowsPrec :: Int -> SrcMap -> ShowS
Show, SrcMap -> SrcMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcMap -> SrcMap -> Bool
$c/= :: SrcMap -> SrcMap -> Bool
== :: SrcMap -> SrcMap -> Bool
$c== :: SrcMap -> SrcMap -> Bool
Eq, Eq SrcMap
SrcMap -> SrcMap -> Bool
SrcMap -> SrcMap -> Ordering
SrcMap -> SrcMap -> SrcMap
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 :: SrcMap -> SrcMap -> SrcMap
$cmin :: SrcMap -> SrcMap -> SrcMap
max :: SrcMap -> SrcMap -> SrcMap
$cmax :: SrcMap -> SrcMap -> SrcMap
>= :: SrcMap -> SrcMap -> Bool
$c>= :: SrcMap -> SrcMap -> Bool
> :: SrcMap -> SrcMap -> Bool
$c> :: SrcMap -> SrcMap -> Bool
<= :: SrcMap -> SrcMap -> Bool
$c<= :: SrcMap -> SrcMap -> Bool
< :: SrcMap -> SrcMap -> Bool
$c< :: SrcMap -> SrcMap -> Bool
compare :: SrcMap -> SrcMap -> Ordering
$ccompare :: SrcMap -> SrcMap -> Ordering
Ord, forall x. Rep SrcMap x -> SrcMap
forall x. SrcMap -> Rep SrcMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrcMap x -> SrcMap
$cfrom :: forall x. SrcMap -> Rep SrcMap x
Generic)

data SrcMapParseState
  = F1 String Int
  | F2 Int String Int
  | F3 Int Int String Int
  | F4 Int Int Int (Maybe JumpType)
  | F5 Int Int Int JumpType String
  | Fe
  deriving Int -> SrcMapParseState -> ShowS
[SrcMapParseState] -> ShowS
SrcMapParseState -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SrcMapParseState] -> ShowS
$cshowList :: [SrcMapParseState] -> ShowS
show :: SrcMapParseState -> FilePath
$cshow :: SrcMapParseState -> FilePath
showsPrec :: Int -> SrcMapParseState -> ShowS
$cshowsPrec :: Int -> SrcMapParseState -> ShowS
Show

data CodeType = Creation | Runtime
  deriving (Int -> CodeType -> ShowS
[CodeType] -> ShowS
CodeType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CodeType] -> ShowS
$cshowList :: [CodeType] -> ShowS
show :: CodeType -> FilePath
$cshow :: CodeType -> FilePath
showsPrec :: Int -> CodeType -> ShowS
$cshowsPrec :: Int -> CodeType -> ShowS
Show, CodeType -> CodeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeType -> CodeType -> Bool
$c/= :: CodeType -> CodeType -> Bool
== :: CodeType -> CodeType -> Bool
$c== :: CodeType -> CodeType -> Bool
Eq, Eq CodeType
CodeType -> CodeType -> Bool
CodeType -> CodeType -> Ordering
CodeType -> CodeType -> CodeType
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 :: CodeType -> CodeType -> CodeType
$cmin :: CodeType -> CodeType -> CodeType
max :: CodeType -> CodeType -> CodeType
$cmax :: CodeType -> CodeType -> CodeType
>= :: CodeType -> CodeType -> Bool
$c>= :: CodeType -> CodeType -> Bool
> :: CodeType -> CodeType -> Bool
$c> :: CodeType -> CodeType -> Bool
<= :: CodeType -> CodeType -> Bool
$c<= :: CodeType -> CodeType -> Bool
< :: CodeType -> CodeType -> Bool
$c< :: CodeType -> CodeType -> Bool
compare :: CodeType -> CodeType -> Ordering
$ccompare :: CodeType -> CodeType -> Ordering
Ord)

-- Obscure but efficient parser for the Solidity sourcemap format.
makeSrcMaps :: Text -> Maybe (Seq SrcMap)
makeSrcMaps :: Text -> Maybe (Seq SrcMap)
makeSrcMaps = (\case (Seq SrcMap
_, SrcMapParseState
Fe, SrcMap
_) -> forall a. Maybe a
Nothing; (Seq SrcMap, SrcMapParseState, SrcMap)
x -> forall a. a -> Maybe a
Just ((Seq SrcMap, SrcMapParseState, SrcMap) -> Seq SrcMap
done (Seq SrcMap, SrcMapParseState, SrcMap)
x))
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> (Seq SrcMap, SrcMapParseState, SrcMap)
go) (forall a. Monoid a => a
mempty, FilePath -> Int -> SrcMapParseState
F1 [] Int
1, Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
0 Int
0 Int
0 JumpType
JumpRegular Int
0)
  where
    done :: (Seq SrcMap, SrcMapParseState, SrcMap) -> Seq SrcMap
done (Seq SrcMap
xs, SrcMapParseState
s, SrcMap
p) = let (Seq SrcMap
xs', SrcMapParseState
_, SrcMap
_) = Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> (Seq SrcMap, SrcMapParseState, SrcMap)
go Char
';' (Seq SrcMap
xs, SrcMapParseState
s, SrcMap
p) in Seq SrcMap
xs'
    readR :: FilePath -> Int
readR = forall a. Read a => FilePath -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

    go :: Char -> (Seq SrcMap, SrcMapParseState, SrcMap) -> (Seq SrcMap, SrcMapParseState, SrcMap)
    go :: Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> (Seq SrcMap, SrcMapParseState, SrcMap)
go Char
':' (Seq SrcMap
xs, F1 [] Int
_, p :: SrcMap
p@(SM Int
a Int
_ Int
_ JumpType
_ Int
_))     = (Seq SrcMap
xs, Int -> FilePath -> Int -> SrcMapParseState
F2 Int
a [] Int
1, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F1 FilePath
ds Int
k, SrcMap
p)                    = (Seq SrcMap
xs, Int -> FilePath -> Int -> SrcMapParseState
F2 (Int
k forall a. Num a => a -> a -> a
* (FilePath -> Int
readR FilePath
ds)) [] Int
1, SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F1 [] Int
_, SrcMap
p)                    = (Seq SrcMap
xs, FilePath -> Int -> SrcMapParseState
F1 [] (-Int
1), SrcMap
p)
    go Char
d   (Seq SrcMap
xs, F1 FilePath
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d        = (Seq SrcMap
xs, FilePath -> Int -> SrcMapParseState
F1 (Char
d forall a. a -> [a] -> [a]
: FilePath
ds) Int
k, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F1 [] Int
k, SrcMap
p)                    = (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p, FilePath -> Int -> SrcMapParseState
F1 [] Int
k, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F1 FilePath
ds Int
k, SM Int
_ Int
b Int
c JumpType
d Int
e)         = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM (Int
k forall a. Num a => a -> a -> a
* (FilePath -> Int
readR FilePath
ds)) Int
b Int
c JumpType
d Int
e in (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
'-' (Seq SrcMap
xs, F2 Int
a [] Int
_, SrcMap
p)                  = (Seq SrcMap
xs, Int -> FilePath -> Int -> SrcMapParseState
F2 Int
a [] (-Int
1), SrcMap
p)
    go Char
d   (Seq SrcMap
xs, F2 Int
a FilePath
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d      = (Seq SrcMap
xs, Int -> FilePath -> Int -> SrcMapParseState
F2 Int
a (Char
d forall a. a -> [a] -> [a]
: FilePath
ds) Int
k, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F2 Int
a [] Int
_, p :: SrcMap
p@(SM Int
_ Int
b Int
_ JumpType
_ Int
_))   = (Seq SrcMap
xs, Int -> Int -> FilePath -> Int -> SrcMapParseState
F3 Int
a Int
b [] Int
1, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F2 Int
a FilePath
ds Int
k, SrcMap
p)                  = (Seq SrcMap
xs, Int -> Int -> FilePath -> Int -> SrcMapParseState
F3 Int
a (Int
k forall a. Num a => a -> a -> a
* (FilePath -> Int
readR FilePath
ds)) [] Int
1, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F2 Int
a [] Int
_, SM Int
_ Int
b Int
c JumpType
d Int
e)       = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
d Int
e in (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F2 Int
a FilePath
ds Int
k, SM Int
_ Int
_ Int
c JumpType
d Int
e)       = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a (Int
k forall a. Num a => a -> a -> a
* (FilePath -> Int
readR FilePath
ds)) Int
c JumpType
d Int
e in
                                                 (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
d   (Seq SrcMap
xs, F3 Int
a Int
b FilePath
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d    = (Seq SrcMap
xs, Int -> Int -> FilePath -> Int -> SrcMapParseState
F3 Int
a Int
b (Char
d forall a. a -> [a] -> [a]
: FilePath
ds) Int
k, SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F3 Int
a Int
b [] Int
_, SrcMap
p)                = (Seq SrcMap
xs, Int -> Int -> FilePath -> Int -> SrcMapParseState
F3 Int
a Int
b [] (-Int
1), SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F3 Int
a Int
b [] Int
_, p :: SrcMap
p@(SM Int
_ Int
_ Int
c JumpType
_ Int
_)) = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c forall a. Maybe a
Nothing, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F3 Int
a Int
b FilePath
ds Int
k, SrcMap
p)                = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b (Int
k forall a. Num a => a -> a -> a
* (FilePath -> Int
readR FilePath
ds)) forall a. Maybe a
Nothing, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F3 Int
a Int
b [] Int
_, SM Int
_ Int
_ Int
c JumpType
d Int
e)     = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
d Int
e in (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F3 Int
a Int
b FilePath
ds Int
k, SM Int
_ Int
_ Int
_ JumpType
d Int
e)     = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b (Int
k forall a. Num a => a -> a -> a
* (FilePath -> Int
readR FilePath
ds)) JumpType
d Int
e in
                                                 (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
'i' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
Nothing, SrcMap
p)           = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c (forall a. a -> Maybe a
Just JumpType
JumpInto), SrcMap
p)
    go Char
'o' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
Nothing, SrcMap
p)           = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c (forall a. a -> Maybe a
Just JumpType
JumpFrom), SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
Nothing, SrcMap
p)           = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b Int
c (forall a. a -> Maybe a
Just JumpType
JumpRegular), SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F4 Int
a Int
b Int
c (Just JumpType
d),  SrcMap
p)         = (Seq SrcMap
xs, Int -> Int -> Int -> JumpType -> FilePath -> SrcMapParseState
F5 Int
a Int
b Int
c JumpType
d [], SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
_, p :: SrcMap
p@(SM Int
_ Int
_ Int
_ JumpType
d Int
_))  = (Seq SrcMap
xs, Int -> Int -> Int -> JumpType -> FilePath -> SrcMapParseState
F5 Int
a Int
b Int
c JumpType
d [], SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F4 Int
a Int
b Int
c Maybe JumpType
_, SM Int
_ Int
_ Int
_ JumpType
d Int
e)      = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
d Int
e in
                                                 (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
d   (Seq SrcMap
xs, F5 Int
a Int
b Int
c JumpType
j FilePath
ds, SrcMap
p) | Char -> Bool
isDigit Char
d  = (Seq SrcMap
xs, Int -> Int -> Int -> JumpType -> FilePath -> SrcMapParseState
F5 Int
a Int
b Int
c JumpType
j (Char
d forall a. a -> [a] -> [a]
: FilePath
ds), SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F5 Int
a Int
b Int
c JumpType
j [], SrcMap
_)              = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
j (-Int
1) in -- solc <0.6
                                                 (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F5 Int
a Int
b Int
c JumpType
j FilePath
ds, SrcMap
_)              = let p' :: SrcMap
p' = Int -> Int -> Int -> JumpType -> Int -> SrcMap
SM Int
a Int
b Int
c JumpType
j (FilePath -> Int
readR FilePath
ds) in -- solc >=0.6
                                                 (Seq SrcMap
xs forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', FilePath -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
c (Seq SrcMap
xs, SrcMapParseState
state, SrcMap
p)                      = (Seq SrcMap
xs, forall a. HasCallStack => FilePath -> a
error (FilePath
"srcmap: y u " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Char
c forall a. [a] -> [a] -> [a]
++ FilePath
" in state" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show SrcMapParseState
state forall a. [a] -> [a] -> [a]
++ FilePath
"?!?"), SrcMap
p)

makeSourceCache :: [(Text, Maybe ByteString)] -> Map Text Value -> IO SourceCache
makeSourceCache :: [(Text, Maybe ByteString)] -> Map Text Value -> IO SourceCache
makeSourceCache [(Text, Maybe ByteString)]
paths Map Text Value
asts = do
  let f :: (Text, Maybe ByteString) -> IO ByteString
f (Text
_,  Just ByteString
content) = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
      f (Text
fp, Maybe ByteString
Nothing) = FilePath -> IO ByteString
BS.readFile forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
fp
  [ByteString]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Maybe ByteString) -> IO ByteString
f [(Text, Maybe ByteString)]
paths
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SourceCache
    { $sel:files:SourceCache :: [(Text, ByteString)]
files = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe ByteString)]
paths) [ByteString]
xs
    , $sel:lines:SourceCache :: [Vector ByteString]
lines = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Vector a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
BS.split Word8
0xa) [ByteString]
xs
    , $sel:asts:SourceCache :: Map Text Value
asts  = Map Text Value
asts
    }

lineSubrange ::
  Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
lineSubrange :: Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
lineSubrange Vector ByteString
xs (Int
s1, Int
n1) Int
i =
  let
    ks :: Vector Int
ks = forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (\ByteString
x -> Int
1 forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
x) Vector ByteString
xs
    s2 :: Int
s2  = forall a. Num a => Vector a -> a
Vector.sum (forall a. Int -> Vector a -> Vector a
Vector.take Int
i Vector Int
ks)
    n2 :: Int
n2  = Vector Int
ks forall a. Vector a -> Int -> a
Vector.! Int
i
  in
    if Int
s1 forall a. Num a => a -> a -> a
+ Int
n1 forall a. Ord a => a -> a -> Bool
< Int
s2 Bool -> Bool -> Bool
|| Int
s1 forall a. Ord a => a -> a -> Bool
> Int
s2 forall a. Num a => a -> a -> a
+ Int
n2
    then forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just (Int
s1 forall a. Num a => a -> a -> a
- Int
s2, forall a. Ord a => a -> a -> a
min (Int
s2 forall a. Num a => a -> a -> a
+ Int
n2 forall a. Num a => a -> a -> a
- Int
s1) Int
n1)

readSolc :: FilePath -> IO (Maybe (Map Text SolcContract, SourceCache))
readSolc :: FilePath -> IO (Maybe (Map Text SolcContract, SourceCache))
readSolc FilePath
fp =
  (Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readFile FilePath
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe
  (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just (Map Text SolcContract
contracts, Map Text Value
asts, [(Text, Maybe ByteString)]
sources) -> do
        SourceCache
sourceCache <- [(Text, Maybe ByteString)] -> Map Text Value -> IO SourceCache
makeSourceCache [(Text, Maybe ByteString)]
sources Map Text Value
asts
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Map Text SolcContract
contracts, SourceCache
sourceCache))

yul :: Text -> Text -> IO (Maybe ByteString)
yul :: Text -> Text -> IO (Maybe ByteString)
yul Text
contract Text
src = do
  (Text
json, Text
path) <- Text -> IO (Text, Text)
yul' Text
src
  let f :: Value
f = (Text
json forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"contracts") forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
Key.fromText Text
path)
      c :: Value
c = Value
f forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
Key.fromText forall a b. (a -> b) -> a -> b
$ if Text -> Bool
Text.null Text
contract then Text
"object" else Text
contract)
      bytecode :: Text
bytecode = Value
c forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"evm" forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"bytecode" forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"object" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ByteString
toCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just Text
bytecode)

yulRuntime :: Text -> Text -> IO (Maybe ByteString)
yulRuntime :: Text -> Text -> IO (Maybe ByteString)
yulRuntime Text
contract Text
src = do
  (Text
json, Text
path) <- Text -> IO (Text, Text)
yul' Text
src
  let f :: Value
f = (Text
json forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"contracts") forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
Key.fromText Text
path)
      c :: Value
c = Value
f forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
Key.fromText forall a b. (a -> b) -> a -> b
$ if Text -> Bool
Text.null Text
contract then Text
"object" else Text
contract)
      bytecode :: Text
bytecode = Value
c forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"evm" forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"deployedBytecode" forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"object" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ByteString
toCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just Text
bytecode)

solidity :: Text -> Text -> IO (Maybe ByteString)
solidity :: Text -> Text -> IO (Maybe ByteString)
solidity Text
contract Text
src = do
  (Text
json, Text
path) <- Text -> IO (Text, Text)
solidity' Text
src
  let (Map Text SolcContract
sol, Map Text Value
_, [(Text, Maybe ByteString)]
_) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
path forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
contract) Map Text SolcContract
sol forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.creationCode)

solcRuntime :: Text -> Text -> IO (Maybe ByteString)
solcRuntime :: Text -> Text -> IO (Maybe ByteString)
solcRuntime Text
contract Text
src = do
  (Text
json, Text
path) <- Text -> IO (Text, Text)
solidity' Text
src
  let (Map Text SolcContract
sol, Map Text Value
_, [(Text, Maybe ByteString)]
_) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
path forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
contract) Map Text SolcContract
sol forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.runtimeCode)

functionAbi :: Text -> IO Method
functionAbi :: Text -> IO Method
functionAbi Text
f = do
  (Text
json, Text
path) <- Text -> IO (Text, Text)
solidity' (Text
"contract ABI { function " forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" public {}}")
  let (Map Text SolcContract
sol, Map Text Value
_, [(Text, Maybe ByteString)]
_) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  case forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
path forall a. Semigroup a => a -> a -> a
<> Text
":ABI") Map Text SolcContract
sol)).abiMap of
     [(Word32
_,Method
b)] -> forall (m :: * -> *) a. Monad m => a -> m a
return Method
b
     [(Word32, Method)]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"hevm internal error: unexpected abi format"

force :: String -> Maybe a -> a
force :: forall a. FilePath -> Maybe a -> a
force FilePath
s = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
s)

readJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON :: Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json = case Text
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"sourceList" of
  Maybe Value
Nothing -> Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readStdJSON Text
json
  Maybe Value
_ -> Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readCombinedJSON Text
json

-- deprecate me soon
readCombinedJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readCombinedJSON :: Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readCombinedJSON Text
json = do
  Map Text SolcContract
contracts <- forall {v1}. AsValue v1 => HashMap Text v1 -> Map Text SolcContract
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"contracts" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (KeyMap Value)
_Object)
  [Text]
sources <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall t. AsValue t => Prism' t Text
_String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"sourceList" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array
  forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text SolcContract
contracts, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Value
asts), [ (Text
x, forall a. Maybe a
Nothing) | Text
x <- [Text]
sources])
  where
    asts :: HashMap Text Value
asts = forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"JSON lacks abstract syntax trees.") (Text
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"sources" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (KeyMap Value)
_Object)
    f :: HashMap Text v1 -> Map Text SolcContract
f HashMap Text v1
x = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HMap.toList forall a b. (a -> b) -> a -> b
$ forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMap.mapWithKey forall {s}. AsValue s => Text -> s -> SolcContract
g HashMap Text v1
x
    g :: Text -> s -> SolcContract
g Text
s s
x =
      let
        theRuntimeCode :: ByteString
theRuntimeCode = Text -> ByteString
toCode (s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"bin-runtime" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
        theCreationCode :: ByteString
theCreationCode = Text -> ByteString
toCode (s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"bin" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
        abis :: [Value]
abis = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ case (s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"abi") forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Prism' t (Vector Value)
_Array of
                 Just Vector Value
v -> Vector Value
v                                       -- solc >= 0.8
                 Maybe (Vector Value)
Nothing -> (s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"abi" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String) forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Prism' t (Vector Value)
_Array -- solc <  0.8
      in SolcContract {
        $sel:runtimeCode:SolcContract :: ByteString
runtimeCode      = ByteString
theRuntimeCode,
        $sel:creationCode:SolcContract :: ByteString
creationCode     = ByteString
theCreationCode,
        $sel:runtimeCodehash:SolcContract :: W256
runtimeCodehash  = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        $sel:creationCodehash:SolcContract :: W256
creationCodehash = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        $sel:runtimeSrcmap:SolcContract :: Seq SrcMap
runtimeSrcmap    = forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"srcmap-runtime" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)),
        $sel:creationSrcmap:SolcContract :: Seq SrcMap
creationSrcmap   = forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"srcmap" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)),
        $sel:contractName:SolcContract :: Text
contractName = Text
s,
        $sel:constructorInputs:SolcContract :: [(Text, AbiType)]
constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        $sel:abiMap:SolcContract :: Map Word32 Method
abiMap       = [Value] -> Map Word32 Method
mkAbiMap [Value]
abis,
        $sel:eventMap:SolcContract :: Map W256 Event
eventMap     = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        $sel:errorMap:SolcContract :: Map W256 SolError
errorMap     = [Value] -> Map W256 SolError
mkErrorMap [Value]
abis,
        $sel:storageLayout:SolcContract :: Maybe (Map Text StorageItem)
storageLayout = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout forall a b. (a -> b) -> a -> b
$ s
x forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"storage-layout",
        $sel:immutableReferences:SolcContract :: Map W256 [Reference]
immutableReferences = forall a. Monoid a => a
mempty -- TODO: deprecate combined-json
      }

readStdJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readStdJSON :: Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readStdJSON Text
json = do
  HashMap Text Value
contracts <- forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"contracts" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (KeyMap Value)
_Object
  -- TODO: support the general case of "urls" and "content" in the standard json
  HashMap Text Value
sources <- forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Text
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"sources" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (KeyMap Value)
_Object
  let asts :: HashMap Text Value
asts = forall a. FilePath -> Maybe a -> a
force FilePath
"JSON lacks abstract syntax trees." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall t. AsValue t => Key -> Traversal' t Value
key Key
"ast") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Value
sources
      contractMap :: Map Text (SolcContract, HashMap Text Text)
contractMap = forall s.
AsValue s =>
HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f HashMap Text Value
contracts
      contents :: Text -> (Text, Maybe ByteString)
contents Text
src = (Text
src, Text -> ByteString
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
src (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap))
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Value
asts), Text -> (Text, Maybe ByteString)
contents forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
HMap.keys HashMap Text Value
sources))
  where
    f :: (AsValue s) => HMap.HashMap Text s -> (Map Text (SolcContract, (HMap.HashMap Text Text)))
    f :: forall s.
AsValue s =>
HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f HashMap Text s
x = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {s}.
AsValue s =>
(Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HMap.toList forall a b. (a -> b) -> a -> b
$ HashMap Text s
x
    g :: (Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
g (Text
s, s
x) = Text -> (Text, Value) -> (Text, (SolcContract, HashMap Text Text))
h Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. HashMap k v -> [(k, v)]
HMap.toList (forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall t. AsValue t => Prism' t (KeyMap Value)
_Object s
x))
    h :: Text -> (Text, Value) -> (Text, (SolcContract, HMap.HashMap Text Text))
    h :: Text -> (Text, Value) -> (Text, (SolcContract, HashMap Text Text))
h Text
s (Text
c, Value
x) =
      let
        evmstuff :: Value
evmstuff = Value
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"evm"
        runtime :: Value
runtime = Value
evmstuff forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"deployedBytecode"
        creation :: Value
creation =  Value
evmstuff forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"bytecode"
        theRuntimeCode :: ByteString
theRuntimeCode = Text -> ByteString
toCode forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Value
runtime forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"object" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
        theCreationCode :: ByteString
theCreationCode = Text -> ByteString
toCode forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Value
creation forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"object" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
        srcContents :: Maybe (HMap.HashMap Text Text)
        srcContents :: Maybe (HashMap Text Text)
srcContents = do Text
metadata <- Value
x forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"metadata" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
                         HashMap Text Value
srcs <- forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
metadata forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"sources" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (KeyMap Value)
_Object
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall t. AsValue t => Key -> Traversal' t Value
key Key
"content" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HMap.filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall t. AsValue t => Key -> Traversal' t Value
key Key
"content")) HashMap Text Value
srcs)
        abis :: [Value]
abis = forall a. FilePath -> Maybe a -> a
force (FilePath
"abi key not found in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Value
x) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
x forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"abi" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array
      in (Text
s forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
c, (SolcContract {
        $sel:runtimeCode:SolcContract :: ByteString
runtimeCode      = ByteString
theRuntimeCode,
        $sel:creationCode:SolcContract :: ByteString
creationCode     = ByteString
theCreationCode,
        $sel:runtimeCodehash:SolcContract :: W256
runtimeCodehash  = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        $sel:creationCodehash:SolcContract :: W256
creationCodehash = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        $sel:runtimeSrcmap:SolcContract :: Seq SrcMap
runtimeSrcmap    = forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
runtime forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"sourceMap" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)),
        $sel:creationSrcmap:SolcContract :: Seq SrcMap
creationSrcmap   = forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
creation forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"sourceMap" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)),
        $sel:contractName:SolcContract :: Text
contractName = Text
s forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
c,
        $sel:constructorInputs:SolcContract :: [(Text, AbiType)]
constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        $sel:abiMap:SolcContract :: Map Word32 Method
abiMap        = [Value] -> Map Word32 Method
mkAbiMap [Value]
abis,
        $sel:eventMap:SolcContract :: Map W256 Event
eventMap      = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        $sel:errorMap:SolcContract :: Map W256 SolError
errorMap      = [Value] -> Map W256 SolError
mkErrorMap [Value]
abis,
        $sel:storageLayout:SolcContract :: Maybe (Map Text StorageItem)
storageLayout = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout forall a b. (a -> b) -> a -> b
$ Value
x forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"storageLayout",
        $sel:immutableReferences:SolcContract :: Map W256 [Reference]
immutableReferences = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
          do Value
x' <- Value
runtime forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"immutableReferences"
             case forall a. FromJSON a => Value -> Result a
fromJSON Value
x' of
               Success Map W256 [Reference]
a -> forall (m :: * -> *) a. Monad m => a -> m a
return Map W256 [Reference]
a
               Result (Map W256 [Reference])
_ -> forall a. Maybe a
Nothing
      }, forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (HashMap Text Text)
srcContents))

mkAbiMap :: [Value] -> Map Word32 Method
mkAbiMap :: [Value] -> Map Word32 Method
mkAbiMap [Value]
abis = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"function" forall a. Eq a => a -> a -> Bool
== Value
y forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String) [Value]
abis
    f :: s -> (Word32, Method)
f s
abi =
      (ByteString -> Word32
abiKeccak (Text -> ByteString
encodeUtf8 (forall s. AsValue s => s -> Text
signature s
abi)),
       Method { $sel:name:Method :: Text
name = s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
              , $sel:methodSignature:Method :: Text
methodSignature = forall s. AsValue s => s -> Text
signature s
abi
              , $sel:inputs:Method :: [(Text, AbiType)]
inputs = forall a b. (a -> b) -> [a] -> [b]
map forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"inputs" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , $sel:output:Method :: [(Text, AbiType)]
output = forall a b. (a -> b) -> [a] -> [b]
map forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"outputs" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , $sel:mutability:Method :: Mutability
mutability = Text -> Mutability
parseMutability
                 (s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"stateMutability" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
              })
  in forall {s}. AsValue s => s -> (Word32, Method)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant

mkEventMap :: [Value] -> Map W256 Event
mkEventMap :: [Value] -> Map W256 Event
mkEventMap [Value]
abis = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"event" forall a. Eq a => a -> a -> Bool
== Value
y forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String) [Value]
abis
    f :: s -> (W256, Event)
f s
abi =
     ( ByteString -> W256
keccak' (Text -> ByteString
encodeUtf8 (forall s. AsValue s => s -> Text
signature s
abi))
     , Text -> Anonymity -> [(Text, AbiType, Indexed)] -> Event
Event
       (s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
       (case s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"anonymous" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Bool
_Bool of
         Bool
True -> Anonymity
Anonymous
         Bool
False -> Anonymity
NotAnonymous)
       (forall a b. (a -> b) -> [a] -> [b]
map (\Value
y ->
        ( Value
y forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
        , forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: type" (forall s. AsValue s => s -> Maybe AbiType
parseTypeName' Value
y)
        , if Value
y forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"indexed" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Bool
_Bool
          then Indexed
Indexed
          else Indexed
NotIndexed
        ))
       (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"inputs" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array))
     )
  in forall {s}. AsValue s => s -> (W256, Event)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant

mkErrorMap :: [Value] -> Map W256 SolError
mkErrorMap :: [Value] -> Map W256 SolError
mkErrorMap [Value]
abis = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"error" forall a. Eq a => a -> a -> Bool
== Value
y forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String) [Value]
abis
    f :: s -> (W256, SolError)
f s
abi =
     ( W256 -> W256
stripKeccak forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak' (Text -> ByteString
encodeUtf8 (forall s. AsValue s => s -> Text
signature s
abi))
     , Text -> [AbiType] -> SolError
SolError
       (s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
       (forall a b. (a -> b) -> [a] -> [b]
map (forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. AsValue s => s -> Maybe AbiType
parseTypeName')
       (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"inputs" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array))
     )
  in forall {s}. AsValue s => s -> (W256, SolError)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant
  where
    stripKeccak :: W256 -> W256
    stripKeccak :: W256 -> W256
stripKeccak = forall a. Read a => FilePath -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show

mkConstructor :: [Value] -> [(Text, AbiType)]
mkConstructor :: [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis =
  let
    isConstructor :: s -> Bool
isConstructor s
y =
      Text
"constructor" forall a. Eq a => a -> a -> Bool
== s
y forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
  in
    case forall a. (a -> Bool) -> [a] -> [a]
filter forall {s}. AsValue s => s -> Bool
isConstructor [Value]
abis of
      [Value
abi] -> forall a b. (a -> b) -> [a] -> [b]
map forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Value
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"inputs" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array))
      [] -> [] -- default constructor has zero inputs
      [Value]
_  -> forall a. HasCallStack => FilePath -> a
error FilePath
"strange: contract has multiple constructors"

mkStorageLayout :: Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout :: Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout Maybe Value
Nothing = forall a. Maybe a
Nothing
mkStorageLayout (Just Value
json) = do
  Vector Value
items <- Value
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"storage" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array
  Value
types <- Value
json forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"types"
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Vector a -> [a]
Vector.toList Vector Value
items) forall a b. (a -> b) -> a -> b
$ \Value
item ->
    do Text
name <- Value
item forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"label" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
       Int
offset <- Value
item forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"offset" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Scientific
_Number forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger
       Text
slot <- Value
item forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"slot" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
       Key
typ <- Text -> Key
Key.fromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
item forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
       Text
slotType <- Value
types forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
typ forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"label" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
       forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, SlotType -> Int -> Int -> StorageItem
StorageItem (forall a. Read a => FilePath -> a
read forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
slotType) Int
offset (forall a. Read a => FilePath -> a
read forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
slot)))

signature :: AsValue s => s -> Text
signature :: forall s. AsValue s => s -> Text
signature s
abi =
  case s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" of
    Value
"fallback" -> Text
"<fallback>"
    Value
_ ->
      forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [
        forall a. a -> Maybe a -> a
fromMaybe Text
"<constructor>" (s
abi forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String), Text
"(",
        Text -> [Text] -> Text
intercalate Text
","
          (forall a b. (a -> b) -> [a] -> [b]
map (\Value
x -> Value
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
            (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ s
abi forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"inputs" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array)),
        Text
")"
      ]

-- Helper function to convert the fields to the desired type
parseTypeName' :: AsValue s => s -> Maybe AbiType
parseTypeName' :: forall s. AsValue s => s -> Maybe AbiType
parseTypeName' s
x =
  Vector AbiType -> Text -> Maybe AbiType
parseTypeName
    (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ s
x forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"components" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Vector Value -> Vector AbiType
parseComponents)
    (s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
  where parseComponents :: Vector Value -> Vector AbiType
parseComponents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput

parseMutability :: Text -> Mutability
parseMutability :: Text -> Mutability
parseMutability Text
"view" = Mutability
View
parseMutability Text
"pure" = Mutability
Pure
parseMutability Text
"nonpayable" = Mutability
NonPayable
parseMutability Text
"payable" = Mutability
Payable
parseMutability Text
_ = forall a. HasCallStack => FilePath -> a
error FilePath
"unknown function mutability"

-- This actually can also parse a method output! :O
parseMethodInput :: AsValue s => s -> (Text, AbiType)
parseMethodInput :: forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput s
x =
  ( s
x forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
  , forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: method type" (forall s. AsValue s => s -> Maybe AbiType
parseTypeName' s
x)
  )

containsLinkerHole :: Text -> Bool
containsLinkerHole :: Text -> Bool
containsLinkerHole = Text -> Text -> Bool
regexMatches Text
"__\\$[a-z0-9]{34}\\$__"

toCode :: Text -> ByteString
toCode :: Text -> ByteString
toCode Text
t = case ByteString -> Either Text ByteString
BS16.decodeBase16 (Text -> ByteString
encodeUtf8 Text
t) of
  Right ByteString
d -> ByteString
d
  Left Text
e -> if Text -> Bool
containsLinkerHole Text
t
            then forall a. HasCallStack => FilePath -> a
error FilePath
"unlinked libraries detected in bytecode"
            else forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
e

solidity' :: Text -> IO (Text, Text)
solidity' :: Text -> IO (Text, Text)
solidity' Text
src = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"hevm.sol" forall a b. (a -> b) -> a -> b
$ \FilePath
path Handle
handle -> do
  Handle -> IO ()
hClose Handle
handle
  FilePath -> Text -> IO ()
writeFile FilePath
path (Text
"//SPDX-License-Identifier: UNLICENSED\n" forall a. Semigroup a => a -> a -> a
<> Text
"pragma solidity ^0.8.6;\n" forall a. Semigroup a => a -> a -> a
<> Text
src)
  FilePath -> Text -> IO ()
writeFile (FilePath
path forall a. Semigroup a => a -> a -> a
<> FilePath
".json")
    [Here.i|
    {
      "language": "Solidity",
      "sources": {
        ${path}: {
          "urls": [
            ${path}
          ]
        }
      },
      "settings": {
        "outputSelection": {
          "*": {
            "*": [
              "metadata",
              "evm.bytecode",
              "evm.deployedBytecode",
              "abi",
              "storageLayout",
              "evm.bytecode.sourceMap",
              "evm.bytecode.linkReferences",
              "evm.bytecode.generatedSources",
              "evm.deployedBytecode.sourceMap",
              "evm.deployedBytecode.linkReferences",
              "evm.deployedBytecode.generatedSources"
            ],
            "": [
              "ast"
            ]
          }
        }
      }
    }
    |]
  Text
x <- FilePath -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess
      FilePath
"solc"
      [FilePath
"--allow-paths", FilePath
path, FilePath
"--standard-json", (FilePath
path forall a. Semigroup a => a -> a -> a
<> FilePath
".json")]
      FilePath
""
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, FilePath -> Text
pack FilePath
path)

yul' :: Text -> IO (Text, Text)
yul' :: Text -> IO (Text, Text)
yul' Text
src = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"hevm.yul" forall a b. (a -> b) -> a -> b
$ \FilePath
path Handle
handle -> do
  Handle -> IO ()
hClose Handle
handle
  FilePath -> Text -> IO ()
writeFile FilePath
path Text
src
  FilePath -> Text -> IO ()
writeFile (FilePath
path forall a. Semigroup a => a -> a -> a
<> FilePath
".json")
    [Here.i|
    {
      "language": "Yul",
      "sources": { ${path}: { "urls": [ ${path} ] } },
      "settings": { "outputSelection": { "*": { "*": ["*"], "": [ "*" ] } } }
    }
    |]
  Text
x <- FilePath -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess
      FilePath
"solc"
      [FilePath
"--allow-paths", FilePath
path, FilePath
"--standard-json", (FilePath
path forall a. Semigroup a => a -> a -> a
<> FilePath
".json")]
      FilePath
""
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, FilePath -> Text
pack FilePath
path)

solc :: Language -> Text -> IO Text
solc :: Language -> Text -> IO Text
solc Language
lang Text
src =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"hevm.sol" forall a b. (a -> b) -> a -> b
$ \FilePath
path Handle
handle -> do
    Handle -> IO ()
hClose Handle
handle
    FilePath -> Text -> IO ()
writeFile FilePath
path (Language -> Text -> Text
stdjson Language
lang Text
src)
    FilePath -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess
      FilePath
"solc"
      [FilePath
"--standard-json", FilePath
path]
      FilePath
""

data Language = Solidity | Yul
  deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> FilePath
$cshow :: Language -> FilePath
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show)

data StandardJSON = StandardJSON Language Text
-- more options later perhaps

instance ToJSON StandardJSON where
  toJSON :: StandardJSON -> Value
toJSON (StandardJSON Language
lang Text
src) =
    [Pair] -> Value
object [ Key
"language" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> FilePath
show Language
lang
           , Key
"sources" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"hevm.sol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                                   [Pair] -> Value
object [Key
"content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
src]]
           , Key
"settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
             [Pair] -> Value
object [ Key
"outputSelection" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                    [Pair] -> Value
object [Key
"*" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                      [Pair] -> Value
object [Key
"*" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall a. ToJSON a => a -> Value
toJSON
                              [FilePath
"metadata" :: String,
                               FilePath
"evm.bytecode",
                               FilePath
"evm.deployedBytecode",
                               FilePath
"abi",
                               FilePath
"storageLayout",
                               FilePath
"evm.bytecode.sourceMap",
                               FilePath
"evm.bytecode.linkReferences",
                               FilePath
"evm.bytecode.generatedSources",
                               FilePath
"evm.deployedBytecode.sourceMap",
                               FilePath
"evm.deployedBytecode.linkReferences",
                               FilePath
"evm.deployedBytecode.generatedSources",
                               FilePath
"evm.deployedBytecode.immutableReferences"
                              ]),
                              Key
"" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall a. ToJSON a => a -> Value
toJSON [FilePath
"ast" :: String])
                             ]
                            ]
                    ]
           ]

stdjson :: Language -> Text -> Text
stdjson :: Language -> Text -> Text
stdjson Language
lang Text
src = ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ Language -> Text -> StandardJSON
StandardJSON Language
lang Text
src

-- | When doing CREATE and passing constructor arguments, Solidity loads
-- the argument data via the creation bytecode, since there is no "calldata"
-- for CREATE.
--
-- This interferes with our ability to look up the current contract by
-- codehash, so we must somehow strip away this extra suffix. Luckily
-- we can detect the end of the actual bytecode by looking for the
-- "metadata hash". (Not 100% correct, but works in practice.)
--
-- Actually, we strip away the entire BZZR suffix too, because as long
-- as the codehash matches otherwise, we don't care if there is some
-- difference there.
stripBytecodeMetadata :: ByteString -> ByteString
stripBytecodeMetadata :: ByteString -> ByteString
stripBytecodeMetadata ByteString
bs =
  let stripCandidates :: [(ByteString, ByteString)]
stripCandidates = forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
bs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
knownBzzrPrefixes in
    case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(ByteString, ByteString)]
stripCandidates of
      Maybe (ByteString, ByteString)
Nothing -> ByteString
bs
      Just (ByteString
b, ByteString
_) -> ByteString
b

stripBytecodeMetadataSym :: [Expr Byte] -> [Expr Byte]
stripBytecodeMetadataSym :: [Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym [Expr 'Byte]
b =
  let
    concretes :: [Maybe Word8]
    concretes :: [Maybe Word8]
concretes = Expr 'Byte -> Maybe Word8
unlitByte forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr 'Byte]
b
    bzzrs :: [[Maybe Word8]]
    bzzrs :: [[Maybe Word8]]
bzzrs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
knownBzzrPrefixes
    candidates :: [Bool]
candidates = (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => [a] -> [a] -> Bool
Data.List.isInfixOf [Maybe Word8]
concretes) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Maybe Word8]]
bzzrs
  in case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Bool
True [Bool]
candidates of
    Maybe Int
Nothing -> [Expr 'Byte]
b
    Just Int
i -> let ind :: Int
ind = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe Int
infixIndex ([[Maybe Word8]]
bzzrs forall a. [a] -> Int -> a
!! Int
i) [Maybe Word8]
concretes
              in forall a. Int -> [a] -> [a]
take Int
ind [Expr 'Byte]
b

infixIndex :: (Eq a) => [a] -> [a] -> Maybe Int
infixIndex :: forall a. Eq a => [a] -> [a] -> Maybe Int
infixIndex [a]
needle [a]
haystack = forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
needle) (forall a. [a] -> [[a]]
tails [a]
haystack)

knownBzzrPrefixes :: [ByteString]
knownBzzrPrefixes :: [ByteString]
knownBzzrPrefixes = [
  -- a1 65 "bzzr0" 0x58 0x20 (solc <= 0.5.8)
  [Word8] -> ByteString
BS.pack [Word8
0xa1, Word8
0x65, Word8
98, Word8
122, Word8
122, Word8
114, Word8
48, Word8
0x58, Word8
0x20],
  -- a2 65 "bzzr0" 0x58 0x20 (solc >= 0.5.9)
  [Word8] -> ByteString
BS.pack [Word8
0xa2, Word8
0x65, Word8
98, Word8
122, Word8
122, Word8
114, Word8
48, Word8
0x58, Word8
0x20],
  -- a2 65 "bzzr1" 0x58 0x20 (solc >= 0.5.11)
  [Word8] -> ByteString
BS.pack [Word8
0xa2, Word8
0x65, Word8
98, Word8
122, Word8
122, Word8
114, Word8
49, Word8
0x58, Word8
0x20],
  -- a2 64 "ipfs" 0x58 0x22 (solc >= 0.6.0)
  [Word8] -> ByteString
BS.pack [Word8
0xa2, Word8
0x64, Word8
0x69, Word8
0x70, Word8
0x66, Word8
0x73, Word8
0x58, Word8
0x22]
  ]

-- | Every node in the AST has an ID, and other nodes reference those
-- IDs.  This function recurses through the tree looking for objects
-- with the "id" key and makes a big map from ID to value.
astIdMap :: Foldable f => f Value -> Map Int Value
astIdMap :: forall (f :: * -> *). Foldable f => f Value -> Map Int Value
astIdMap = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Map Int Value
f
  where
    f :: Value -> Map Int Value
    f :: Value -> Map Int Value
f (Array Vector Value
x) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Map Int Value
f Vector Value
x
    f v :: Value
v@(Object KeyMap Value
x) =
      let t :: Map Int Value
t = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Map Int Value
f (forall v. KeyMap v -> [v]
KeyMap.elems KeyMap Value
x)
      in case forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"id" KeyMap Value
x of
        Maybe Value
Nothing         -> Map Int Value
t
        Just (Number Scientific
i) -> Map Int Value
t forall a. Semigroup a => a -> a -> a
<> forall k a. k -> a -> Map k a
Map.singleton (forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
i) Value
v
        Just Value
_          -> Map Int Value
t
    f Value
_ = forall a. Monoid a => a
mempty

astSrcMap :: Map Int Value -> (SrcMap -> Maybe Value)
astSrcMap :: Map Int Value -> SrcMap -> Maybe Value
astSrcMap Map Int Value
astIds =
  \(SM Int
i Int
n Int
f JumpType
_ Int
_)  -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
i, Int
n, Int
f) Map (Int, Int, Int) Value
tmp
  where
    tmp :: Map (Int, Int, Int) Value
    tmp :: Map (Int, Int, Int) Value
tmp =
       forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (\Value
v -> do
          Text
src <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall t. AsValue t => Key -> Traversal' t Value
key Key
"src" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String) Value
v
          [Int
i, Int
n, Int
f] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Read a => FilePath -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Text.unpack) ((Char -> Bool) -> Text -> [Text]
Text.split (forall a. Eq a => a -> a -> Bool
== Char
':') Text
src)
          forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
i, Int
n, Int
f), Value
v)
        )
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems
      forall a b. (a -> b) -> a -> b
$ Map Int Value
astIds