diff --git a/runsol.sh b/runsol.sh index 0f2e54d8e..a47f61afe 100755 --- a/runsol.sh +++ b/runsol.sh @@ -191,16 +191,12 @@ fi # Execute compilation pipeline echo "Compiling to hull..." -if ! cabal run sol-core -- -f "$file"; then +mkdir -p "$build_dir" +if ! cabal run sol-core -- -f "$file" -o "$build_dir"; then echo "Error: sol-core compilation failed" exit 1 fi -mkdir -p build -if ls ./output*.hull 1> /dev/null 2>&1; then - mv ./output*.hull build/ -fi - echo "Generating Yul..." yule_args=("$hull" -o "$yulfile") if [[ "$create" == "false" ]]; then diff --git a/sol-core.cabal b/sol-core.cabal index 07eb320a6..dc332a2f8 100644 --- a/sol-core.cabal +++ b/sol-core.cabal @@ -171,6 +171,7 @@ test-suite sol-core-tests -- cabal-fmt: expand test -Main other-modules: Cases + ContractAbiTests HullCases MatchCompilerTests ModuleTypeCheckTests diff --git a/src/Solcore/Desugarer/ContractDispatch.hs b/src/Solcore/Desugarer/ContractDispatch.hs index a767a4f07..123ee9d2a 100644 --- a/src/Solcore/Desugarer/ContractDispatch.hs +++ b/src/Solcore/Desugarer/ContractDispatch.hs @@ -11,10 +11,13 @@ module Solcore.Desugarer.ContractDispatch ( contractDispatchDesugarer, contractDispatchTopDecls, + writeContractAbis, + contractAbiJson, ) where -import Data.List (mapAccumL) +import Control.Monad (forM_, unless) +import Data.List (intercalate, mapAccumL) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Set (Set) import Data.Set qualified as Set @@ -23,6 +26,8 @@ import Language.Yul.QuasiQuote import Solcore.Backend.Mast import Solcore.Frontend.Syntax import Solcore.Primitives.Primitives (string, tupleExpFromList, tupleTyFromList, unit, word) +import System.Directory (createDirectoryIfMissing) +import System.FilePath ((<.>), ()) contractDispatchDesugarer :: CompUnit Name -> CompUnit Name contractDispatchDesugarer (CompUnit ims topdecls) = CompUnit ims (contractDispatchTopDecls topdecls) @@ -273,3 +278,159 @@ nameTypeName cname fname = Name ("DispatchNameTy_" <> nm cname <> "_" <> nm fnam where nm (Name s) = s nm (QualName _ s) = s + +nameStr :: Name -> String +nameStr (Name s) = s +nameStr (QualName _ s) = s + +--- ABI generation --- + +-- | Write a JSON ABI file for every contract among the given declarations. +writeContractAbis :: FilePath -> [TopDecl Name] -> IO () +writeContractAbis outDir topdecls = do + let cs = [c | TContr c <- topdecls] + unless (null cs) (createDirectoryIfMissing True outDir) + forM_ cs $ \c -> + writeFile (outDir nameStr (name c) <.> "abi") (contractAbiJson c) + +-- | Render the JSON ABI description of a contract: an array of constructor, +-- function and fallback descriptors. +contractAbiJson :: Contract Name -> String +contractAbiJson c = + renderJson (JArr (map abiEntryJson (contractAbiEntries c))) <> "\n" + +-- | A single ABI descriptor. +data AbiEntry + = AbiFunction String [AbiParam] [AbiParam] String + | AbiConstructor [AbiParam] String + | AbiFallback String + +-- | An input or output entry. Tuple types carry their (recursive) components. +data AbiParam = AbiParam + { abiParamName :: String, + abiParamType :: String, + abiParamComponents :: [AbiParam] + } + +contractAbiEntries :: Contract Name -> [AbiEntry] +contractAbiEntries = mapMaybe entry . decls + where + entry (CConstrDecl con) = + Just (AbiConstructor (map abiParam (constrParams con)) (stateMutability (constrPayable con))) + entry (CFunDecl (FunDef isPublic sig _)) + | sigName sig == fallbackName = Just (AbiFallback (stateMutability (sigPayable sig))) + | isPublic = + Just $ + AbiFunction + (nameStr (sigName sig)) + (map abiParam (sigParams sig)) + (abiOutputs (sigReturn sig)) + (stateMutability (sigPayable sig)) + | otherwise = Nothing + entry _ = Nothing + +-- | The ABI @stateMutability@ field admits four values: @pure@, @view@, +-- @nonpayable@ and @payable@. This prototype only tracks payability, not whether +-- a function reads or writes state, so we can only distinguish @payable@ from +-- @nonpayable@ and conservatively report the latter for everything else. +stateMutability :: Bool -> String +stateMutability payable = if payable then "payable" else "nonpayable" + +abiParam :: Param Name -> AbiParam +abiParam (Typed _ pname t) = mkAbiParam (nameStr pname) t +abiParam (Untyped _ pname) = AbiParam (nameStr pname) "" [] + +-- | A comma-separated return list @(a, b, c)@ desugars to nested pairs; the ABI +-- represents it as one output per element. A unit return has no outputs. +abiOutputs :: Maybe Ty -> [AbiParam] +abiOutputs Nothing = [] +abiOutputs (Just t) + | t == unit = [] + | otherwise = map (mkAbiParam "") (flattenTuple t) + +flattenTuple :: Ty -> [Ty] +flattenTuple (TyCon (Name "pair") [a, b]) = a : flattenTuple b +flattenTuple t = [t] + +mkAbiParam :: String -> Ty -> AbiParam +mkAbiParam pname t = + let (tyStr, comps) = abiTypeOf t + in AbiParam pname tyStr comps + +-- | Map a Solcore type to its canonical ABI type name and (for tuples) its +-- component parameters. Memory/calldata are location qualifiers and are +-- transparent to the ABI. The native @word@ maps to @uint256@; the remaining +-- value-type names (uint256, address, bytes32, bool, bytes, string, ...) already +-- match the Solidity ABI spelling and are passed through unchanged. +abiTypeOf :: Ty -> (String, [AbiParam]) +abiTypeOf (TyCon (Name "memory") [t]) = abiTypeOf t +abiTypeOf (TyCon (Name "calldata") [t]) = abiTypeOf t +abiTypeOf t@(TyCon (Name "pair") [_, _]) = + ("tuple", map (mkAbiParam "") (flattenTuple t)) +abiTypeOf (TyCon (Name "word") []) = ("uint256", []) +abiTypeOf (TyCon n _) = (nameStr n, []) +abiTypeOf t = (show t, []) + +abiEntryJson :: AbiEntry -> Json +abiEntryJson (AbiFunction fname ins outs mut) = + JObj + [ ("inputs", JArr (map abiParamJson ins)), + ("name", JStr fname), + ("outputs", JArr (map abiParamJson outs)), + ("stateMutability", JStr mut), + ("type", JStr "function") + ] +abiEntryJson (AbiConstructor ins mut) = + JObj + [ ("inputs", JArr (map abiParamJson ins)), + ("stateMutability", JStr mut), + ("type", JStr "constructor") + ] +abiEntryJson (AbiFallback mut) = + JObj + [ ("stateMutability", JStr mut), + ("type", JStr "fallback") + ] + +abiParamJson :: AbiParam -> Json +abiParamJson p = + JObj $ + [ ("internalType", JStr (abiParamType p)), + ("name", JStr (abiParamName p)), + ("type", JStr (abiParamType p)) + ] + <> [("components", JArr (map abiParamJson (abiParamComponents p))) | not (null (abiParamComponents p))] + +--- Minimal JSON rendering --- + +data Json + = JStr String + | JArr [Json] + | JObj [(String, Json)] + +renderJson :: Json -> String +renderJson = go 0 + where + go _ (JStr s) = jsonString s + go _ (JArr []) = "[]" + go ind (JArr xs) = + "[\n" + <> intercalate ",\n" [indent (ind + 1) <> go (ind + 1) x | x <- xs] + <> "\n" + <> indent ind + <> "]" + go _ (JObj []) = "{}" + go ind (JObj kvs) = + "{\n" + <> intercalate ",\n" [indent (ind + 1) <> jsonString k <> ": " <> go (ind + 1) v | (k, v) <- kvs] + <> "\n" + <> indent ind + <> "}" + indent n = replicate (2 * n) ' ' + +jsonString :: String -> String +jsonString s = '"' : concatMap esc s <> "\"" + where + esc '"' = "\\\"" + esc '\\' = "\\\\" + esc c = [c] diff --git a/src/Solcore/Pipeline/Options.hs b/src/Solcore/Pipeline/Options.hs index 35efef7ca..110e5059a 100644 --- a/src/Solcore/Pipeline/Options.hs +++ b/src/Solcore/Pipeline/Options.hs @@ -8,6 +8,8 @@ data Option optRootDir :: !FilePath, optImportDirs :: !String, optExternalLibs :: ![String], + optOutputDir :: !FilePath, + optEmitAbi :: !Bool, optNoSpec :: !Bool, optNoDesugarCalls :: !Bool, optNoMatchCompiler :: !Bool, @@ -37,6 +39,8 @@ emptyOption path = optRootDir = ".", optImportDirs = "std", optExternalLibs = [], + optOutputDir = ".", + optEmitAbi = False, optNoSpec = False, optNoDesugarCalls = False, optNoMatchCompiler = False, @@ -100,6 +104,17 @@ options = <> help "Register an external library root for @NAME imports." ) ) + <*> strOption + ( long "output-dir" + <> short 'o' + <> metavar "DIR" + <> value (optOutputDir stdOpt) + <> help "Directory for generated output files (default: current directory)" + ) + <*> switch + ( long "abi" + <> help "Emit a JSON ABI file (.abi) for each contract" + ) <*> switch ( long "no-specialise" <> short 'n' diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs index 933ed6451..70938bf75 100644 --- a/src/Solcore/Pipeline/SolcorePipeline.hs +++ b/src/Solcore/Pipeline/SolcorePipeline.hs @@ -16,7 +16,7 @@ import Solcore.Backend.EmitHull (emitHull) import Solcore.Backend.Mast () import Solcore.Backend.MastEval (defaultFuel, eliminateDeadCode, evalCompUnit) import Solcore.Backend.Specialise (specialiseCompUnit) -import Solcore.Desugarer.ContractDispatch (contractDispatchTopDecls) +import Solcore.Desugarer.ContractDispatch (contractDispatchTopDecls, writeContractAbis) import Solcore.Desugarer.DecisionTreeCompiler (matchCompiler, showWarning) import Solcore.Desugarer.FieldAccess (fieldDesugarTopDecls) import Solcore.Desugarer.IfDesugarer (ifDesugarer) @@ -35,8 +35,9 @@ import Solcore.Frontend.TypeInference.SccAnalysis import Solcore.Frontend.TypeInference.TcEnv import Solcore.Frontend.TypeInference.TcModule import Solcore.Pipeline.Options (Option (..), argumentsParser, noDesugarOpt) -import System.Directory (makeAbsolute) +import System.Directory (createDirectoryIfMissing, makeAbsolute) import System.Exit (ExitCode (..), exitWith) +import System.FilePath (()) import System.TimeIt qualified as TimeIt -- main compiler driver function @@ -50,8 +51,10 @@ pipeline = do putStrLn err exitWith (ExitFailure 1) Right contracts -> do + let outDir = optOutputDir opts + unless (null contracts) (createDirectoryIfMissing True outDir) forM_ (zip [(1 :: Int) ..] contracts) $ \(i, c) -> do - let filename = "output" <> show i <> ".hull" + let filename = outDir "output" <> show i <> ".hull" putStrLn ("Writing to " ++ filename) writeFile filename (show c) @@ -290,6 +293,16 @@ prepareInferenceDeclsForTypeInference opts emitOutput imps inferenceDecls = do putStrLn "Contract field access desugaring:" putStrLn $ prettyInferenceDecls accessed + -- Emit a JSON ABI file for each of the module's own contracts, named + -- .abi. Gated by --abi. + liftIO $ when (optEmitAbi opts) $ do + let localTopDecls = + [ moduleInferenceDeclTopDecl d + | d <- accessed, + moduleInferenceDeclSegment d == ModuleLocalDecl + ] + writeContractAbis (optOutputDir opts) localTopDecls + -- contract dispatch generation dispatched <- liftIO $ diff --git a/test/ContractAbiTests.hs b/test/ContractAbiTests.hs new file mode 100644 index 000000000..755494879 --- /dev/null +++ b/test/ContractAbiTests.hs @@ -0,0 +1,129 @@ +module ContractAbiTests where + +import Solcore.Desugarer.ContractDispatch (contractAbiJson) +import Solcore.Frontend.Syntax +import Solcore.Primitives.Primitives (word) +import Test.Tasty +import Test.Tasty.HUnit + +contractAbiTests :: TestTree +contractAbiTests = + testGroup + "Contract ABI generation" + [ testCase "only public functions are exposed" $ + contractAbiJson onlyPublicContract @?= onlyPublicExpected, + testCase "constructor, payable, word and tuple returns" $ + contractAbiJson richContract @?= richExpected + ] + +-- Helpers for building sample contracts + +tyCon :: String -> Ty +tyCon n = TyCon (Name n) [] + +sig :: String -> [Param Name] -> Maybe Ty -> Bool -> Signature Name +sig fname params ret payable = + Signature + { sigVars = [], + sigContext = [], + sigName = Name fname, + sigParams = params, + sigRetComptime = False, + sigReturn = ret, + sigPayable = payable + } + +fun :: Bool -> Signature Name -> ContractDecl Name +fun isPublic s = CFunDecl (FunDef isPublic s []) + +-- A contract with one public and one private function. + +onlyPublicContract :: Contract Name +onlyPublicContract = + Contract + (Name "Sample") + [] + [ fun True (sig "get" [] (Just (tyCon "uint256")) False), + fun False (sig "secret" [] (Just (tyCon "uint256")) False) + ] + +onlyPublicExpected :: String +onlyPublicExpected = + unlines + [ "[", + " {", + " \"inputs\": [],", + " \"name\": \"get\",", + " \"outputs\": [", + " {", + " \"internalType\": \"uint256\",", + " \"name\": \"\",", + " \"type\": \"uint256\"", + " }", + " ],", + " \"stateMutability\": \"nonpayable\",", + " \"type\": \"function\"", + " }", + "]" + ] + +-- A contract exercising a constructor, a payable function, the native `word` +-- type (mapped to uint256) and a tuple return flattened to two outputs. + +richContract :: Contract Name +richContract = + Contract + (Name "Token") + [] + [ CConstrDecl (Constructor [Typed False (Name "amount") word] [] False), + fun + True + ( sig + "pay" + [Typed False (Name "to") (tyCon "address")] + (Just (TyCon (Name "pair") [word, tyCon "bool"])) + True + ) + ] + +richExpected :: String +richExpected = + unlines + [ "[", + " {", + " \"inputs\": [", + " {", + " \"internalType\": \"uint256\",", + " \"name\": \"amount\",", + " \"type\": \"uint256\"", + " }", + " ],", + " \"stateMutability\": \"nonpayable\",", + " \"type\": \"constructor\"", + " },", + " {", + " \"inputs\": [", + " {", + " \"internalType\": \"address\",", + " \"name\": \"to\",", + " \"type\": \"address\"", + " }", + " ],", + " \"name\": \"pay\",", + " \"outputs\": [", + " {", + " \"internalType\": \"uint256\",", + " \"name\": \"\",", + " \"type\": \"uint256\"", + " },", + " {", + " \"internalType\": \"bool\",", + " \"name\": \"\",", + " \"type\": \"bool\"", + " }", + " ],", + " \"stateMutability\": \"payable\",", + " \"type\": \"function\"", + " }", + "]" + ] diff --git a/test/Main.hs b/test/Main.hs index d04a27e24..0018d1fec 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,6 +1,7 @@ module Main where import Cases +import ContractAbiTests import HullCases import MatchCompilerTests import ModuleTypeCheckTests @@ -25,6 +26,7 @@ tests = imports, moduleTypeCheckTests, dispatches, + contractAbiTests, matchTests, yulEvalTests, hullTests