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

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

import EVM.ABI
import EVM.Types hiding (Success)

import Optics.Core
import Optics.Operators.Unsafe

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


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

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

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

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

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

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

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

-- | A mapping from contract identifiers (filepath:name) to a SolcContract object
newtype Contracts = Contracts (Map Text SolcContract)
  deriving newtype (Int -> Contracts -> ShowS
[Contracts] -> ShowS
Contracts -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Contracts] -> ShowS
$cshowList :: [Contracts] -> ShowS
show :: Contracts -> FilePath
$cshow :: Contracts -> FilePath
showsPrec :: Int -> Contracts -> ShowS
$cshowsPrec :: Int -> Contracts -> ShowS
Show, Contracts -> Contracts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contracts -> Contracts -> Bool
$c/= :: Contracts -> Contracts -> Bool
== :: Contracts -> Contracts -> Bool
$c== :: Contracts -> Contracts -> Bool
Eq, NonEmpty Contracts -> Contracts
Contracts -> Contracts -> Contracts
forall b. Integral b => b -> Contracts -> Contracts
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Contracts -> Contracts
$cstimes :: forall b. Integral b => b -> Contracts -> Contracts
sconcat :: NonEmpty Contracts -> Contracts
$csconcat :: NonEmpty Contracts -> Contracts
<> :: Contracts -> Contracts -> Contracts
$c<> :: Contracts -> Contracts -> Contracts
Semigroup, Semigroup Contracts
Contracts
[Contracts] -> Contracts
Contracts -> Contracts -> Contracts
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Contracts] -> Contracts
$cmconcat :: [Contracts] -> Contracts
mappend :: Contracts -> Contracts -> Contracts
$cmappend :: Contracts -> Contracts -> Contracts
mempty :: Contracts
$cmempty :: Contracts
Monoid)

-- | A mapping from contract identifiers (filepath:name) to their ast json
newtype Asts = Asts (Map Text Value)
  deriving newtype (Int -> Asts -> ShowS
[Asts] -> ShowS
Asts -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Asts] -> ShowS
$cshowList :: [Asts] -> ShowS
show :: Asts -> FilePath
$cshow :: Asts -> FilePath
showsPrec :: Int -> Asts -> ShowS
$cshowsPrec :: Int -> Asts -> ShowS
Show, Asts -> Asts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Asts -> Asts -> Bool
$c/= :: Asts -> Asts -> Bool
== :: Asts -> Asts -> Bool
$c== :: Asts -> Asts -> Bool
Eq, NonEmpty Asts -> Asts
Asts -> Asts -> Asts
forall b. Integral b => b -> Asts -> Asts
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Asts -> Asts
$cstimes :: forall b. Integral b => b -> Asts -> Asts
sconcat :: NonEmpty Asts -> Asts
$csconcat :: NonEmpty Asts -> Asts
<> :: Asts -> Asts -> Asts
$c<> :: Asts -> Asts -> Asts
Semigroup, Semigroup Asts
Asts
[Asts] -> Asts
Asts -> Asts -> Asts
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Asts] -> Asts
$cmconcat :: [Asts] -> Asts
mappend :: Asts -> Asts -> Asts
$cmappend :: Asts -> Asts -> Asts
mempty :: Asts
$cmempty :: Asts
Monoid)

-- | Solidity source files are identified either by their location in the vfs, or by a src map identifier
data SrcFile = SrcFile
  { SrcFile -> Int
id :: Int
  , SrcFile -> FilePath
filepath :: FilePath
  }
  deriving (Int -> SrcFile -> ShowS
[SrcFile] -> ShowS
SrcFile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SrcFile] -> ShowS
$cshowList :: [SrcFile] -> ShowS
show :: SrcFile -> FilePath
$cshow :: SrcFile -> FilePath
showsPrec :: Int -> SrcFile -> ShowS
$cshowsPrec :: Int -> SrcFile -> ShowS
Show, SrcFile -> SrcFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcFile -> SrcFile -> Bool
$c/= :: SrcFile -> SrcFile -> Bool
== :: SrcFile -> SrcFile -> Bool
$c== :: SrcFile -> SrcFile -> Bool
Eq, Eq SrcFile
SrcFile -> SrcFile -> Bool
SrcFile -> SrcFile -> Ordering
SrcFile -> SrcFile -> SrcFile
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 :: SrcFile -> SrcFile -> SrcFile
$cmin :: SrcFile -> SrcFile -> SrcFile
max :: SrcFile -> SrcFile -> SrcFile
$cmax :: SrcFile -> SrcFile -> SrcFile
>= :: SrcFile -> SrcFile -> Bool
$c>= :: SrcFile -> SrcFile -> Bool
> :: SrcFile -> SrcFile -> Bool
$c> :: SrcFile -> SrcFile -> Bool
<= :: SrcFile -> SrcFile -> Bool
$c<= :: SrcFile -> SrcFile -> Bool
< :: SrcFile -> SrcFile -> Bool
$c< :: SrcFile -> SrcFile -> Bool
compare :: SrcFile -> SrcFile -> Ordering
$ccompare :: SrcFile -> SrcFile -> Ordering
Ord)

