{-# Language DeriveAnyClass #-}
{-# Language DataKinds #-}
{-# Language StrictData #-}
{-# Language TemplateHaskell #-}
{-# Language OverloadedStrings #-}
{-# Language QuasiQuotes #-}

module EVM.Solidity
  ( solidity
  , solcRuntime
  , solidity'
  , yul'
  , yul
  , yulRuntime
  , JumpType (..)
  , SolcContract (..)
  , StorageItem (..)
  , SourceCache (..)
  , SrcMap (..)
  , CodeType (..)
  , Method (..)
  , SlotType (..)
  , Reference(..)
  , Mutability(..)
  , methodName
  , methodSignature
  , methodInputs
  , methodOutput
  , methodMutability
  , abiMap
  , eventMap
  , errorMap
  , storageLayout
  , contractName
  , constructorInputs
  , creationCode
  , functionAbi
  , makeSrcMaps
  , readSolc
  , readJSON
  , readStdJSON
  , readCombinedJSON
  , runtimeCode
  , runtimeCodehash
  , creationCodehash
  , runtimeSrcmap
  , creationSrcmap
  , sourceFiles
  , sourceLines
  , sourceAsts
  , stripBytecodeMetadata
  , stripBytecodeMetadataSym
  , signature
  , solc
  , Language(..)
  , stdjson
  , parseMethodInput
  , lineSubrange
  , astIdMap
  , astSrcMap
  , containsLinkerHole
) where

import EVM.ABI
import EVM.Types
import Data.SBV

import Control.Applicative
import Control.Monad
import Control.Lens         hiding (Indexed, (.=))
import qualified Data.String.Here as Here
import Data.Aeson hiding (json)
import Data.Aeson.Types
import Data.Aeson.Lens
import Data.Scientific
import Data.ByteString      (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Char            (isDigit)
import Data.Foldable
import Data.Map.Strict      (Map)
import Data.Maybe
import Data.List.NonEmpty   (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Semigroup
import Data.Sequence        (Seq)
import Data.Text            (Text, pack, intercalate)
import Data.Text.Encoding   (encodeUtf8, decodeUtf8)
import Data.Text.IO         (readFile, writeFile)
import Data.Vector          (Vector)
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)

import qualified Data.ByteString        as BS
import qualified Data.ByteString.Base16 as BS16
import qualified Data.HashMap.Strict    as HMap
import qualified Data.Map.Strict        as Map
import qualified Data.Text              as Text
import qualified Data.Vector            as Vector
import Data.List (sort, isPrefixOf, isInfixOf, elemIndex, tails, findIndex)

data StorageItem = StorageItem {
  StorageItem -> SlotType
_type   :: SlotType,
  StorageItem -> Int
_offset :: Int,
  StorageItem -> Int
_slot   :: Int
  } deriving (Int -> StorageItem -> ShowS
[StorageItem] -> ShowS
StorageItem -> String
(Int -> StorageItem -> ShowS)
-> (StorageItem -> String)
-> ([StorageItem] -> ShowS)
-> Show StorageItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StorageItem] -> ShowS
$cshowList :: [StorageItem] -> ShowS
show :: StorageItem -> String
$cshow :: StorageItem -> String
showsPrec :: Int -> StorageItem -> ShowS
$cshowsPrec :: Int -> StorageItem -> ShowS
Show, StorageItem -> StorageItem -> Bool
(StorageItem -> StorageItem -> Bool)
-> (StorageItem -> StorageItem -> Bool) -> Eq StorageItem
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
(SlotType -> SlotType -> Bool)
-> (SlotType -> SlotType -> Bool) -> Eq SlotType
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 -> String
show (StorageValue AbiType
t) = AbiType -> String
forall a. Show a => a -> String
show AbiType
t
 show (StorageMapping NonEmpty AbiType
s AbiType
t) =
   (AbiType -> ShowS) -> String -> NonEmpty AbiType -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
   (\AbiType
x String
y ->
       String
"mapping("
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AbiType -> String
forall a. Show a => a -> String
show AbiType
x
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" => "
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
y
       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")
   (AbiType -> String
forall a. Show a => a -> String
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
'(':String
s) =
    let (Text
lhs:[Text]
rhs) = Text -> Text -> [Text]
Text.splitOn Text
" => " (String -> Text
pack String
s)
        first :: AbiType
first = Maybe AbiType -> AbiType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AbiType -> AbiType) -> Maybe AbiType -> AbiType
forall a b. (a -> b) -> a -> b
$ Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty Text
lhs
        target :: AbiType
target = Maybe AbiType -> AbiType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AbiType -> AbiType) -> Maybe AbiType -> AbiType
forall a b. (a -> b) -> a -> b
$ Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty (Text -> Text -> Text -> Text
Text.replace Text
")" Text
"" ([Text] -> Text
forall a. [a] -> a
last [Text]
rhs))
        rest :: [AbiType]
rest = (Text -> AbiType) -> [Text] -> [AbiType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe AbiType -> AbiType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AbiType -> AbiType)
-> (Text -> Maybe AbiType) -> Text -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty (Text -> Maybe AbiType) -> (Text -> Text) -> Text -> Maybe AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text -> Text
Text.replace Text
"mapping(" Text
""))) (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
rhs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
rhs)
    in [(NonEmpty AbiType -> AbiType -> SlotType
StorageMapping (AbiType
first AbiType -> [AbiType] -> NonEmpty AbiType
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [AbiType]
rest) AbiType
target, String
"")]
  readsPrec Int
_ String
s = [(AbiType -> SlotType
StorageValue (AbiType -> SlotType) -> AbiType -> SlotType
forall a b. (a -> b) -> a -> b
$ AbiType -> Maybe AbiType -> AbiType
forall a. a -> Maybe a -> a
fromMaybe (String -> AbiType
forall a. HasCallStack => String -> a
error String
"could not parse storage item") (Vector AbiType -> Text -> Maybe AbiType
parseTypeName Vector AbiType
forall a. Monoid a => a
mempty (String -> Text
pack String
s)),String
"")]

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 -> String
(Int -> SolcContract -> ShowS)
-> (SolcContract -> String)
-> ([SolcContract] -> ShowS)
-> Show SolcContract
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolcContract] -> ShowS
$cshowList :: [SolcContract] -> ShowS
show :: SolcContract -> String
$cshow :: SolcContract -> String
showsPrec :: Int -> SolcContract -> ShowS
$cshowsPrec :: Int -> SolcContract -> ShowS
Show, SolcContract -> SolcContract -> Bool
(SolcContract -> SolcContract -> Bool)
-> (SolcContract -> SolcContract -> Bool) -> Eq SolcContract
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. SolcContract -> Rep SolcContract x)
-> (forall x. Rep SolcContract x -> SolcContract)
-> Generic SolcContract
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)]
_methodOutput :: [(Text, AbiType)]
  , Method -> [(Text, AbiType)]
_methodInputs :: [(Text, AbiType)]
  , Method -> Text
_methodName :: Text
  , Method -> Text
_methodSignature :: Text
  , Method -> Mutability
