-- SPDX-FileCopyrightText: 2020 Tocqueville Group -- -- SPDX-License-Identifier: LicenseRef-MIT-TQ module Main ( main ) where import Data.Default (def) import qualified Data.Text.Lazy.IO.Utf8 as Utf8 (writeFile) import Data.Version (showVersion) import Fmt (pretty) import Named (arg, argF, (!)) import Options.Applicative (command, execParser, footerDoc, fullDesc, header, help, helper, info, infoOption, long, progDesc, short, subparser, switch) import qualified Options.Applicative as Opt import Options.Applicative.Help.Pretty (Doc, linebreak) import Paths_morley (version) import Michelson.Analyzer (analyze) import Michelson.Optimizer (optimize) import Michelson.Printer (printSomeContract, printUntypedContract) import Michelson.Runtime (TxData(..), originateContract, prepareContract, runContract, transfer) import Michelson.Runtime.GState (genesisAddress) import Michelson.TypeCheck (tcVerbose, typeCheckContract) import Michelson.TypeCheck.Types (SomeContract(..), mapSomeContract) import Michelson.Typed (Contract(..)) import qualified Michelson.Untyped as U import Morley.CLI import REPL import Tezos.Address (Address) import Tezos.Core (Mutez, Timestamp(..), unsafeMkMutez) import Tezos.Crypto import Util.CLI (outputOption) import Util.Main (wrapMain) import Util.Named ---------------------------------------------------------------------------- -- Command line options ---------------------------------------------------------------------------- data CmdLnArgs = Print ("input" :? FilePath) ("output" :? FilePath) ("singleLine" :! Bool) | Optimize OptimizeOptions | Analyze AnalyzeOptions | TypeCheck TypeCheckOptions | Run RunOptions | Originate OriginateOptions | Transfer TransferOptions | REPL data OptimizeOptions = OptimizeOptions { optoContractFile :: Maybe FilePath , optoOutput :: Maybe FilePath , optoSingleLine :: Bool } data AnalyzeOptions = AnalyzeOptions { aoContractFile :: Maybe FilePath } data TypeCheckOptions = TypeCheckOptions { tcoContractFile :: Maybe FilePath , tcoVerbose :: Bool } data RunOptions = RunOptions { roContractFile :: Maybe FilePath , roDBPath :: FilePath , roStorageValue :: U.Value , roTxData :: TxData , roVerbose :: Bool , roNow :: Maybe Timestamp , roLevel :: Maybe Natural , roMaxSteps :: Word64 , roInitBalance :: Mutez , roWrite :: Bool } data OriginateOptions = OriginateOptions { ooContractFile :: Maybe FilePath , ooDBPath :: FilePath , ooOriginator :: Address , ooDelegate :: Maybe KeyHash , ooStorageValue :: U.Value , ooBalance :: Mutez , ooVerbose :: Bool } data TransferOptions = TransferOptions { toDBPath :: FilePath , toDestination :: Address , toTxData :: TxData , toNow :: Maybe Timestamp , toLevel :: Maybe Natural , toMaxSteps :: Word64 , toVerbose :: Bool , toDryRun :: Bool } argParser :: Opt.Parser CmdLnArgs argParser = subparser $ printSubCmd <> typecheckSubCmd <> runSubCmd <> originateSubCmd <> transferSubCmd <> optimizeSubCmd <> analyzeSubCmd <> replSubCmd where mkCommandParser commandName parser desc = command commandName $ info (helper <*> parser) $ progDesc desc typecheckSubCmd = mkCommandParser "typecheck" (TypeCheck <$> typeCheckOptions) $ ("Typecheck passed contract") printSubCmd = mkCommandParser "print" (Print <$> (#input <.?> optional contractFileOption) <*> (#output <.?> outputOption) <*> (#singleLine <.!> onelineOption)) ("Parse a Morley contract and print corresponding Michelson " <> "contract that can be parsed by the OCaml reference client") runSubCmd = mkCommandParser "run" (Run <$> runOptions) $ "Run passed contract. \ \It's originated first and then a transaction is sent to it" replSubCmd = mkCommandParser "repl" (pure REPL) "Start a Morley REPL" originateSubCmd = mkCommandParser "originate" (Originate <$> originateOptions) "Originate passed contract. Add it to passed DB" transferSubCmd = mkCommandParser "transfer" (Transfer <$> transferOptions) "Transfer tokens to given address" optimizeSubCmd = mkCommandParser "optimize" (Optimize <$> optimizeOptions) "Optimize the contract." analyzeSubCmd = mkCommandParser "analyze" (Analyze <$> analyzeOptions) "Analyze the contract." verboseFlag :: Opt.Parser Bool verboseFlag = switch $ short 'v' <> long "verbose" <> help "Whether output should be verbose" writeFlag :: Opt.Parser Bool writeFlag = switch $ long "write" <> help "Whether updated DB should be written to DB file" dryRunFlag :: Opt.Parser Bool dryRunFlag = switch $ long "dry-run" <> help "Do not write updated DB to DB file" typeCheckOptions :: Opt.Parser TypeCheckOptions typeCheckOptions = TypeCheckOptions <$> optional contractFileOption <*> verboseFlag defaultBalance :: Mutez defaultBalance = unsafeMkMutez 4000000 optimizeOptions :: Opt.Parser OptimizeOptions optimizeOptions = OptimizeOptions <$> optional contractFileOption <*> outputOption <*> onelineOption analyzeOptions :: Opt.Parser AnalyzeOptions analyzeOptions = AnalyzeOptions <$> optional contractFileOption runOptions :: Opt.Parser RunOptions runOptions = RunOptions <$> optional contractFileOption <*> dbPathOption <*> valueOption Nothing (#name .! "storage") (#help .! "Initial storage of a running contract") <*> txDataOption <*> verboseFlag <*> nowOption <*> levelOption <*> maxStepsOption <*> mutezOption (Just defaultBalance) (#name .! "balance") (#help .! "Initial balance of this contract") <*> writeFlag originateOptions :: Opt.Parser OriginateOptions originateOptions = OriginateOptions <$> optional contractFileOption <*> dbPathOption <*> addressOption (Just genesisAddress) (#name .! "originator") (#help .! "Contract's originator") <*> optional (keyHashOption Nothing (#name .! "delegate") (#help .! "Contract's optional delegate") ) <*> valueOption Nothing (#name .! "storage") (#help .! "Initial storage of an originating contract") <*> mutezOption (Just defaultBalance) (#name .! "balance") (#help .! "Initial balance of an originating contract") <*> verboseFlag transferOptions :: Opt.Parser TransferOptions transferOptions = do toDBPath <- dbPathOption toDestination <- addressOption Nothing (#name .! "to") (#help .! "Destination address") toTxData <- txDataOption toNow <- nowOption toLevel <- levelOption toMaxSteps <- maxStepsOption toVerbose <- verboseFlag toDryRun <- dryRunFlag pure TransferOptions {..} ---------------------------------------------------------------------------- -- Actual main ---------------------------------------------------------------------------- main :: IO () main = wrapMain $ do cmdLnArgs <- execParser programInfo run cmdLnArgs where programInfo = info (helper <*> versionOption <*> argParser) $ mconcat [ fullDesc , progDesc "Morley: Haskell implementation of Michelson typechecker and interpreter" , header "Morley tools" , footerDoc $ usageDoc ] versionOption = infoOption ("morley-" <> showVersion version) (long "version" <> help "Show version.") run :: CmdLnArgs -> IO () run args = case args of Print (argF #input -> mInputFile) (argF #output -> mOutputFile) (arg #singleLine -> forceSingleLine) -> do contract <- prepareContract mInputFile let write = maybe putStrLn Utf8.writeFile mOutputFile write $ printUntypedContract forceSingleLine contract Optimize OptimizeOptions{..} -> do untypedContract <- prepareContract optoContractFile checkedContract <- either throwM pure $ typeCheckContract untypedContract def let optimizedContract = mapSomeContract optimize checkedContract let write = maybe putStrLn Utf8.writeFile optoOutput write $ printSomeContract optoSingleLine optimizedContract Analyze AnalyzeOptions{..} -> do untypedContract <- prepareContract aoContractFile SomeContract contract <- either throwM pure $ typeCheckContract untypedContract def putTextLn $ pretty $ analyze (cCode contract) TypeCheck TypeCheckOptions{..} -> do morleyContract <- prepareContract tcoContractFile contract <- either throwM pure $ typeCheckContract morleyContract def{ tcVerbose = tcoVerbose } when tcoVerbose (putStrLn $ printSomeContract False contract) putTextLn "Contract is well-typed" Run RunOptions {..} -> do michelsonContract <- prepareContract roContractFile void $ runContract roNow roLevel roMaxSteps roInitBalance roDBPath roStorageValue michelsonContract roTxData ! #verbose roVerbose ! #dryRun (not roWrite) Originate OriginateOptions {..} -> do michelsonContract <- prepareContract ooContractFile addr <- originateContract ooDBPath ooOriginator ooDelegate ooBalance ooStorageValue michelsonContract ! #verbose ooVerbose putTextLn $ "Originated contract " <> pretty addr Transfer TransferOptions {..} -> do transfer toNow toLevel toMaxSteps toDBPath toDestination toTxData ! #verbose toVerbose ! #dryRun toDryRun REPL -> runRepl usageDoc :: Maybe Doc usageDoc = Just $ mconcat [ "You can use help for specific COMMAND", linebreak , "EXAMPLE:", linebreak , " morley run --help", linebreak , linebreak , "Documentation for morley tools can be found at the following links:", linebreak , " https://gitlab.com/morley-framework/morley/blob/master/README.md", linebreak , " https://gitlab.com/morley-framework/morley/tree/master/docs", linebreak , linebreak , "Sample contracts for running can be found at the following link:", linebreak , " https://gitlab.com/morley-framework/morley/tree/master/contracts", linebreak , linebreak , "USAGE EXAMPLE:", linebreak , " morley parse --contract add1.tz", linebreak , linebreak , " This command will parse contract stored in add1.tz", linebreak , " and return its representation in haskell types", linebreak , linebreak , " morley originate --contract add1.tz --storage 1 --verbose", linebreak , linebreak , " This command will originate contract with code stored in add1.tz", linebreak , " with initial storage value set to 1 and return info about", linebreak , " originated contract: its balance, storage and contract code"]