-- | A mapping from source files to (maybe) their contents
newtype Sources = Sources (Map SrcFile (Maybe ByteString))
  deriving newtype (Int -> Sources -> ShowS
[Sources] -> ShowS
Sources -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Sources] -> ShowS
$cshowList :: [Sources] -> ShowS
show :: Sources -> FilePath
$cshow :: Sources -> FilePath
showsPrec :: Int -> Sources -> ShowS
$cshowsPrec :: Int -> Sources -> ShowS
Show, Sources -> Sources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sources -> Sources -> Bool
$c/= :: Sources -> Sources -> Bool
== :: Sources -> Sources -> Bool
$c== :: Sources -> Sources -> Bool
Eq, NonEmpty Sources -> Sources
Sources -> Sources -> Sources
forall b. Integral b => b -> Sources -> Sources
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Sources -> Sources
$cstimes :: forall b. Integral b => b -> Sources -> Sources
sconcat :: NonEmpty Sources -> Sources
$csconcat :: NonEmpty Sources -> Sources
<> :: Sources -> Sources -> Sources
$c<> :: Sources -> Sources -> Sources
Semigroup, Semigroup Sources
Sources
[Sources] -> Sources
Sources -> Sources -> Sources
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Sources] -> Sources
$cmconcat :: [Sources] -> Sources
mappend :: Sources -> Sources -> Sources
$cmappend :: Sources -> Sources -> Sources
mempty :: Sources
$cmempty :: Sources
Monoid)

data BuildOutput = BuildOutput
  { BuildOutput -> Contracts
contracts :: Contracts
  , BuildOutput -> SourceCache
sources   :: SourceCache
  }
  deriving (Int -> BuildOutput -> ShowS
[BuildOutput] -> ShowS
BuildOutput -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BuildOutput] -> ShowS
$cshowList :: [BuildOutput] -> ShowS
show :: BuildOutput -> FilePath
$cshow :: BuildOutput -> FilePath
showsPrec :: Int -> BuildOutput -> ShowS
$cshowsPrec :: Int -> BuildOutput -> ShowS
Show, BuildOutput -> BuildOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildOutput -> BuildOutput -> Bool
$c/= :: BuildOutput -> BuildOutput -> Bool
== :: BuildOutput -> BuildOutput -> Bool
$c== :: BuildOutput -> BuildOutput -> Bool
Eq)

instance Semigroup BuildOutput where
  (BuildOutput Contracts
a SourceCache
b) <> :: BuildOutput -> BuildOutput -> BuildOutput
<> (BuildOutput Contracts
c SourceCache
d) = Contracts -> SourceCache -> BuildOutput
BuildOutput (Contracts
a forall a. Semigroup a => a -> a -> a
<> Contracts
c) (SourceCache
b forall a. Semigroup a => a -> a -> a
<> SourceCache
d)
instance Monoid BuildOutput where
  mempty :: BuildOutput
mempty = Contracts -> SourceCache -> BuildOutput
BuildOutput forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | The various project types understood by hevm
data ProjectType = DappTools | Foundry
  deriving (ProjectType -> ProjectType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectType -> ProjectType -> Bool
$c/= :: ProjectType -> ProjectType -> Bool
== :: ProjectType -> ProjectType -> Bool
$c== :: ProjectType -> ProjectType -> Bool
Eq, Int -> ProjectType -> ShowS
[ProjectType] -> ShowS
ProjectType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProjectType] -> ShowS
$cshowList :: [ProjectType] -> ShowS
show :: ProjectType -> FilePath
$cshow :: ProjectType -> FilePath
showsPrec :: Int -> ProjectType -> ShowS
$cshowsPrec :: Int -> ProjectType -> ShowS
Show, ReadPrec [ProjectType]
ReadPrec ProjectType
Int -> ReadS ProjectType
ReadS [ProjectType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProjectType]
$creadListPrec :: ReadPrec [ProjectType]
readPrec :: ReadPrec ProjectType
$creadPrec :: ReadPrec ProjectType
readList :: ReadS [ProjectType]
$creadList :: ReadS [ProjectType]
readsPrec :: Int -> ReadS ProjectType
$creadsPrec :: Int -> ReadS ProjectType
Read, ReadM ProjectType
Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe FilePath
-> Parser [ProjectType]
Maybe Text
-> Maybe Text -> Maybe Char -> Maybe FilePath -> Parser ProjectType
forall a.
(Maybe Text
 -> Maybe Text -> Maybe Char -> Maybe FilePath -> Parser a)