_methodMutability :: Mutability
  } deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show, Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
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
Eq Method
-> (Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord 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
$cp1Ord :: Eq Method
Ord, (forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
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 -> String
(Int -> Mutability -> ShowS)
-> (Mutability -> String)
-> ([Mutability] -> ShowS)
-> Show Mutability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mutability] -> ShowS
$cshowList :: [Mutability] -> ShowS
show :: Mutability -> String
$cshow :: Mutability -> String
showsPrec :: Int -> Mutability -> ShowS
$cshowsPrec :: Int -> Mutability -> ShowS
Show, Mutability -> Mutability -> Bool
(Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool) -> Eq Mutability
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
Eq Mutability
-> (Mutability -> Mutability -> Ordering)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Bool)
-> (Mutability -> Mutability -> Mutability)
-> (Mutability -> Mutability -> Mutability)
-> Ord 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
$cp1Ord :: Eq Mutability
Ord, (forall x. Mutability -> Rep Mutability x)
-> (forall x. Rep Mutability x -> Mutability) -> Generic Mutability
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)]
_sourceFiles  :: [(Text, ByteString)]
  , SourceCache -> [Vector ByteString]
_sourceLines  :: [(Vector ByteString)]
  , SourceCache -> Map Text Value
_sourceAsts   :: Map Text Value
  } deriving (Int -> SourceCache -> ShowS
[SourceCache] -> ShowS
SourceCache -> String
(Int -> SourceCache -> ShowS)
-> (SourceCache -> String)
-> ([SourceCache] -> ShowS)
-> Show SourceCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceCache] -> ShowS
$cshowList :: [SourceCache] -> ShowS
show :: SourceCache -> String
$cshow :: SourceCache -> String
showsPrec :: Int -> SourceCache -> ShowS
$cshowsPrec :: Int -> SourceCache -> ShowS
Show, SourceCache -> SourceCache -> Bool
(SourceCache -> SourceCache -> Bool)
-> (SourceCache -> SourceCache -> Bool) -> Eq SourceCache
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. SourceCache -> Rep SourceCache x)
-> (forall x. Rep SourceCache x -> SourceCache)
-> Generic SourceCache
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
_refStart :: Int,
    Reference -> Int
_refLength :: Int
  } deriving (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reference] -> ShowS
$cshowList :: [Reference] -> ShowS
show :: Reference -> String
$cshow :: Reference -> String
showsPrec :: Int -> Reference -> ShowS
$cshowsPrec :: Int -> Reference -> ShowS
Show, Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
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 Object
v) = Int -> Int -> Reference
Reference
    (Int -> Int -> Reference)
-> Parser Int -> Parser (Int -> Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"start"
    Parser (Int -> Reference) -> Parser Int -> Parser Reference
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"length"
  parseJSON Value
invalid =
    String -> Value -> Parser Reference
forall a. String -> Value -> Parser a
typeMismatch String
"Transaction" Value
invalid

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

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

data JumpType = JumpInto | JumpFrom | JumpRegular
  deriving (Int -> JumpType -> ShowS
[JumpType] -> ShowS
JumpType -> String
(Int -> JumpType -> ShowS)
-> (JumpType -> String) -> ([JumpType] -> ShowS) -> Show JumpType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JumpType] -> ShowS
$cshowList :: [JumpType] -> ShowS
show :: JumpType -> String
$cshow :: JumpType -> String
showsPrec :: Int -> JumpType -> ShowS
$cshowsPrec :: Int -> JumpType -> ShowS
Show, JumpType -> JumpType -> Bool
(JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool) -> Eq JumpType
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
Eq JumpType
-> (JumpType -> JumpType -> Ordering)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> JumpType)
-> (JumpType -> JumpType -> JumpType)
-> Ord 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
$cp1Ord :: Eq JumpType
Ord, (forall x. JumpType -> Rep JumpType x)
-> (forall x. Rep JumpType x -> JumpType) -> Generic JumpType
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 -> String
(Int -> SrcMap -> ShowS)
-> (SrcMap -> String) -> ([SrcMap] -> ShowS) -> Show SrcMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcMap] -> ShowS
$cshowList :: [SrcMap] -> ShowS
show :: SrcMap -> String
$cshow :: SrcMap -> String
showsPrec :: Int -> SrcMap -> ShowS
$cshowsPrec :: Int -> SrcMap -> ShowS
Show, SrcMap -> SrcMap -> Bool
(SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool) -> Eq SrcMap
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
Eq SrcMap
-> (SrcMap -> SrcMap -> Ordering)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> Bool)
-> (SrcMap -> SrcMap -> SrcMap)
-> (SrcMap -> SrcMap -> SrcMap)
-> Ord 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
$cp1Ord :: Eq SrcMap
Ord, (forall x. SrcMap -> Rep SrcMap x)
-> (forall x. Rep SrcMap x -> SrcMap) -> Generic SrcMap
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 -> String
(Int -> SrcMapParseState -> ShowS)
-> (SrcMapParseState -> String)
-> ([SrcMapParseState] -> ShowS)
-> Show SrcMapParseState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcMapParseState] -> ShowS
$cshowList :: [SrcMapParseState] -> ShowS
show :: SrcMapParseState -> String
$cshow :: SrcMapParseState -> String
showsPrec :: Int -> SrcMapParseState -> ShowS
$cshowsPrec :: Int -> SrcMapParseState -> ShowS
Show

data CodeType = Creation | Runtime
  deriving (Int -> CodeType -> ShowS
[CodeType] -> ShowS
CodeType -> String
(Int -> CodeType -> ShowS)
-> (CodeType -> String) -> ([CodeType] -> ShowS) -> Show CodeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeType] -> ShowS
$cshowList :: [CodeType] -> ShowS
show :: CodeType -> String
$cshow :: CodeType -> String
showsPrec :: Int -> CodeType -> ShowS
$cshowsPrec :: Int -> CodeType -> ShowS
Show, CodeType -> CodeType -> Bool
(CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool) -> Eq CodeType
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
Eq CodeType
-> (CodeType -> CodeType -> Ordering)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> Bool)
-> (CodeType -> CodeType -> CodeType)
-> (CodeType -> CodeType -> CodeType)
-> Ord 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
$cp1Ord :: Eq CodeType
Ord)

makeLenses ''SolcContract
makeLenses ''SourceCache
makeLenses ''Method

-- 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
_) -> Maybe (Seq SrcMap)
forall a. Maybe a
Nothing; (Seq SrcMap, SrcMapParseState, SrcMap)
x -> Seq SrcMap -> Maybe (Seq SrcMap)
forall a. a -> Maybe a
Just ((Seq SrcMap, SrcMapParseState, SrcMap) -> Seq SrcMap
done (Seq SrcMap, SrcMapParseState, SrcMap)
x))
             ((Seq SrcMap, SrcMapParseState, SrcMap) -> Maybe (Seq SrcMap))
-> (Text -> (Seq SrcMap, SrcMapParseState, SrcMap))
-> Text
-> Maybe (Seq SrcMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Seq SrcMap, SrcMapParseState, SrcMap)
 -> Char -> (Seq SrcMap, SrcMapParseState, SrcMap))
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> Text
-> (Seq SrcMap, SrcMapParseState, SrcMap)
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' ((Char
 -> (Seq SrcMap, SrcMapParseState, SrcMap)
 -> (Seq SrcMap, SrcMapParseState, SrcMap))
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char
-> (Seq SrcMap, SrcMapParseState, SrcMap)
-> (Seq SrcMap, SrcMapParseState, SrcMap)
go) (Seq SrcMap
forall a. Monoid a => a
mempty, String -> 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 :: String -> Int
readR = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
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 -> String -> Int -> SrcMapParseState
F2 Int
a [] Int
1, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F1 String
ds Int
k, SrcMap
p)                    = (Seq SrcMap
xs, Int -> String -> Int -> SrcMapParseState
F2 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* (String -> Int
readR String
ds)) [] Int
1, SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F1 [] Int
_, SrcMap
p)                    = (Seq SrcMap
xs, String -> Int -> SrcMapParseState
F1 [] (-Int
1), SrcMap
p)
    go Char
