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

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

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

import Control.Applicative
import Control.Monad
import Control.Lens         hiding (Indexed, (.=))
import Data.Aeson           (Value (..), ToJSON(..), (.=), object, encode)
import Data.Aeson.Lens
import Data.Scientific
import Data.ByteString      (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Char            (isDigit)
import Data.Foldable
import Data.Map.Strict      (Map)
import Data.Maybe
import Data.List.NonEmpty   (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Semigroup
import Data.Sequence        (Seq)
import Data.Text            (Text, pack, intercalate)
import Data.Text.Encoding   (encodeUtf8, decodeUtf8)
import Data.Text.IO         (readFile, writeFile)
import Data.Vector          (Vector)
import Data.Word
import GHC.Generics         (Generic)
import Prelude hiding       (readFile, writeFile)
import System.IO hiding     (readFile, writeFile)
import System.IO.Temp
import System.Process
import Text.Read            (readMaybe)

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

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

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

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

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

data SolcContract = SolcContract
  { SolcContract -> W256
_runtimeCodehash  :: W256
  , SolcContract -> W256
_creationCodehash :: W256
  , SolcContract -> ByteString
_runtimeCode      :: ByteString
  , SolcContract -> ByteString
_creationCode     :: ByteString
  , SolcContract -> Text
_contractName     :: Text
  , SolcContract -> [(Text, AbiType)]
_constructorInputs :: [(Text, AbiType)]
  , SolcContract -> Map Word32 Method
_abiMap           :: Map Word32 Method
  , SolcContract -> Map W256 Event
_eventMap         :: Map W256 Event
  , SolcContract -> Maybe (Map Text StorageItem)
_storageLayout    :: Maybe (Map Text StorageItem)
  , SolcContract -> Seq SrcMap
_runtimeSrcmap    :: Seq SrcMap
  , SolcContract -> Seq SrcMap
_creationSrcmap   :: Seq SrcMap
  } deriving (Int -> SolcContract -> ShowS
[SolcContract] -> ShowS
SolcContract -> String
(Int -> SolcContract -> ShowS)
-> (SolcContract -> String)
-> ([SolcContract] -> ShowS)
-> Show SolcContract
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolcContract] -> ShowS
$cshowList :: [SolcContract] -> ShowS
show :: SolcContract -> String
$cshow :: SolcContract -> String
showsPrec :: Int -> SolcContract -> ShowS
$cshowsPrec :: Int -> SolcContract -> ShowS
Show, SolcContract -> SolcContract -> Bool
(SolcContract -> SolcContract -> Bool)
-> (SolcContract -> SolcContract -> Bool) -> Eq SolcContract
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolcContract -> SolcContract -> Bool
$c/= :: SolcContract -> SolcContract -> Bool
== :: SolcContract -> SolcContract -> Bool
$c== :: SolcContract -> SolcContract -> Bool
Eq, (forall x. SolcContract -> Rep SolcContract x)
-> (forall x. Rep SolcContract x -> SolcContract)
-> Generic SolcContract
forall x. Rep SolcContract x -> SolcContract
forall x. SolcContract -> Rep SolcContract x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolcContract x -> SolcContract
$cfrom :: forall x. SolcContract -> Rep SolcContract x
Generic)

data Method = Method
  { Method -> [(Text, AbiType)]
_methodOutput :: [(Text, AbiType)]
  , Method -> [(Text, AbiType)]
_methodInputs :: [(Text, AbiType)]
  , Method -> Text
_methodName :: Text
  , Method -> Text
_methodSignature :: Text
  } deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show, Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Eq, Eq Method
Eq Method =>
(Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmax :: Method -> Method -> Method
>= :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c< :: Method -> Method -> Bool
compare :: Method -> Method -> Ordering
$ccompare :: Method -> Method -> Ordering
$cp1Ord :: Eq Method
Ord, (forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Method x -> Method
$cfrom :: forall x. Method -> Rep Method x
Generic)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

makeSourceCache :: [(Text, Maybe ByteString)] -> Map Text Value -> IO SourceCache
makeSourceCache :: [(Text, Maybe ByteString)] -> Map Text Value -> IO SourceCache
makeSourceCache paths :: [(Text, Maybe ByteString)]
paths asts :: Map Text Value
asts = do
  let f :: (Text, Maybe ByteString) -> IO ByteString
f (_,  Just content :: ByteString
content) = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
      f (fp :: Text
fp, Nothing) = String -> IO ByteString
BS.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
fp
  [ByteString]
xs <- ((Text, Maybe ByteString) -> IO ByteString)
-> [(Text, Maybe ByteString)] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Maybe ByteString) -> IO ByteString
f [(Text, Maybe ByteString)]
paths
  SourceCache -> IO SourceCache
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceCache -> IO SourceCache) -> SourceCache -> IO SourceCache
forall a b. (a -> b) -> a -> b
$! $WSourceCache :: Map Int (Text, ByteString)
-> Map Int (Vector ByteString) -> Map Text Value -> SourceCache
SourceCache
    { _sourceFiles :: Map Int (Text, ByteString)
_sourceFiles =
        [(Int, (Text, ByteString))] -> Map Int (Text, ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Int] -> [(Text, ByteString)] -> [(Int, (Text, ByteString))]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] ([Text] -> [ByteString] -> [(Text, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Text, Maybe ByteString) -> Text
forall a b. (a, b) -> a
fst ((Text, Maybe ByteString) -> Text)
-> [(Text, Maybe ByteString)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe ByteString)]
paths) [ByteString]
xs))
    , _sourceLines :: Map Int (Vector ByteString)