-> (Maybe Text
    -> Maybe Text -> Maybe Char -> Maybe FilePath -> Parser [a])
-> ReadM a
-> (forall (proxy :: * -> *). proxy a -> FilePath)
-> ParseField a
forall (proxy :: * -> *). proxy ProjectType -> FilePath
metavar :: forall (proxy :: * -> *). proxy ProjectType -> FilePath
$cmetavar :: forall (proxy :: * -> *). proxy ProjectType -> FilePath
readField :: ReadM ProjectType
$creadField :: ReadM ProjectType
parseListOfField :: Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe FilePath
-> Parser [ProjectType]
$cparseListOfField :: Maybe Text
-> Maybe Text
-> Maybe Char
-> Maybe FilePath
-> Parser [ProjectType]
parseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe FilePath -> Parser ProjectType
$cparseField :: Maybe Text
-> Maybe Text -> Maybe Char -> Maybe FilePath -> Parser ProjectType
ParseField)

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

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

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

instance Semigroup SourceCache where
  SourceCache Map Int (FilePath, ByteString)
a Map Int (Vector ByteString)
b Map Text Value
c <> :: SourceCache -> SourceCache -> SourceCache
<> SourceCache Map Int (FilePath, ByteString)
d Map Int (Vector ByteString)
e Map Text Value
f = Map Int (FilePath, ByteString)
-> Map Int (Vector ByteString) -> Map Text Value -> SourceCache
SourceCache (Map Int (FilePath, ByteString)
a forall a. Semigroup a => a -> a -> a
<> Map Int (FilePath, ByteString)
d) (Map Int (Vector ByteString)
b forall a. Semigroup a => a -> a -> a
<> Map Int (Vector ByteString)
e) (Map Text Value
c forall a. Semigroup a => a -> a -> a
<> Map Text Value
f)

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

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