d   (Seq SrcMap
xs, F1 String
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d        = (Seq SrcMap
xs, String -> Int -> SrcMapParseState
F1 (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: String
ds) Int
k, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F1 [] Int
k, SrcMap
p)                    = (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p, String -> Int -> SrcMapParseState
F1 [] Int
k, SrcMap
p)
    go Char
';' (Seq SrcMap
xs, F1 String
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (String -> Int
readR String
ds)) Int
b Int
c JumpType
d Int
e in (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', String -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
'-' (Seq SrcMap
xs, F2 Int
a [] Int
_, SrcMap
p)                  = (Seq SrcMap
xs, Int -> String -> Int -> SrcMapParseState
F2 Int
a [] (-Int
1), SrcMap
p)
    go Char
d   (Seq SrcMap
xs, F2 Int
a String
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d      = (Seq SrcMap
xs, Int -> String -> Int -> SrcMapParseState
F2 Int
a (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: String
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 -> String -> Int -> SrcMapParseState
F3 Int
a Int
b [] Int
1, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F2 Int
a String
ds Int
k, SrcMap
p)                  = (Seq SrcMap
xs, Int -> Int -> String -> Int -> SrcMapParseState
F3 Int
a (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* (String -> Int
readR String
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 Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', String -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F2 Int
a String
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (String -> Int
readR String
ds)) Int
c JumpType
d Int
e in
                                                 (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', String -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

    go Char
d   (Seq SrcMap
xs, F3 Int
a Int
b String
ds Int
k, SrcMap
p) | Char -> Bool
isDigit Char
d    = (Seq SrcMap
xs, Int -> Int -> String -> Int -> SrcMapParseState
F3 Int
a Int
b (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: String
ds) Int
k, SrcMap
p)
    go Char
'-' (Seq SrcMap
xs, F3 Int
a Int
b [] Int
_, SrcMap
p)                = (Seq SrcMap
xs, Int -> Int -> String -> 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 Maybe JumpType
forall a. Maybe a
Nothing, SrcMap
p)
    go Char
':' (Seq SrcMap
xs, F3 Int
a Int
b String
ds Int
k, SrcMap
p)                = (Seq SrcMap
xs, Int -> Int -> Int -> Maybe JumpType -> SrcMapParseState
F4 Int
a Int
b (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* (String -> Int
readR String
ds)) Maybe JumpType
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 Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', String -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')
    go Char
';' (Seq SrcMap
xs, F3 Int
a Int
b String
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (String -> Int
readR String
ds)) JumpType
d Int
e in
                                                 (Seq SrcMap
xs Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', String -> 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 (JumpType -> Maybe JumpType
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 (JumpType -> Maybe JumpType
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 (JumpType -> Maybe JumpType
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 -> String -> 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 -> String -> 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 Seq SrcMap -> SrcMap -> Seq SrcMap
forall s a. Snoc s s a a => s -> a -> s
|> SrcMap
p', String -> Int -> SrcMapParseState
F1 [] Int
1, SrcMap
p')

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

    go Char
c (Seq SrcMap
xs, SrcMapParseState
state, SrcMap
p)                      = (Seq SrcMap
xs, String -> SrcMapParseState
forall a. HasCallStack => String -> a
error (String
"srcmap: y u " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in state" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcMapParseState -> String
forall a. Show a => a -> String
show SrcMapParseState
state String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?!?"), 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) = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
      f (Text
fp, Maybe ByteString
Nothing) = String -> IO ByteString
BS.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
fp
  [ByteString]
xs <- ((Text, Maybe ByteString) -> IO ByteString)
-> [(Text, Maybe ByteString)] -> IO [ByteString]
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
  SourceCache -> IO SourceCache
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceCache -> IO SourceCache) -> SourceCache -> IO SourceCache
forall a b. (a -> b) -> a -> b
$! SourceCache :: [(Text, ByteString)]
-> [Vector ByteString] -> Map Text Value -> SourceCache
SourceCache
    { _sourceFiles :: [(Text, ByteString)]
_sourceFiles = [Text] -> [ByteString] -> [(Text, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Text, Maybe ByteString) -> Text
forall a b. (a, b) -> a
fst ((Text, Maybe ByteString) -> Text)
-> [(Text, Maybe ByteString)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe ByteString)]
paths) [ByteString]
xs
    , _sourceLines :: [Vector ByteString]
_sourceLines = (ByteString -> Vector ByteString)
-> [ByteString] -> [Vector ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ([ByteString] -> Vector ByteString
forall a. [a] -> Vector a
Vector.fromList ([ByteString] -> Vector ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> Vector ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
BS.split Word8
0xa) [ByteString]
xs
    , _sourceAsts :: Map Text Value
_sourceAsts  = 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 = (ByteString -> Int) -> Vector ByteString -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (\ByteString
x -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
x) Vector ByteString
xs
    s2 :: Int
s2  = Vector Int -> Int
forall a. Num a => Vector a -> a
Vector.sum (Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
i Vector Int
ks)
    n2 :: Int
n2  = Vector Int
ks Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
i
  in
    if Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s2 Bool -> Bool -> Bool
|| Int
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2
    then Maybe (Int, Int)
forall a. Maybe a
Nothing
    else (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s1) Int
n1)

readSolc :: FilePath -> IO (Maybe (Map Text SolcContract, SourceCache))
readSolc :: String -> IO (Maybe (Map Text SolcContract, SourceCache))
readSolc String
fp =
  (Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON (Text
 -> Maybe
      (Map Text SolcContract, Map Text Value,
       [(Text, Maybe ByteString)]))
-> IO Text
-> IO
     (Maybe
        (Map Text SolcContract, Map Text Value,
         [(Text, Maybe ByteString)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
readFile String
fp) IO
  (Maybe
     (Map Text SolcContract, Map Text Value,
      [(Text, Maybe ByteString)]))
-> (Maybe
      (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
    -> IO (Maybe (Map Text SolcContract, SourceCache)))
-> IO (Maybe (Map Text SolcContract, SourceCache))
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 -> Maybe (Map Text SolcContract, SourceCache)
-> IO (Maybe (Map Text SolcContract, SourceCache))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map Text SolcContract, SourceCache)
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
        Maybe (Map Text SolcContract, SourceCache)
-> IO (Maybe (Map Text SolcContract, SourceCache))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Map Text SolcContract, SourceCache)
 -> IO (Maybe (Map Text SolcContract, SourceCache)))
-> Maybe (Map Text SolcContract, SourceCache)
-> IO (Maybe (Map Text SolcContract, SourceCache))
forall a b. (a -> b) -> a -> b
$! (Map Text SolcContract, SourceCache)
-> Maybe (Map Text SolcContract, SourceCache)
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 (Just Value
f) = Text
json Text -> Getting (Endo Value) Text Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"contracts" Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
path
      (Just Value
c) = Value
f Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key (if Text -> Bool
Text.null Text
contract then Text
"object" else Text
contract)
      bytecode :: Text
bytecode = Value
c Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"evm" Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"bytecode" Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"object" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
  Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
toCode (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
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 (Just Value
f) = Text
json Text -> Getting (Endo Value) Text Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"contracts" Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
path
      (Just Value
c) = Value
f Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key (if Text -> Bool
Text.null Text
contract then Text
"object" else Text
contract)
      bytecode :: Text
bytecode = Value
c Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"evm" Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"deployedBytecode" Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"object" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
  Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
toCode (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
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 Just (Map Text SolcContract
sol, Map Text Value
_, [(Text, Maybe ByteString)]
_) = Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text SolcContract
sol Map Text SolcContract
-> Getting (First ByteString) (Map Text SolcContract) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contract) ((SolcContract -> Const (First ByteString) SolcContract)
 -> Map Text SolcContract
 -> Const (First ByteString) (Map Text SolcContract))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> SolcContract -> Const (First ByteString) SolcContract)
-> Getting (First ByteString) (Map Text SolcContract) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> SolcContract -> Const (First ByteString) SolcContract
Lens' SolcContract ByteString
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 Just (Map Text SolcContract
sol, Map Text Value
_, [(Text, Maybe ByteString)]
_) = Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text SolcContract
sol Map Text SolcContract
-> Getting (First ByteString) (Map Text SolcContract) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contract) ((SolcContract -> Const (First ByteString) SolcContract)
 -> Map Text SolcContract
 -> Const (First ByteString) (Map Text SolcContract))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> SolcContract -> Const (First ByteString) SolcContract)
-> Getting (First ByteString) (Map Text SolcContract) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> SolcContract -> Const (First ByteString) SolcContract
Lens' SolcContract ByteString
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" public {}}")
  let Just (Map Text SolcContract
sol, Map Text Value
_, [(Text, Maybe ByteString)]
_) = Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  case Map Word32 Method -> [(Word32, Method)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Word32 Method -> [(Word32, Method)])
-> Map Word32 Method -> [(Word32, Method)]
forall a b. (a -> b) -> a -> b
$ Map Text SolcContract
sol Map Text SolcContract
-> Getting
     (Endo (Map Word32 Method))
     (Map Text SolcContract)
     (Map Word32 Method)
-> Map Word32 Method
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":ABI") ((SolcContract -> Const (Endo (Map Word32 Method)) SolcContract)
 -> Map Text SolcContract
 -> Const (Endo (Map Word32 Method)) (Map Text SolcContract))
-> ((Map Word32 Method
     -> Const (Endo (Map Word32 Method)) (Map Word32 Method))
    -> SolcContract -> Const (Endo (Map Word32 Method)) SolcContract)
-> Getting
     (Endo (Map Word32 Method))
     (Map Text SolcContract)
     (Map Word32 Method)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Word32 Method
 -> Const (Endo (Map Word32 Method)) (Map Word32 Method))
-> SolcContract -> Const (Endo (Map Word32 Method)) SolcContract
Lens' SolcContract (Map Word32 Method)
abiMap of
     [(Word32
_,Method
b)] -> Method -> IO Method
forall (m :: * -> *) a. Monad m => a -> m a
return Method
b
     [(Word32, Method)]
_ -> String -> IO Method
forall a. HasCallStack => String -> a
error String
"hevm internal error: unexpected abi format"

force :: String -> Maybe a -> a
force :: String -> Maybe a -> a
force String
s = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
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 Text -> Getting (First Value) Text Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"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 <- Object -> Map Text SolcContract
forall s. AsValue s => HashMap Text s -> Map Text SolcContract
f (Object -> Map Text SolcContract)
-> Maybe Object -> Maybe (Map Text SolcContract)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
json Text -> Getting (First Object) Text Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"contracts" ((Value -> Const (First Object) Value)
 -> Text -> Const (First Object) Text)
-> ((Object -> Const (First Object) Object)
    -> Value -> Const (First Object) Value)
-> Getting (First Object) Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Const (First Object) Object)
-> Value -> Const (First Object) Value
forall t. AsValue t => Prism' t Object
_Object)
  [Text]
sources <- Vector Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Text -> [Text])
-> (Vector Value -> Vector Text) -> Vector Value -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Text) -> Vector Value -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting Text Value Text -> Value -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Value Text
forall t. AsPrimitive t => Prism' t Text
_String) (Vector Value -> [Text]) -> Maybe (Vector Value) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json Text
-> Getting (First (Vector Value)) Text (Vector Value)
-> Maybe (Vector Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"sourceList" ((Value -> Const (First (Vector Value)) Value)
 -> Text -> Const (First (Vector Value)) Text)
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> Getting (First (Vector Value)) Text (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value -> Const (First (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array
  (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text SolcContract
contracts, [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
asts), [ (Text
x, Maybe ByteString
forall a. Maybe a
Nothing) | Text
x <- [Text]
sources])
  where
    asts :: Object
asts = Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe (String -> Object
forall a. HasCallStack => String -> a
error String
"JSON lacks abstract syntax trees.") (Text
json Text -> Getting (First Object) Text Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"sources" ((Value -> Const (First Object) Value)
 -> Text -> Const (First Object) Text)
-> ((Object -> Const (First Object) Object)
    -> Value -> Const (First Object) Value)
-> Getting (First Object) Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Const (First Object) Object)
-> Value -> Const (First Object) Value
forall t. AsValue t => Prism' t Object
_Object)
    f :: HashMap Text s -> Map Text SolcContract
f HashMap Text s
x = [(Text, SolcContract)] -> Map Text SolcContract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, SolcContract)] -> Map Text SolcContract)
-> (HashMap Text SolcContract -> [(Text, SolcContract)])
-> HashMap Text SolcContract
-> Map Text SolcContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text SolcContract -> [(Text, SolcContract)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap Text SolcContract -> Map Text SolcContract)
-> HashMap Text SolcContract -> Map Text SolcContract
forall a b. (a -> b) -> a -> b
$ (Text -> s -> SolcContract)
-> HashMap Text s -> HashMap Text SolcContract
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMap.mapWithKey Text -> s -> SolcContract
forall s. AsValue s => Text -> s -> SolcContract
g HashMap Text s
x
    g :: Text -> s -> SolcContract
g Text
s s
x =
      let
        theRuntimeCode :: ByteString
theRuntimeCode = Text -> ByteString
toCode (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"bin-runtime" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)
        theCreationCode :: ByteString
theCreationCode = Text -> ByteString
toCode (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"bin" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)
        abis :: [Value]
abis = Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ case (s
x s -> Getting (Endo Value) s Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"abi") Value
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> Maybe (Vector Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value -> Const (First (Vector Value)) Value
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 s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"abi" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Text
-> Getting (Endo (Vector Value)) Text (Vector Value)
-> Vector Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo (Vector Value)) Text (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array -- solc <  0.8
      in SolcContract :: W256
-> W256
-> ByteString
-> ByteString
-> Text
-> [(Text, AbiType)]
-> Map Word32 Method
-> Map W256 Event
-> Map W256 SolError
-> Map W256 [Reference]
-> Maybe (Map Text StorageItem)
-> Seq SrcMap
-> Seq SrcMap
-> SolcContract
SolcContract {
        _runtimeCode :: ByteString
_runtimeCode      = ByteString
theRuntimeCode,
        _creationCode :: ByteString
_creationCode     = ByteString
theCreationCode,
        _runtimeCodehash :: W256
_runtimeCodehash  = ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        _creationCodehash :: W256
_creationCodehash = ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        _runtimeSrcmap :: Seq SrcMap
_runtimeSrcmap    = String -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. String -> Maybe a -> a
force String
"internal error: srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"srcmap-runtime" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)),
        _creationSrcmap :: Seq SrcMap
_creationSrcmap   = String -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. String -> Maybe a -> a
force String
"internal error: srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"srcmap" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)),
        _contractName :: Text
_contractName = Text
s,
        _constructorInputs :: [(Text, AbiType)]
_constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        _abiMap :: Map Word32 Method
_abiMap       = [Value] -> Map Word32 Method
mkAbiMap [Value]
abis,
        _eventMap :: Map W256 Event
_eventMap     = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        _errorMap :: Map W256 SolError
_errorMap     = [Value] -> Map W256 SolError
mkErrorMap [Value]
abis,
        _storageLayout :: Maybe (Map Text StorageItem)
_storageLayout = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout (Maybe Value -> Maybe (Map Text StorageItem))
-> Maybe Value -> Maybe (Map Text StorageItem)
forall a b. (a -> b) -> a -> b
$ s
x s -> Getting (First Value) s Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"storage-layout",
        _immutableReferences :: Map W256 [Reference]
_immutableReferences = Map W256 [Reference]
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
  Object
contracts <- Text
json Text -> Getting (First Object) Text Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"contracts" ((Value -> Const (First Object) Value)
 -> Text -> Const (First Object) Text)
-> ((Object -> Const (First Object) Object)
    -> Value -> Const (First Object) Value)
-> Getting (First Object) Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Object -> Const (First Object) Object)
-> Value -> Const (First Object) Value
forall t. AsValue t => Prism' t Object
_Object
  -- TODO: support the general case of "urls" and "content" in the standard json
  Object
sources <- Text
json Text -> Getting (First Object) Text Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"sources" ((Value -> Const (First Object) Value)
 -> Text -> Const (First Object) Text)
-> ((Object -> Const (First Object) Object)
    -> Value -> Const (First Object) Value)
-> Getting (First Object) Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Const (First Object) Object)
-> Value -> Const (First Object) Value
forall t. AsValue t => Prism' t Object
_Object
  let asts :: Object
asts = String -> Maybe Value -> Value
forall a. String -> Maybe a -> a
force String
"JSON lacks abstract syntax trees." (Maybe Value -> Value) -> (Value -> Maybe Value) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"ast") (Value -> Value) -> Object -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
sources
      contractMap :: Map Text (SolcContract, HashMap Text Text)
contractMap = Object -> Map Text (SolcContract, HashMap Text Text)
forall s.
AsValue s =>
HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f Object
contracts
      contents :: Text -> (Text, Maybe ByteString)
contents Text
src = (Text
src, Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
src ([HashMap Text Text] -> HashMap Text Text
forall a. Monoid a => [a] -> a
mconcat ([HashMap Text Text] -> HashMap Text Text)
-> [HashMap Text Text] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ Map Text (HashMap Text Text) -> [HashMap Text Text]
forall k a. Map k a -> [a]
Map.elems (Map Text (HashMap Text Text) -> [HashMap Text Text])
-> Map Text (HashMap Text Text) -> [HashMap Text Text]
forall a b. (a -> b) -> a -> b
$ (SolcContract, HashMap Text Text) -> HashMap Text Text
forall a b. (a, b) -> b
snd ((SolcContract, HashMap Text Text) -> HashMap Text Text)
-> Map Text (SolcContract, HashMap Text Text)
-> Map Text (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap))
  (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((SolcContract, HashMap Text Text) -> SolcContract
forall a b. (a, b) -> a
fst ((SolcContract, HashMap Text Text) -> SolcContract)
-> Map Text (SolcContract, HashMap Text Text)
-> Map Text SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap, [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
asts), Text -> (Text, Maybe ByteString)
contents (Text -> (Text, Maybe ByteString))
-> [Text] -> [(Text, Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Object -> [Text]
forall k v. HashMap k v -> [k]
HMap.keys Object
sources))
  where
    f :: (AsValue s) => HMap.HashMap Text s -> (Map Text (SolcContract, (HMap.HashMap Text Text)))
    f :: HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f HashMap Text s
x = [(Text, (SolcContract, HashMap Text Text))]
-> Map Text (SolcContract, HashMap Text Text)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, (SolcContract, HashMap Text Text))]
 -> Map Text (SolcContract, HashMap Text Text))
-> (HashMap Text s -> [(Text, (SolcContract, HashMap Text Text))])
-> HashMap Text s
-> Map Text (SolcContract, HashMap Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, s) -> [(Text, (SolcContract, HashMap Text Text))])
-> [(Text, s)] -> [(Text, (SolcContract, HashMap Text Text))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
forall s.
AsValue s =>
(Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
g) ([(Text, s)] -> [(Text, (SolcContract, HashMap Text Text))])
-> (HashMap Text s -> [(Text, s)])
-> HashMap Text s
-> [(Text, (SolcContract, HashMap Text Text))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text s -> [(Text, s)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap Text s -> Map Text (SolcContract, HashMap Text Text))
-> HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
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 ((Text, Value) -> (Text, (SolcContract, HashMap Text Text)))
-> [(Text, Value)] -> [(Text, (SolcContract, HashMap Text Text))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (Getting Object s Object -> s -> Object
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Object s Object
forall t. AsValue t => Prism' t Object
_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 Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"evm"
        runtime :: Value
runtime = Value
evmstuff Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"deployedBytecode"
        creation :: Value
creation =  Value
evmstuff Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"bytecode"
        theRuntimeCode :: ByteString
theRuntimeCode = Text -> ByteString
toCode (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value
runtime Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"object" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
        theCreationCode :: ByteString
theCreationCode = Text -> ByteString
toCode (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Value
creation Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"object" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
        srcContents :: Maybe (HMap.HashMap Text Text)
        srcContents :: Maybe (HashMap Text Text)
srcContents = do Text
metadata <- Value
x Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"metadata" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
                         Object
srcs <- Text
metadata Text -> Getting (First Object) Text Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"sources" ((Value -> Const (First Object) Value)
 -> Text -> Const (First Object) Text)
-> ((Object -> Const (First Object) Object)
    -> Value -> Const (First Object) Value)
-> Getting (First Object) Text Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Const (First Object) Object)
-> Value -> Const (First Object) Value
forall t. AsValue t => Prism' t Object
_Object
                         HashMap Text Text -> Maybe (HashMap Text Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap Text Text -> Maybe (HashMap Text Text))
-> HashMap Text Text -> Maybe (HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ (Getting Text Value Text -> Value -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"content" ((Value -> Const Text Value) -> Value -> Const Text Value)
-> Getting Text Value Text -> Getting Text Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text Value Text
forall t. AsPrimitive t => Prism' t Text
_String)) (Value -> Text) -> Object -> HashMap Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value -> Bool) -> Object -> Object
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HMap.filter (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> (Value -> Maybe Value) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"content")) Object
srcs)
        abis :: [Value]
abis = String -> Maybe [Value] -> [Value]
forall a. String -> Maybe a -> a
force (String
"abi key not found in " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
x) (Maybe [Value] -> [Value]) -> Maybe [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$
          Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Maybe (Vector Value) -> Maybe [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
x Value
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> Maybe (Vector Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"abi" ((Value -> Const (First (Vector Value)) Value)
 -> Value -> Const (First (Vector Value)) Value)
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value
-> Const (First (Vector Value)) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value -> Const (First (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array
      in (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c, (SolcContract :: W256
-> W256
-> ByteString
-> ByteString
-> Text
-> [(Text, AbiType)]
-> Map Word32 Method
-> Map W256 Event
-> Map W256 SolError
-> Map W256 [Reference]
-> Maybe (Map Text StorageItem)
-> Seq SrcMap
-> Seq SrcMap
-> SolcContract
SolcContract {
        _runtimeCode :: ByteString
_runtimeCode      = ByteString
theRuntimeCode,
        _creationCode :: ByteString
_creationCode     = ByteString
theCreationCode,
        _runtimeCodehash :: W256
_runtimeCodehash  = ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        _creationCodehash :: W256
_creationCodehash = ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        _runtimeSrcmap :: Seq SrcMap
_runtimeSrcmap    = String -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. String -> Maybe a -> a
force String
"internal error: srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
runtime Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"sourceMap" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)),
        _creationSrcmap :: Seq SrcMap
_creationSrcmap   = String -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. String -> Maybe a -> a
force String
"internal error: srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
creation Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"sourceMap" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)),
        _contractName :: Text
_contractName = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c,
        _constructorInputs :: [(Text, AbiType)]
_constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        _abiMap :: Map Word32 Method
_abiMap        = [Value] -> Map Word32 Method
mkAbiMap [Value]
abis,
        _eventMap :: Map W256 Event
_eventMap      = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        _errorMap :: Map W256 SolError
_errorMap      = [Value] -> Map W256 SolError
mkErrorMap [Value]
abis,
        _storageLayout :: Maybe (Map Text StorageItem)
_storageLayout = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout (Maybe Value -> Maybe (Map Text StorageItem))
-> Maybe Value -> Maybe (Map Text StorageItem)
forall a b. (a -> b) -> a -> b
$ Value
x Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"storageLayout",
        _immutableReferences :: Map W256 [Reference]
_immutableReferences = Map W256 [Reference]
-> Maybe (Map W256 [Reference]) -> Map W256 [Reference]
forall a. a -> Maybe a -> a
fromMaybe Map W256 [Reference]
forall a. Monoid a => a
mempty (Maybe (Map W256 [Reference]) -> Map W256 [Reference])
-> Maybe (Map W256 [Reference]) -> Map W256 [Reference]
forall a b. (a -> b) -> a -> b
$
          do Value
x' <- Value
runtime Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"immutableReferences"
             case Value -> Result (Map W256 [Reference])
forall a. FromJSON a => Value -> Result a
fromJSON Value
x' of
               Success Map W256 [Reference]
a -> Map W256 [Reference] -> Maybe (Map W256 [Reference])
forall (m :: * -> *) a. Monad m => a -> m a
return Map W256 [Reference]
a
               Result (Map W256 [Reference])
_ -> Maybe (Map W256 [Reference])
forall a. Maybe a
Nothing
      }, HashMap Text Text -> Maybe (HashMap Text Text) -> HashMap Text Text
forall a. a -> Maybe a -> a
fromMaybe HashMap Text Text
forall a. Monoid a => a
mempty Maybe (HashMap Text Text)
srcContents))

mkAbiMap :: [Value] -> Map Word32 Method
mkAbiMap :: [Value] -> Map Word32 Method
mkAbiMap [Value]
abis = [(Word32, Method)] -> Map Word32 Method
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word32, Method)] -> Map Word32 Method)
-> [(Word32, Method)] -> Map Word32 Method
forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"function" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"type" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) [Value]
abis
    f :: s -> (Word32, Method)