_sourceLines =
        [(Int, Vector ByteString)] -> Map Int (Vector ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Int] -> [Vector ByteString] -> [(Int, Vector ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 .. [(Text, Maybe ByteString)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Maybe ByteString)]
paths Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
                       ((ByteString -> Vector ByteString)
-> [ByteString] -> [Vector ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ([ByteString] -> Vector ByteString
forall a. [a] -> Vector a
Vector.fromList ([ByteString] -> Vector ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> Vector ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
BS.split 0xa) [ByteString]
xs))
    , _sourceAsts :: Map Text Value
_sourceAsts =
        Map Text Value
asts
    }

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

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

solidity :: Text -> Text -> IO (Maybe ByteString)
solidity :: Text -> Text -> IO (Maybe ByteString)
solidity contract :: Text
contract src :: Text
src = do
  (json :: Text
json, path :: Text
path) <- Text -> IO (Text, Text)
solidity' Text
src
  let Just (sol :: Map Text SolcContract
sol, _, _) = Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text SolcContract
sol Map Text SolcContract
-> Getting (First ByteString) (Map Text SolcContract) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contract) ((SolcContract -> Const (First ByteString) SolcContract)
 -> Map Text SolcContract
 -> Const (First ByteString) (Map Text SolcContract))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> SolcContract -> Const (First ByteString) SolcContract)
-> Getting (First ByteString) (Map Text SolcContract) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> SolcContract -> Const (First ByteString) SolcContract
Lens' SolcContract ByteString
creationCode)

solcRuntime :: Text -> Text -> IO (Maybe ByteString)
solcRuntime :: Text -> Text -> IO (Maybe ByteString)
solcRuntime contract :: Text
contract src :: Text
src = do
  (json :: Text
json, path :: Text
path) <- Text -> IO (Text, Text)
solidity' Text
src
  let Just (sol :: Map Text SolcContract
sol, _, _) = Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text SolcContract
sol Map Text SolcContract
-> Getting (First ByteString) (Map Text SolcContract) ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contract) ((SolcContract -> Const (First ByteString) SolcContract)
 -> Map Text SolcContract
 -> Const (First ByteString) (Map Text SolcContract))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> SolcContract -> Const (First ByteString) SolcContract)
-> Getting (First ByteString) (Map Text SolcContract) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> SolcContract -> Const (First ByteString) SolcContract
Lens' SolcContract ByteString
runtimeCode)

functionAbi :: Text -> IO Method
functionAbi :: Text -> IO Method
functionAbi f :: Text
f = do
  (json :: Text
json, path :: Text
path) <- Text -> IO (Text, Text)
solidity' ("contract ABI { function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " public {}}")
  let Just (sol :: Map Text SolcContract
sol, _, _) = Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readJSON Text
json
  case Map Word32 Method -> [(Word32, Method)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Word32 Method -> [(Word32, Method)])
-> Map Word32 Method -> [(Word32, Method)]
forall a b. (a -> b) -> a -> b
$ Map Text SolcContract
sol Map Text SolcContract
-> Getting
     (Endo (Map Word32 Method))
     (Map Text SolcContract)
     (Map Word32 Method)
-> Map Word32 Method
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map Text SolcContract)
-> Traversal'
     (Map Text SolcContract) (IxValue (Map Text SolcContract))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":ABI") ((SolcContract -> Const (Endo (Map Word32 Method)) SolcContract)
 -> Map Text SolcContract
 -> Const (Endo (Map Word32 Method)) (Map Text SolcContract))
-> ((Map Word32 Method
     -> Const (Endo (Map Word32 Method)) (Map Word32 Method))
    -> SolcContract -> Const (Endo (Map Word32 Method)) SolcContract)