data SrcMap = SM {
  SrcMap -> Int
offset        :: {-# UNPACK #-} !Int,
  SrcMap -> Int
length        :: {-# UNPACK #-} !Int,
  SrcMap -> Int
file          :: {-# UNPACK #-} !Int,
  SrcMap -> JumpType
jump          :: JumpType,
  SrcMap -> Int
modifierDepth :: {-# UNPACK #-} !Int
} deriving (Int -> SrcMap -> ShowS
[SrcMap] -> ShowS
SrcMap -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SrcMap] -> ShowS
$cshowList :: [SrcMap] -> ShowS
show :: SrcMap -> FilePath
$cshow :: SrcMap -> FilePath
showsPrec :: Int -> SrcMap -> ShowS
$cshowsPrec :: Int -> SrcMap -> ShowS
Show, SrcMap -> SrcMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcMap -> SrcMap -> Bool
$c/= :: SrcMap -> SrcMap -> Bool
== :: SrcMap -> SrcMap -> Bool
$c== :: SrcMap -> SrcMap -> Bool
Eq, Eq SrcMap
SrcMap -> SrcMap -> Bool
SrcMap -> SrcMap -> Ordering
SrcMap -> SrcMap -> SrcMap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SrcMap -> SrcMap -> SrcMap
$cmin :: SrcMap -> SrcMap -> SrcMap
max :: SrcMap -> SrcMap -> SrcMap
$cmax :: SrcMap -> SrcMap -> SrcMap
>= :: SrcMap -> SrcMap -> Bool
$c>= :: SrcMap -> SrcMap -> Bool
> :: SrcMap -> SrcMap -> Bool
$c> :: SrcMap -> SrcMap -> Bool
<= :: SrcMap -> SrcMap -> Bool
$c<= :: SrcMap -> SrcMap -> Bool
< :: SrcMap -> SrcMap -> Bool
$c< :: SrcMap -> SrcMap -> Bool
compare :: SrcMap -> SrcMap -> Ordering
$ccompare :: SrcMap -> SrcMap -> Ordering
Ord, forall x. Rep SrcMap x -> SrcMap
forall x. SrcMap -> Rep SrcMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrcMap x -> SrcMap
$cfrom :: forall x. SrcMap -> Rep SrcMap x
Generic)

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

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

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

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

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

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

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

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

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

-- | Reads all solc ouput json files found under the provided filepath and returns them merged into a BuildOutput
readBuildOutput :: FilePath -> ProjectType -> IO (Either String BuildOutput)
readBuildOutput :: FilePath -> ProjectType -> IO (Either FilePath BuildOutput)
readBuildOutput FilePath
root ProjectType
DappTools = do
  let outDir :: FilePath
outDir = FilePath
root forall a. Semigroup a => a -> a -> a
<> FilePath
"/out/"
  [FilePath]
jsons <- FilePath -> IO [FilePath]
findJsonFiles FilePath
outDir
  case [FilePath]
jsons of
    [FilePath
x] -> ProjectType
-> FilePath -> FilePath -> IO (Either FilePath BuildOutput)
readSolc ProjectType
DappTools FilePath
root (FilePath
outDir forall a. Semigroup a => a -> a -> a
<> FilePath
x)
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath
"no json files found in: " forall a. Semigroup a => a -> a -> a
<> FilePath
outDir
    [FilePath]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath
"multiple json files found in: " forall a. Semigroup a => a -> a -> a
<> FilePath
outDir
readBuildOutput FilePath
root ProjectType
Foundry = do
  let outDir :: FilePath
outDir = FilePath
root forall a. Semigroup a => a -> a -> a
<> FilePath
"/out/"
  [FilePath]
jsons <- FilePath -> IO [FilePath]
findJsonFiles (FilePath
root forall a. Semigroup a => a -> a -> a
<> FilePath
"/out")
  case ([FilePath] -> [FilePath]
filterMetadata [FilePath]
jsons) of
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath
"no json files found in: " forall a. Semigroup a => a -> a -> a
<> FilePath
outDir
    [FilePath]
js -> do
      Either FilePath [BuildOutput]
outputs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ProjectType
-> FilePath -> FilePath -> IO (Either FilePath BuildOutput)
readSolc ProjectType
Foundry FilePath
root) ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Semigroup a => a -> a -> a
(<>) (FilePath
outDir))) [FilePath]
js)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat) forall a b. (a -> b) -> a -> b
$ Either FilePath [BuildOutput]
outputs

-- | Finds all json files under the provided filepath, searches recursively
findJsonFiles :: FilePath -> IO [FilePath]
findJsonFiles :: FilePath -> IO [FilePath]
findJsonFiles FilePath
root = FilePath -> [FilePath] -> IO [FilePath]
getDirectoryFiles FilePath
root [FilePath
"**/*.json"]

-- | Filters out metadata json files
filterMetadata :: [FilePath] -> [FilePath]
filterMetadata :: [FilePath] -> [FilePath]
filterMetadata = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".metadata.json")

makeSourceCache :: FilePath -> Sources -> Asts -> IO SourceCache
makeSourceCache :: FilePath -> Sources -> Asts -> IO SourceCache
makeSourceCache FilePath
root (Sources Map SrcFile (Maybe ByteString)
sources) (Asts Map Text Value
asts) = do
  Map Int (FilePath, ByteString)
files <- forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
Map.toList Map SrcFile (Maybe ByteString)
sources) (\x :: (SrcFile, Maybe ByteString)
x@(SrcFile Int
id' FilePath
fp, Maybe ByteString
_) -> do
      ByteString
contents <- case (SrcFile, Maybe ByteString)
x of
        (SrcFile
_,  Just ByteString
content) -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
        (SrcFile Int
_ FilePath
_, Maybe ByteString
Nothing) -> FilePath -> IO ByteString
BS.readFile (FilePath
root forall a. Semigroup a => a -> a -> a
<> FilePath
"/" forall a. Semigroup a => a -> a -> a
<> FilePath
fp)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
id', (FilePath
fp, ByteString
contents))
    )
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SourceCache
    { $sel:files:SourceCache :: Map Int (FilePath, ByteString)
files = Map Int (FilePath, ByteString)
files
    , $sel:lines:SourceCache :: Map Int (Vector ByteString)
lines = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> Vector a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
BS.split Word8
0xa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Map Int (FilePath, ByteString)
files
    , $sel:asts:SourceCache :: Map Text Value
asts  = Map Text Value
asts
    }

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