f s
abi =
      (ByteString -> Word32
abiKeccak (Text -> ByteString
encodeUtf8 (s -> Text
forall s. AsValue s => s -> Text
signature s
abi)),
       Method :: [(Text, AbiType)]
-> [(Text, AbiType)] -> Text -> Text -> Mutability -> Method
Method { _methodName :: Text
_methodName = s
abi s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
              , _methodSignature :: Text
_methodSignature = s -> Text
forall s. AsValue s => s -> Text
signature s
abi
              , _methodInputs :: [(Text, AbiType)]
_methodInputs = (Value -> (Text, AbiType)) -> [Value] -> [(Text, AbiType)]
forall a b. (a -> b) -> [a] -> [b]
map Value -> (Text, AbiType)
forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi s -> Getting (Endo (Vector Value)) s (Vector Value) -> Vector Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"inputs" ((Value -> Const (Endo (Vector Value)) Value)
 -> s -> Const (Endo (Vector Value)) s)
-> ((Vector Value -> Const (Endo (Vector Value)) (Vector Value))
    -> Value -> Const (Endo (Vector Value)) Value)
-> Getting (Endo (Vector Value)) s (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo (Vector Value)) (Vector Value))
-> Value -> Const (Endo (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , _methodOutput :: [(Text, AbiType)]
_methodOutput = (Value -> (Text, AbiType)) -> [Value] -> [(Text, AbiType)]
forall a b. (a -> b) -> [a] -> [b]
map Value -> (Text, AbiType)
forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi s -> Getting (Endo (Vector Value)) s (Vector Value) -> Vector Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"outputs" ((Value -> Const (Endo (Vector Value)) Value)
 -> s -> Const (Endo (Vector Value)) s)
-> ((Vector Value -> Const (Endo (Vector Value)) (Vector Value))
    -> Value -> Const (Endo (Vector Value)) Value)
-> Getting (Endo (Vector Value)) s (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo (Vector Value)) (Vector Value))
-> Value -> Const (Endo (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , _methodMutability :: Mutability
_methodMutability = Text -> Mutability
parseMutability
                 (s
abi s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"stateMutability" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)
              })
  in Value -> (Word32, Method)
forall s. AsValue s => s -> (Word32, Method)
f (Value -> (Word32, Method)) -> [Value] -> [(Word32, Method)]
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 = [(W256, Event)] -> Map W256 Event
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(W256, Event)] -> Map W256 Event)
-> [(W256, Event)] -> Map W256 Event
forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"event" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"type" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) [Value]
abis
    f :: s -> (W256, Event)