-> Getting
     (Endo (Map Word32 Method))
     (Map Text SolcContract)
     (Map Word32 Method)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Word32 Method
 -> Const (Endo (Map Word32 Method)) (Map Word32 Method))
-> SolcContract -> Const (Endo (Map Word32 Method)) SolcContract
Lens' SolcContract (Map Word32 Method)
abiMap of
     [(_,b :: Method
b)] -> Method -> IO Method
forall (m :: * -> *) a. Monad m => a -> m a
return Method
b
     _ -> String -> IO Method
forall a. HasCallStack => String -> a
error "hevm internal error: unexpected abi format"

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

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

readCombinedJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readCombinedJSON :: Text
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
readCombinedJSON json :: Text
json = do
  Map Text SolcContract
contracts <- HashMap Text Value -> Map Text SolcContract
forall s. AsValue s => HashMap Text s -> Map Text SolcContract
f (HashMap Text Value -> Map Text SolcContract)
-> Maybe (HashMap Text Value) -> Maybe (Map Text SolcContract)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
json Text
-> Getting (First (HashMap Text Value)) Text (HashMap Text Value)
-> Maybe (HashMap Text Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key "contracts" ((Value -> Const (First (HashMap Text Value)) Value)
 -> Text -> Const (First (HashMap Text Value)) Text)
-> ((HashMap Text Value
     -> Const (First (HashMap Text Value)) (HashMap Text Value))
    -> Value -> Const (First (HashMap Text Value)) Value)
-> Getting (First (HashMap Text Value)) Text (HashMap Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text Value
 -> Const (First (HashMap Text Value)) (HashMap Text Value))
-> Value -> Const (First (HashMap Text Value)) Value
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object)
  [Text]