readSolc :: ProjectType -> FilePath -> FilePath -> IO (Either String BuildOutput)
readSolc :: ProjectType
-> FilePath -> FilePath -> IO (Either FilePath BuildOutput)
readSolc ProjectType
pt FilePath
root FilePath
fp =
  (ProjectType -> Text -> Text -> Maybe (Contracts, Asts, Sources)
readJSON ProjectType
pt (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ShowS
takeBaseName FilePath
fp) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readFile FilePath
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe (Contracts, Asts, Sources)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath
"unable to parse: " forall a. Semigroup a => a -> a -> a
<> FilePath
fp
      Just (Contracts
contracts, Asts
asts, Sources
sources) -> do
        SourceCache
sourceCache <- FilePath -> Sources -> Asts -> IO SourceCache
makeSourceCache FilePath
root Sources
sources Asts
asts
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (Contracts -> SourceCache -> BuildOutput
BuildOutput Contracts
contracts SourceCache
sourceCache))

yul :: Text -> Text -> IO (Maybe ByteString)
yul :: Text -> Text -> IO (Maybe ByteString)
yul Text
contract Text
src = do
  (Text
json, Text
path) <- Text -> IO (Text, Text)
yul' Text
src
  let f :: Value
f = (Text
json forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"contracts") forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText Text
path)
      c :: Value
c = Value
f forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
contract then Text
"object" else Text
contract)
      bytecode :: Text
bytecode = Value
c forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"evm" forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bytecode" forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ByteString
toCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just Text
bytecode)

yulRuntime :: Text -> Text -> IO (Maybe ByteString)
yulRuntime :: Text -> Text -> IO (Maybe ByteString)
yulRuntime Text
contract Text
src = do
  (Text
json, Text
path) <- Text -> IO (Text, Text)
yul' Text
src
  let f :: Value
f = (Text
json forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"contracts") forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText Text
path)
      c :: Value
c = Value
f forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key (Text -> Key
Key.fromText forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
contract then Text
"object" else Text
contract)
      bytecode :: Text
bytecode = Value
c forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"evm" forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"deployedBytecode" forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> ByteString
toCode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just Text
bytecode)

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

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

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

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

readJSON :: ProjectType -> Text -> Text -> Maybe (Contracts, Asts, Sources)
readJSON :: ProjectType -> Text -> Text -> Maybe (Contracts, Asts, Sources)
readJSON ProjectType
DappTools Text
_ Text
json = Text -> Maybe (Contracts, Asts, Sources)
readStdJSON Text
json
readJSON ProjectType
Foundry Text
contractName Text
json = Text -> Text -> Maybe (Contracts, Asts, Sources)
readFoundryJSON Text
contractName Text
json

-- | Reads a foundry json output
readFoundryJSON :: Text -> Text -> Maybe (Contracts, Asts, Sources)
readFoundryJSON :: Text -> Text -> Maybe (Contracts, Asts, Sources)
readFoundryJSON Text
contractName Text
json = do
  Value
runtime <- Text
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"deployedBytecode"
  ByteString
runtimeCode <- Text -> ByteString
toCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip0x'' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
runtime forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
  Seq SrcMap
runtimeSrcMap <- Text -> Maybe (Seq SrcMap)
makeSrcMaps forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value
runtime forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String

  Value
creation <- Text
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bytecode"
  ByteString
creationCode <- Text -> ByteString
toCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip0x'' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
creation forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
  Seq SrcMap
creationSrcMap <- Text -> Maybe (Seq SrcMap)
makeSrcMaps forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value
creation forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String

  Value
ast <- Text
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"ast"
  Text
path <- Value
ast forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"absolutePath" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String

  [Value]
abi <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"abi" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array

  Int
id' <- forall a b. (Integral a, Num b) => a -> b
num forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"id" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsNumber t => Prism' t Integer
_Integer

  let contract :: SolcContract
contract = SolcContract
        { $sel:runtimeCodehash:SolcContract :: W256
runtimeCodehash     = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
runtimeCode)
        , $sel:creationCodehash:SolcContract :: W256
creationCodehash    = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
creationCode)
        , $sel:runtimeCode:SolcContract :: ByteString
runtimeCode         = ByteString
runtimeCode
        , $sel:creationCode:SolcContract :: ByteString
creationCode        = ByteString
creationCode
        , $sel:contractName:SolcContract :: Text