f s
abi =
     ( ByteString -> W256
keccak (Text -> ByteString
encodeUtf8 (s -> Text
forall s. AsValue s => s -> Text
signature s
abi))
     , Text -> Anonymity -> [(Text, AbiType, Indexed)] -> Event
Event
       (s
abi s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)
       (case s
abi s -> Getting (Endo Bool) s Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"anonymous" ((Value -> Const (Endo Bool) Value) -> s -> Const (Endo Bool) s)
-> ((Bool -> Const (Endo Bool) Bool)
    -> Value -> Const (Endo Bool) Value)
-> Getting (Endo Bool) s Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (Endo Bool) Bool)
-> Value -> Const (Endo Bool) Value
forall t. AsPrimitive t => Prism' t Bool
_Bool of
         Bool
True -> Anonymity
Anonymous
         Bool
False -> Anonymity
NotAnonymous)
       ((Value -> (Text, AbiType, Indexed))
-> [Value] -> [(Text, AbiType, Indexed)]
forall a b. (a -> b) -> [a] -> [b]
map (\Value
y ->
        ( Value
y Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
        , String -> Maybe AbiType -> AbiType
forall a. String -> Maybe a -> a
force String
"internal error: type" (Value -> Maybe AbiType
forall s. AsValue s => s -> Maybe AbiType
parseTypeName' Value
y)
        , if Value
y Value
-> ((Bool -> Const (Endo Bool) Bool)
    -> Value -> Const (Endo Bool) Value)
-> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"indexed" ((Value -> Const (Endo Bool) Value)
 -> Value -> Const (Endo Bool) Value)
-> ((Bool -> Const (Endo Bool) Bool)
    -> Value -> Const (Endo Bool) Value)
-> (Bool -> Const (Endo Bool) Bool)
-> Value
-> Const (Endo Bool) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (Endo Bool) Bool)
-> Value -> Const (Endo Bool) Value
forall t. AsPrimitive t => Prism' t Bool
_Bool
          then Indexed
Indexed
          else Indexed
NotIndexed
        ))
       (Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ s
abi s -> Getting (Endo (Vector Value)) s (Vector Value) -> Vector Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"inputs" ((Value -> Const (Endo (Vector Value)) Value)
 -> s -> Const (Endo (Vector Value)) s)
-> ((Vector Value -> Const (Endo (Vector Value)) (Vector Value))
    -> Value -> Const (Endo (Vector Value)) Value)
-> Getting (Endo (Vector Value)) s (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo (Vector Value)) (Vector Value))
-> Value -> Const (Endo (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array))
     )
  in Value -> (W256, Event)