sources <- Vector Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector Text -> [Text])
-> (Vector Value -> Vector Text) -> Vector Value -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Text) -> Vector Value -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting Text Value Text -> Value -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Value Text
forall t. AsPrimitive t => Prism' t Text
_String) (Vector Value -> [Text]) -> Maybe (Vector Value) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
json Text
-> Getting (First (Vector Value)) Text (Vector Value)
-> Maybe (Vector Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key "sourceList" ((Value -> Const (First (Vector Value)) Value)
 -> Text -> Const (First (Vector Value)) Text)
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> Getting (First (Vector Value)) Text (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value -> Const (First (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array
  (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
-> Maybe
     (Map Text SolcContract, Map Text Value, [(Text, Maybe ByteString)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text SolcContract
contracts, [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList HashMap Text Value
asts), [ (Text
x, Maybe ByteString
forall a. Maybe a
Nothing) | Text
x <- [Text]
sources])
  where
    asts :: HashMap Text Value
asts = HashMap Text Value
-> Maybe (HashMap Text Value) -> HashMap Text Value
forall a. a -> Maybe a -> a
fromMaybe (String -> HashMap Text Value
forall a. HasCallStack => String -> a
error "JSON lacks abstract syntax trees.") (Text
json Text
-> Getting (First (HashMap Text Value)) Text (HashMap Text Value)
-> Maybe (HashMap Text Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key "sources" ((Value -> Const (First (HashMap Text Value)) Value)
 -> Text -> Const (First (HashMap Text Value)) Text)
-> ((HashMap Text Value
     -> Const (First (HashMap Text Value)) (HashMap Text Value))
    -> Value -> Const (First (HashMap Text Value)) Value)
-> Getting (First (HashMap Text Value)) Text (HashMap Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text Value
 -> Const (First (HashMap Text Value)) (HashMap Text Value))
-> Value -> Const (First (HashMap Text Value)) Value
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object)
    f :: HashMap Text s -> Map Text SolcContract
f x :: HashMap Text s
x = [(Text, SolcContract)] -> Map Text SolcContract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, SolcContract)] -> Map Text SolcContract)
-> (HashMap Text SolcContract -> [(Text, SolcContract)])
-> HashMap Text SolcContract
-> Map Text SolcContract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text SolcContract -> [(Text, SolcContract)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap Text SolcContract -> Map Text SolcContract)
-> HashMap Text SolcContract -> Map Text SolcContract
forall a b. (a -> b) -> a -> b
$ (Text -> s -> SolcContract)
-> HashMap Text s -> HashMap Text SolcContract
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMap.mapWithKey Text -> s -> SolcContract
forall s. AsValue s => Text -> s -> SolcContract
g HashMap Text s
x
    g :: Text -> s -> SolcContract
g s :: Text
s x :: s
x =
      let
        theRuntimeCode :: ByteString
theRuntimeCode = Text -> ByteString
toCode (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key "bin-runtime" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> ((Text -> Const (Endo Text) Text)
    -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value
forall t. AsPrimitive t => Prism' t Text
_String)
        theCreationCode :: ByteString
theCreationCode = Text -> ByteString
toCode (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key "bin" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> ((Text -> Const (Endo Text) Text)
    -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value
forall t. AsPrimitive t => Prism' t Text
_String)
        abis :: [Value]
abis =
          Vector Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key "abi" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> ((Text -> Const (Endo Text) Text)
    -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value
forall t. AsPrimitive t => Prism' t Text
_String) Text
-> Getting (Endo (Vector Value)) Text (Vector Value)
-> Vector Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo (Vector Value)) Text (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array)
      in $WSolcContract :: W256
-> W256
-> ByteString
-> ByteString
-> Text
-> [(Text, AbiType)]
-> Map Word32 Method
-> Map W256 Event
-> Maybe (Map Text StorageItem)
-> Seq SrcMap
-> Seq SrcMap
-> SolcContract
SolcContract {
        _runtimeCode :: ByteString
_runtimeCode      = ByteString
theRuntimeCode,
        _creationCode :: ByteString
_creationCode     = ByteString
theCreationCode,
        _runtimeCodehash :: W256
_runtimeCodehash  = ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
theRuntimeCode),
        _creationCodehash :: W256
_creationCodehash = ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
theCreationCode),
        _runtimeSrcmap :: Seq SrcMap
_runtimeSrcmap    = String -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. String -> Maybe a -> a
force "internal error: srcmap-runtime" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key "srcmap-runtime" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> ((Text -> Const (Endo Text) Text)
    -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value
forall t. AsPrimitive t => Prism' t Text
_String)),
        _creationSrcmap :: Seq SrcMap
_creationSrcmap   = String -> Maybe (Seq SrcMap) -> Seq SrcMap
forall a. String -> Maybe a -> a
force "internal error: srcmap" (Text -> Maybe (Seq SrcMap)
makeSrcMaps (s
x s -> Getting (Endo Text) s Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key "srcmap" ((Value -> Const (Endo Text) Value) -> s -> Const (Endo Text) s)
-> ((Text -> Const (Endo Text) Text)
    -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo Text) Text)
-> Value -> Const (Endo Text) Value
forall t. AsPrimitive t => Prism' t Text
_String)),
        _contractName :: Text
_contractName = Text
s,
        _constructorInputs :: [(Text, AbiType)]
_constructorInputs = [Value] -> [(Text, AbiType)]
mkConstructor [Value]
abis,
        _abiMap :: Map Word32 Method
_abiMap       = [Value] -> Map Word32 Method
mkAbiMap [Value]
abis,
        _eventMap :: Map W256 Event
_eventMap     = [Value] -> Map W256 Event
mkEventMap [Value]
abis,
        _storageLayout :: Maybe (Map Text StorageItem)
_storageLayout = Maybe Text -> Maybe (Map Text StorageItem)
mkStorageLayout (Maybe Text -> Maybe (Map Text StorageItem))
-> Maybe Text -> Maybe (Map Text StorageItem)
forall a b. (a -> b) -> a -> b
$ s
x s -> Getting (First Text) s Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key "storage-layout" ((Value -> Const (First Text) Value) -> s -> Const (First Text) s)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsPrimitive t => Prism' t Text
_String
      }

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

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

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

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

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

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

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

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

toCode :: Text -> ByteString
toCode :: Text -> ByteString
toCode = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (Text -> (ByteString, ByteString)) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
BS16.decode (ByteString -> (ByteString, ByteString))
-> (Text -> ByteString) -> Text -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

solidity' :: Text -> IO (Text, Text)
solidity' :: Text -> IO (Text, Text)
solidity' src :: Text
src = String -> (String -> Handle -> IO (Text, Text)) -> IO (Text, Text)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile "hevm.sol" ((String -> Handle -> IO (Text, Text)) -> IO (Text, Text))
-> (String -> Handle -> IO (Text, Text)) -> IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ \path :: String
path handle :: Handle
handle -> do
  Handle -> IO ()
hClose Handle
handle
  String -> Text -> IO ()
writeFile String
path ("pragma solidity ^0.6.7;\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src)
  Text
x <- String -> Text
pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    String -> [String] -> String -> IO String
readProcess
      "solc"
      ["--combined-json=bin-runtime,bin,srcmap,srcmap-runtime,abi,ast,storage-layout", String
path]
      ""
  (Text, Text) -> IO (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, String -> Text
pack String
path)

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

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

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

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

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

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

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

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

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

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