contractName        = Text
path forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
contractName
        , $sel:abiMap:SolcContract :: Map FunctionSelector Method
abiMap              = [Value] -> Map FunctionSelector Method
mkAbiMap [Value]
abi
        , $sel:eventMap:SolcContract :: Map W256 Event
eventMap            = [Value] -> Map W256 Event
mkEventMap [Value]
abi
        , $sel:errorMap:SolcContract :: Map W256 SolError
errorMap            = [Value] -> Map W256 SolError
mkErrorMap [Value]
abi
        , $sel:runtimeSrcmap:SolcContract :: Seq SrcMap
runtimeSrcmap       = Seq SrcMap
runtimeSrcMap
        , $sel:creationSrcmap:SolcContract :: Seq SrcMap
creationSrcmap      = Seq SrcMap
creationSrcMap
        , $sel:constructorInputs:SolcContract :: [(Text, AbiType)]
constructorInputs   = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abi
        , $sel:storageLayout:SolcContract :: Maybe (Map Text StorageItem)
storageLayout       = forall a. Monoid a => a
mempty -- TODO: foundry doesn't expose this?
        , $sel:immutableReferences:SolcContract :: Map W256 [Reference]
immutableReferences = forall a. Monoid a => a
mempty -- TODO: foundry doesn't expose this?
        }
  forall (m :: * -> *) a. Monad m => a -> m a
return ( Map Text SolcContract -> Contracts
Contracts forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (Text
path forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
contractName) SolcContract
contract
         , Map Text Value -> Asts
Asts      forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton Text
path Value
ast
         , Map SrcFile (Maybe ByteString) -> Sources
Sources   forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton (Int -> FilePath -> SrcFile
SrcFile Int
id' (Text -> FilePath
T.unpack Text
path)) forall a. Maybe a
Nothing
         )

-- | Parses the standard json output from solc
readStdJSON :: Text -> Maybe (Contracts, Asts, Sources)
readStdJSON :: Text -> Maybe (Contracts, Asts, Sources)
readStdJSON Text
json = do
  HashMap Text Value
contracts <- forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"contracts" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Object
_Object
  -- TODO: support the general case of "urls" and "content" in the standard json
  HashMap Text Value
sources <- forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Text
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sources" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Object
_Object
  let asts :: HashMap Text Value
asts = forall a. FilePath -> Maybe a -> a
force FilePath
"JSON lacks abstract syntax trees." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"ast") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Value
sources
      contractMap :: Map Text (SolcContract, HashMap Text Text)
contractMap = forall s.
AsValue s =>
HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f HashMap Text Value
contracts
      getId :: Text -> Int
getId Text
src = forall a b. (Integral a, Num b) => a -> b
num forall a b. (a -> b) -> a -> b
$ (forall a. FilePath -> Maybe a -> a
force FilePath
"" forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
src HashMap Text Value
sources) forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"id" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsNumber t => Prism' t Integer
_Integer
      contents :: Text -> (SrcFile, Maybe ByteString)
contents Text
src = (Int -> FilePath -> SrcFile
SrcFile (Text -> Int
getId Text
src) (Text -> FilePath
T.unpack Text
src), Text -> ByteString
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMap.lookup Text
src (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap))
  forall (m :: * -> *) a. Monad m => a -> m a
return ( Map Text SolcContract -> Contracts
Contracts forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (SolcContract, HashMap Text Text)
contractMap
         , Map Text Value -> Asts
Asts      forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Value
asts)
         , Map SrcFile (Maybe ByteString) -> Sources
Sources   forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ Text -> (SrcFile, Maybe ByteString)
contents forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
HMap.keys HashMap Text Value
sources)
         )
  where
    f :: (AsValue s) => HMap.HashMap Text s -> (Map Text (SolcContract, (HMap.HashMap Text Text)))
    f :: forall s.