forall s. AsValue s => s -> (W256, Event)
f (Value -> (W256, Event)) -> [Value] -> [(W256, Event)]
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 = [(W256, SolError)] -> Map W256 SolError
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(W256, SolError)] -> Map W256 SolError)
-> [(W256, SolError)] -> Map W256 SolError
forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"error" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"type" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) [Value]
abis
    f :: s -> (W256, SolError)
f s
abi =
     ( W256 -> W256
stripKeccak (W256 -> W256) -> W256 -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
keccak (Text -> ByteString
encodeUtf8 (s -> Text
forall s. AsValue s => s -> Text
signature s
abi))
     , Text -> [AbiType] -> SolError
SolError
       (s
abi s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)
       ((Value -> AbiType) -> [Value] -> [AbiType]
forall a b. (a -> b) -> [a] -> [b]
map (\Value
y -> ( String -> Maybe AbiType -> AbiType
forall a. String -> Maybe a -> a
force String
"internal error: type" (Value -> Maybe AbiType
forall s. AsValue s => s -> Maybe AbiType
parseTypeName' Value
y)))
       (Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ s
abi s -> Getting (Endo (Vector Value)) s (Vector Value) -> Vector Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"inputs" ((Value -> Const (Endo (Vector Value)) Value)
 -> s -> Const (Endo (Vector Value)) s)
-> ((Vector Value -> Const (Endo (Vector Value)) (Vector Value))
    -> Value -> Const (Endo (Vector Value)) Value)
-> Getting (Endo (Vector Value)) s (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo (Vector Value)) (Vector Value))
-> Value -> Const (Endo (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array))
     )
  in Value -> (W256, SolError)
forall s. AsValue s => s -> (W256, SolError)
f (Value -> (W256, SolError)) -> [Value] -> [(W256, SolError)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant
  where
    stripKeccak :: W256 -> W256
    stripKeccak :: W256 -> W256
stripKeccak = String -> W256
forall a. Read a => String -> a
read (String -> W256) -> (W256 -> String) -> W256 -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
10 ShowS -> (W256 -> String) -> W256 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W256 -> String
forall a. Show a => a -> String
show

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

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

signature :: AsValue s => s -> Text
signature :: s -> Text
signature s
abi =
  case s
abi s -> Getting (Endo Value) s Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"type" of
    Value
"fallback" -> Text
"<fallback>"
    Value
_ ->
      [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [
        Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"<constructor>" (s
abi s -> Getting (First Text) s Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (First Text) Value) -> s -> Const (First Text) s)
-> Getting (First Text) Value Text -> Getting (First Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String), Text
"(",
        Text -> [Text] -> Text
intercalate Text
","
          ((Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Value
x -> Value
x Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"type" ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)
            (Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Value -> [Value]) -> Vector Value -> [Value]
forall a b. (a -> b) -> a -> b
$ s
abi s -> Getting (Endo (Vector Value)) s (Vector Value) -> Vector Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"inputs" ((Value -> Const (Endo (Vector Value)) Value)
 -> s -> Const (Endo (Vector Value)) s)
-> ((Vector Value -> Const (Endo (Vector Value)) (Vector Value))
    -> Value -> Const (Endo (Vector Value)) Value)
-> Getting (Endo (Vector Value)) s (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo (Vector Value)) (Vector Value))
-> Value -> Const (Endo (Vector Value)) Value
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' :: s -> Maybe AbiType
parseTypeName' s
x =
  Vector AbiType -> Text -> Maybe AbiType
parseTypeName
    (Vector AbiType -> Maybe (Vector AbiType) -> Vector AbiType
forall a. a -> Maybe a -> a
fromMaybe Vector AbiType
forall a. Monoid a => a
mempty (Maybe (Vector AbiType) -> Vector AbiType)
-> Maybe (Vector AbiType) -> Vector AbiType
forall a b. (a -> b) -> a -> b
$ s
x s
-> Getting (First (Vector AbiType)) s (Vector AbiType)
-> Maybe (Vector AbiType)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"components" ((Value -> Const (First (Vector AbiType)) Value)
 -> s -> Const (First (Vector AbiType)) s)
-> ((Vector AbiType
     -> Const (First (Vector AbiType)) (Vector AbiType))
    -> Value -> Const (First (Vector AbiType)) Value)
-> Getting (First (Vector AbiType)) s (Vector AbiType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First (Vector AbiType)) (Vector Value))
-> Value -> Const (First (Vector AbiType)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array ((Vector Value -> Const (First (Vector AbiType)) (Vector Value))
 -> Value -> Const (First (Vector AbiType)) Value)
-> ((Vector AbiType
     -> Const (First (Vector AbiType)) (Vector AbiType))
    -> Vector Value -> Const (First (Vector AbiType)) (Vector Value))
-> (Vector AbiType
    -> Const (First (Vector AbiType)) (Vector AbiType))
-> Value
-> Const (First (Vector AbiType)) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Vector AbiType)
-> (Vector AbiType
    -> Const (First (Vector AbiType)) (Vector AbiType))
-> Vector Value
-> Const (First (Vector AbiType)) (Vector Value)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Vector Value -> Vector AbiType
parseComponents)
    (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"type" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String)
  where parseComponents :: Vector Value -> Vector AbiType
parseComponents = (Value -> AbiType) -> Vector Value -> Vector AbiType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value -> AbiType) -> Vector Value -> Vector AbiType)
-> (Value -> AbiType) -> Vector Value -> Vector AbiType
forall a b. (a -> b) -> a -> b
$ (Text, AbiType) -> AbiType
forall a b. (a, b) -> b
snd ((Text, AbiType) -> AbiType)
-> (Value -> (Text, AbiType)) -> Value -> AbiType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> (Text, AbiType)
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
_ = String -> Mutability
forall a. HasCallStack => String -> a
error String
"unknown function mutability"