AsValue s =>
HashMap Text s -> Map Text (SolcContract, HashMap Text Text)
f HashMap Text s
x = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {s}.
AsValue s =>
(Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HMap.toList forall a b. (a -> b) -> a -> b
$ HashMap Text s
x
    g :: (Text, s) -> [(Text, (SolcContract, HashMap Text Text))]
g (Text
s, s
x) = Text -> (Text, Value) -> (Text, (SolcContract, HashMap Text Text))
h Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. HashMap k v -> [(k, v)]
HMap.toList (forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"Could not parse json object") (forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview 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 forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"evm"
        runtime :: Value
runtime = Value
evmstuff forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"deployedBytecode"
        creation :: Value
creation =  Value
evmstuff forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"bytecode"
        theRuntimeCode :: ByteString
theRuntimeCode = Text -> ByteString
toCode forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Value
runtime forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
        theCreationCode :: ByteString
theCreationCode = Text -> ByteString
toCode forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Value
creation forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"object" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
        srcContents :: Maybe (HMap.HashMap Text Text)
        srcContents :: Maybe (HashMap Text Text)
srcContents = do Text
metadata <- Value
x forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"metadata" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
                         HashMap Text Value
srcs <- forall v. KeyMap v -> HashMap Text v
KeyMap.toHashMapText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
metadata forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sources" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Object
_Object
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                           (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"Internal Error: could not parse contents field into a string") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"content" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String))
                           (forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HMap.filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"content")) HashMap Text Value
srcs)
        abis :: [Value]
abis = forall a. FilePath -> Maybe a -> a
force (FilePath
"abi key not found in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Value
x) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
x forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"abi" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array
      in (Text
s forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
c, (SolcContract {
        $sel:runtimeCode:SolcContract :: ByteString
runtimeCode      = ByteString
theRuntimeCode,
        $sel:creationCode:SolcContract :: ByteString
creationCode     = ByteString
theCreationCode,
        $sel:runtimeCodehash:SolcContract :: W256
runtimeCodehash  = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        $sel:creationCodehash:SolcContract :: W256
creationCodehash = ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        $sel:runtimeSrcmap:SolcContract :: Seq SrcMap
runtimeSrcmap    = forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
runtime forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String)),
        $sel:creationSrcmap:SolcContract :: Seq SrcMap
creationSrcmap   = forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (Value
creation forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"sourceMap" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String)),
        $sel:contractName:SolcContract :: Text
contractName = Text
s forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
c,
        $sel:constructorInputs:SolcContract :: [(Text, AbiType)]
constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        $sel:abiMap:SolcContract :: Map FunctionSelector Method
abiMap        = [Value] -> Map FunctionSelector Method
mkAbiMap [Value]
abis,
        $sel:eventMap:SolcContract :: Map W256 Event
eventMap      = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        $sel:errorMap:SolcContract :: Map W256 SolError
errorMap      = [Value] -> Map W256 SolError
mkErrorMap [Value]
abis,
        $sel:storageLayout:SolcContract :: Maybe (Map Text StorageItem)
storageLayout = Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout forall a b. (a -> b) -> a -> b
$ Value
x forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"storageLayout",
        $sel:immutableReferences:SolcContract :: Map W256 [Reference]
immutableReferences = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
          do Value
x' <- Value
runtime forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"immutableReferences"
             case forall a. FromJSON a => Value -> Result a
fromJSON Value
x' of
               Success Map W256 [Reference]
a -> forall (m :: * -> *) a. Monad m => a -> m a
return Map W256 [Reference]
a
               Result (Map W256 [Reference])
_ -> forall a. Maybe a
Nothing
      }, forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (HashMap Text Text)
srcContents))

mkAbiMap :: [Value] -> Map FunctionSelector Method
mkAbiMap :: [Value] -> Map FunctionSelector Method
mkAbiMap [Value]
abis = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
  let
    relevant :: [Value]
relevant = forall a. (a -> Bool) -> [a] -> [a]
filter (\Value
y -> Text
"function" forall a. Eq a => a -> a -> Bool
== Value
y forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String) [Value]
abis
    f :: s -> (FunctionSelector, Method)
f s
abi =
      (ByteString -> FunctionSelector
abiKeccak (Text -> ByteString
encodeUtf8 (forall s. AsValue s => s -> Text
signature s
abi)),
       Method { $sel:name:Method :: Text
name = s
abi forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
              , $sel:methodSignature:Method :: Text
methodSignature = forall s. AsValue s => s -> Text
signature s
abi
              , $sel:inputs:Method :: [(Text, AbiType)]
inputs = forall a b. (a -> b) -> [a] -> [b]
map forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , $sel:output:Method :: [(Text, AbiType)]
output = forall a b. (a -> b) -> [a] -> [b]
map forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput
                 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (s
abi forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"outputs" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array))
              , $sel:mutability:Method :: Mutability
mutability = Text -> Mutability
parseMutability
                 (s
abi forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"stateMutability" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String)
              })
  in forall {s}. AsValue s => s -> (FunctionSelector, Method)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
relevant

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

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

mkConstructor :: [Value] -> [(Text, AbiType)]
mkConstructor :: [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis =
  let
    isConstructor :: s -> Bool
isConstructor s
y =
      Text
"constructor" forall a. Eq a => a -> a -> Bool
== s
y forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
  in
    case forall a. (a -> Bool) -> [a] -> [a]
filter forall {s}. AsValue s => s -> Bool
isConstructor [Value]
abis of
      [Value
abi] -> forall a b. (a -> b) -> [a] -> [b]
map forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Value
abi forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array))
      [] -> [] -- default constructor has zero inputs
      [Value]
_  -> forall a. HasCallStack => FilePath -> a
error FilePath
"strange: contract has multiple constructors"

mkStorageLayout :: Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout :: Maybe Value -> Maybe (Map Text StorageItem)
mkStorageLayout Maybe Value
Nothing = forall a. Maybe a
Nothing
mkStorageLayout (Just Value
json) = do
  Vector Value
items <- Value
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"storage" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array
  Value
types <- Value
json forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"types"
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Vector a -> [a]
Vector.toList Vector Value
items) forall a b. (a -> b) -> a -> b
$ \Value
item ->
    do Text
name <- Value
item forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"label" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
       Int
offset <- Value
item forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"offset" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsNumber t => Prism' t Scientific
_Number forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger
       Text
slot <- Value
item forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"slot" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
       Key
typ <- Text -> Key
Key.fromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
item forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
       Text
slotType <- Value
types forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
typ forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"label" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
       forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, SlotType -> Int -> Int -> StorageItem
StorageItem (forall a. Read a => FilePath -> a
read forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
slotType) Int
offset (forall a. Read a => FilePath -> a
read forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
slot)))

signature :: AsValue s => s -> Text
signature :: forall s. AsValue s => s -> Text
signature s
abi =
  case s
abi forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" of
    Value
"fallback" -> Text
"<fallback>"
    Value
_ ->
      forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [
        forall a. a -> Maybe a -> a
fromMaybe Text
"<constructor>" (s
abi forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String), Text
"(",
        Text -> [Text] -> Text
intercalate Text
","
          (forall a b. (a -> b) -> [a] -> [b]
map (\Value
x -> Value
x forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String)
            (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ s
abi forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"inputs" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array)),
        Text
")"
      ]

-- Helper function to convert the fields to the desired type
parseTypeName' :: AsValue s => s -> Maybe AbiType
parseTypeName' :: forall s. AsValue s => s -> Maybe AbiType
parseTypeName' s
x =
  Vector AbiType -> Text -> Maybe AbiType
parseTypeName
    (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ s
x forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"components" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t (Vector Value)
_Array forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s a. (s -> a) -> Getter s a
to Vector Value -> Vector AbiType
parseComponents)
    (s
x forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"type" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String)
  where parseComponents :: Vector Value -> Vector AbiType
parseComponents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput

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

-- This actually can also parse a method output! :O
parseMethodInput :: AsValue s => s -> (Text, AbiType)
parseMethodInput :: forall s. AsValue s => s -> (Text, AbiType)
parseMethodInput s
x =
  ( s
x forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"name" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String
  , forall a. FilePath -> Maybe a -> a
force FilePath
"internal error: method type" (forall s. AsValue s => s -> Maybe AbiType
parseTypeName' s
x)
  )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

astSrcMap :: Map Int Value -> (SrcMap -> Maybe Value)
astSrcMap :: Map Int Value -> SrcMap -> Maybe Value
astSrcMap Map Int Value
astIds =
  \(SM Int
i Int
n Int
f JumpType
_ Int
_)  -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
i, Int
n, Int
f) Map (Int, Int, Int) Value
tmp
  where
    tmp :: Map (Int, Int, Int) Value
    tmp :: Map (Int, Int, Int) Value
tmp =
       forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (\Value
v -> do
          Text
src <- forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall t. AsValue t => Key -> AffineTraversal' t Value
key Key
"src" forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall t. AsValue t => Prism' t Text
_String) Value
v
          [Int
i, Int
n, Int
f] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Read a => FilePath -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) ((Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
':') Text
src)
          forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
i, Int
n, Int
f), Value
v)
        )
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems
      forall a b. (a -> b) -> a -> b
$ Map Int Value
astIds

-- needs to be here not Format due to cyclic module deps
strip0x'' :: Text -> Text
strip0x'' :: Text -> Text
strip0x'' Text
s = if Text
"0x" Text -> Text -> Bool
`T.isPrefixOf` Text
s then Int -> Text -> Text
T.drop Int
2 Text
s else Text
s