-- This actually can also parse a method output! :O
parseMethodInput :: AsValue s => s -> (Text, AbiType)
parseMethodInput :: s -> (Text, AbiType)
parseMethodInput s
x =
  ( s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
  , String -> Maybe AbiType -> AbiType
forall a. String -> Maybe a -> a
force String
"internal error: method type" (s -> Maybe AbiType
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 String ByteString
BS16.decode (Text -> ByteString
encodeUtf8 Text
t) of
  Right ByteString
d -> ByteString
d
  Left String
e -> if Text -> Bool
containsLinkerHole Text
t
            then String -> ByteString
forall a. HasCallStack => String -> a
error String
"unlinked libraries detected in bytecode"
            else String -> ByteString
forall a. HasCallStack => String -> a
error String
e

solidity' :: Text -> IO (Text, Text)
solidity' :: Text -> IO (Text, Text)
solidity' Text
src = String -> (String -> Handle -> IO (Text, Text)) -> IO (Text, Text)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"hevm.sol" ((String -> Handle -> IO (Text, Text)) -> IO (Text, Text))
-> (String -> Handle -> IO (Text, Text)) -> IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ \String
path Handle
handle -> do
  Handle -> IO ()
hClose Handle
handle
  String -> Text -> IO ()
writeFile String
path (Text
"//SPDX-License-Identifier: UNLICENSED\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"pragma solidity ^0.8.6;\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src)
  String -> Text -> IO ()
writeFile (String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".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 <- String -> Text
pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    String -> [String] -> String -> IO String
readProcess
      String
"solc"
      [String
"--allow-paths", String
path, String
"--standard-json", (String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".json")]
      String
""
  (Text, Text) -> IO (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, String -> Text
pack String
path)

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

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

data Language = Solidity | Yul
  deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
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) =
    [(Text, Value)] -> Value
object [ Text
"language" Text -> String -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Language -> String
forall a. Show a => a -> String
show Language
lang
           , Text
"sources" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [(Text, Value)] -> Value
object [Text
"hevm.sol" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
                                   [(Text, Value)] -> Value
object [Text
"content" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
src]]
           , Text
"settings" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
             [(Text, Value)] -> Value
object [ Text
"outputSelection" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
                    [(Text, Value)] -> Value
object [Text
"*" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
                      [(Text, Value)] -> Value
object [Text
"*" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ([String] -> Value
forall a. ToJSON a => a -> Value
toJSON
                              [String
"metadata" :: String,
                               String
"evm.bytecode",
                               String
"evm.deployedBytecode",
                               String
"abi",
                               String
"storageLayout",
                               String
"evm.bytecode.sourceMap",
                               String
"evm.bytecode.linkReferences",
                               String
"evm.bytecode.generatedSources",
                               String
"evm.deployedBytecode.sourceMap",
                               String
"evm.deployedBytecode.linkReferences",
                               String
"evm.deployedBytecode.generatedSources",
                               String
"evm.deployedBytecode.immutableReferences"
                              ]),
                              Text
"" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ([String] -> Value
forall a. ToJSON a => a -> Value
toJSON [String
"ast" :: String])
                             ]
                            ]
                    ]
           ]

stdjson :: Language -> Text -> Text
stdjson :: Language -> Text -> Text
stdjson Language
lang Text
src = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ StandardJSON -> ByteString
forall a. ToJSON a => a -> ByteString
encode (StandardJSON -> ByteString) -> StandardJSON -> ByteString
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 = (ByteString -> ByteString -> (ByteString, ByteString))
-> ByteString -> ByteString -> (ByteString, ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
bs (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
knownBzzrPrefixes in
    case ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> Maybe (ByteString, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
forall a. Monoid a => a
mempty) (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) [(ByteString, ByteString)]
stripCandidates of
      Maybe (ByteString, ByteString)
Nothing -> ByteString
bs
      Just (ByteString
b, ByteString
_) -> ByteString
b

stripBytecodeMetadataSym :: [SWord 8] -> [SWord 8]
stripBytecodeMetadataSym :: [SWord 8] -> [SWord 8]
stripBytecodeMetadataSym [SWord 8]
b =
  let
    concretes :: [Maybe Word8]
    concretes :: [Maybe Word8]
concretes = ((WordN 8 -> Word8) -> Maybe (WordN 8) -> Maybe Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WordN 8 -> Word8
forall a. FromSizedBV a => a -> FromSized a
fromSized) (Maybe (WordN 8) -> Maybe Word8)
-> (SWord 8 -> Maybe (WordN 8)) -> SWord 8 -> Maybe Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SWord 8 -> Maybe (WordN 8)
forall a. SymVal a => SBV a -> Maybe a
unliteral (SWord 8 -> Maybe Word8) -> [SWord 8] -> [Maybe Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SWord 8]
b
    bzzrs :: [[Maybe Word8]]
    bzzrs :: [[Maybe Word8]]
bzzrs = (Word8 -> Maybe Word8) -> [Word8] -> [Maybe Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just) ([Word8] -> [Maybe Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Maybe Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack (ByteString -> [Maybe Word8]) -> [ByteString] -> [[Maybe Word8]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
knownBzzrPrefixes
    candidates :: [Bool]
candidates = (([Maybe Word8] -> [Maybe Word8] -> Bool)
-> [Maybe Word8] -> [Maybe Word8] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Maybe Word8] -> [Maybe Word8] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
Data.List.isInfixOf [Maybe Word8]
concretes) ([Maybe Word8] -> Bool) -> [[Maybe Word8]] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Maybe Word8]]
bzzrs
  in case Bool -> [Bool] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Bool
True [Bool]
candidates of
    Maybe Int
Nothing -> [SWord 8]
b
    Just Int
i -> let Just Int
ind = [Maybe Word8] -> [Maybe Word8] -> Maybe Int
forall a. Eq a => [a] -> [a] -> Maybe Int
infixIndex ([[Maybe Word8]]
bzzrs [[Maybe Word8]] -> Int -> [Maybe Word8]
forall a. [a] -> Int -> a
!! Int
i) [Maybe Word8]
concretes
              in Int -> [SWord 8] -> [SWord 8]
forall a. Int -> [a] -> [a]
take Int
ind [SWord 8]
b

infixIndex :: (Eq a) => [a] -> [a] -> Maybe Int
infixIndex :: [a] -> [a] -> Maybe Int
infixIndex [a]
needle [a]
haystack = ([a] -> Bool) -> [[a]] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
needle) ([a] -> [[a]]
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 :: f Value -> Map Int Value
astIdMap = (Value -> Map Int Value) -> f Value -> Map Int Value
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) = (Value -> Map Int Value) -> Vector Value -> Map Int Value
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 Object
x) =
      let t :: Map Int Value
t = (Value -> Map Int Value) -> [Value] -> Map Int Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Map Int Value
f (Object -> [Value]
forall k v. HashMap k v -> [v]
HMap.elems Object
x)
      in case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
"id" Object
x of
        Maybe Value
Nothing         -> Map Int Value
t
        Just (Number Scientific
i) -> Map Int Value
t Map Int Value -> Map Int Value -> Map Int Value
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> Map Int Value
forall k a. k -> a -> Map k a
Map.singleton (Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
i) Value
v
        Just Value
_          -> Map Int Value
t
    f Value
_ = Map Int 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
_)  -> (Int, Int, Int) -> Map (Int, Int, Int) Value -> Maybe Value
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 =
       [((Int, Int, Int), Value)] -> Map (Int, Int, Int) Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      ([((Int, Int, Int), Value)] -> Map (Int, Int, Int) Value)
-> (Map Int Value -> [((Int, Int, Int), Value)])
-> Map Int Value
-> Map (Int, Int, Int) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe ((Int, Int, Int), Value))
-> [Value] -> [((Int, Int, Int), Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (\Value
v -> do
          Text
src <- Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"src" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Value
v
          [Int
i, Int
n, Int
f] <- (Text -> Maybe Int) -> [Text] -> Maybe [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) ((Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
src)
          ((Int, Int, Int), Value) -> Maybe ((Int, Int, Int), Value)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
i, Int
n, Int
f), Value
v)
        )
      ([Value] -> [((Int, Int, Int), Value)])
-> (Map Int Value -> [Value])
-> Map Int Value
-> [((Int, Int, Int), Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int Value -> [Value]
forall k a. Map k a -> [a]
Map.elems
      (Map Int Value -> Map (Int, Int, Int) Value)
-> Map Int Value -> Map (Int, Int, Int) Value
forall a b. (a -> b) -> a -> b
$ Map Int Value
astIds