-- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -- TODO [#712]: Remove this next major release {-# OPTIONS_GHC -Wno-deprecations #-} module Main ( main ) where import Data.Text.Lazy.IO.Utf8 qualified as Utf8 (writeFile) import Data.Version (showVersion) import Fmt (pretty) import Options.Applicative (execParser, footerDoc, fullDesc, header, help, helper, info, infoOption, long, progDesc, short, subparser, switch) import Options.Applicative qualified as Opt import Options.Applicative.Help.Pretty (Doc, linebreak) import Paths_morley (version) import Text.Hex (encodeHex) import Morley.CLI import Morley.Michelson.Analyzer (analyze) import Morley.Michelson.Optimizer (optimize) import Morley.Michelson.Printer (printSomeContract, printUntypedContract) import Morley.Michelson.Runtime (TxData(..), originateContract, prepareContract, prepareContractExt, runContract, transfer) import Morley.Michelson.Runtime.GState (genesisAddress) import Morley.Michelson.TypeCheck (tcVerbose, typeCheckContract, typeCheckingWith) import Morley.Michelson.TypeCheck qualified as TypeCheck import Morley.Michelson.TypeCheck.Types (mapSomeContract) import Morley.Michelson.Typed (Contract'(..), SomeContract(..)) import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address (Address) import Morley.Tezos.Core (Mutez, Timestamp(..), tz) import Morley.Tezos.Crypto import Morley.Tezos.Crypto.Timelock (chestBytes, chestKeyBytes, createChestAndChestKey) import Morley.Util.CLI (mkCommandParser, outputOption) import Morley.Util.Main (wrapMain) import Morley.Util.Named import REPL ---------------------------------------------------------------------------- -- Command line options ---------------------------------------------------------------------------- data CmdLnArgs = Print ("input" :? FilePath) ("output" :? FilePath) ("singleLine" :! Bool) | Optimize OptimizeOptions | Analyze AnalyzeOptions | TypeCheck TypeCheckOptions | Run RunOptions | Originate OriginateOptions | Transfer TransferOptions | CreateChest CreateChestOptions | REPL data OptimizeOptions = OptimizeOptions { optoContractFile :: Maybe FilePath , optoOutput :: Maybe FilePath , optoSingleLine :: Bool } data AnalyzeOptions = AnalyzeOptions { aoContractFile :: Maybe FilePath } data CreateChestOptions = CreateChestOptions { ccPayload :: ByteString , ccTime :: TLTime } data TypeCheckOptions = TypeCheckOptions { tcoContractFile :: Maybe FilePath , tcoTcOptions :: TypeCheck.TypeCheckOptions } data RunOptions = RunOptions { roContractFile :: Maybe FilePath , roDBPath :: FilePath , roTcOptions :: TypeCheck.TypeCheckOptions , 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 , ooTcOptions :: TypeCheck.TypeCheckOptions , ooOriginator :: Address , ooDelegate :: Maybe KeyHash , ooStorageValue :: U.Value , ooBalance :: Mutez , ooVerbose :: Bool } data TransferOptions = TransferOptions { toDBPath :: FilePath , toTcOptions :: TypeCheck.TypeCheckOptions , toDestination :: Address , toTxData :: TxData , toNow :: Maybe Timestamp , toLevel :: Maybe Natural , toMaxSteps :: Word64 , toVerbose :: Bool , toDryRun :: Bool } argParser :: Opt.Parser (Bool, CmdLnArgs) argParser = ((,) <$> enableExtsOption <*>) . subparser $ printSubCmd <> typecheckSubCmd <> emulateSubCmd <> optimizeSubCmd <> analyzeSubCmd <> createChestSubCmd <> replSubCmd where enableExtsOption = switch $ long "deprecated-morley-extensions" <> help "Enable parsing deprecated Morley extensions" 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: tezos-client") emulateSubCmd = mkCommandParser "emulate" (subparser $ runSubCmd <> originateSubCmd <> transferSubCmd) ("Set of commands to run in an emulated environment") 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." createChestSubCmd = mkCommandParser "create_chest" (CreateChest <$> createChestOptions) "Create a timelocked chest and key." 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" typeCheckOptionsOption :: Opt.Parser TypeCheck.TypeCheckOptions typeCheckOptionsOption = do tcVerbose <- verboseFlag tcStrict <- fmap not . switch $ long "typecheck-lax" <> help "Whether actions permitted in `tezos-client run` but forbidden in \ \e.g. `tezos-client originate` should be allowed here" return TypeCheck.TypeCheckOptions{..} typeCheckOptions :: Opt.Parser TypeCheckOptions typeCheckOptions = TypeCheckOptions <$> optional contractFileOption <*> typeCheckOptionsOption defaultBalance :: Mutez defaultBalance = [tz|4|] optimizeOptions :: Opt.Parser OptimizeOptions optimizeOptions = OptimizeOptions <$> optional contractFileOption <*> outputOption <*> onelineOption analyzeOptions :: Opt.Parser AnalyzeOptions analyzeOptions = AnalyzeOptions <$> optional contractFileOption createChestOptions :: Opt.Parser CreateChestOptions createChestOptions = CreateChestOptions <$> payloadOption <*> timeOption runOptions :: Opt.Parser RunOptions runOptions = RunOptions <$> optional contractFileOption <*> dbPathOption <*> typeCheckOptionsOption <*> 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 <*> typeCheckOptionsOption <*> 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 toTcOptions <- typeCheckOptionsOption toDestination <- addressOption Nothing (#name :! "to") (#help :! "Destination address") toTxData <- txDataOption toNow <- nowOption toLevel <- levelOption toMaxSteps <- maxStepsOption toVerbose <- verboseFlag toDryRun <- dryRunFlag pure TransferOptions {..} -- | Most permitting options, when we don't care much about typechecking. laxTcOptions :: TypeCheck.TypeCheckOptions laxTcOptions = TypeCheck.TypeCheckOptions { TypeCheck.tcVerbose = False , TypeCheck.tcStrict = False } ---------------------------------------------------------------------------- -- Actual main ---------------------------------------------------------------------------- main :: IO () main = wrapMain $ do (exts, cmdLnArgs) <- execParser programInfo run exts 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 :: Bool -> CmdLnArgs -> IO () run exts 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 . typeCheckingWith laxTcOptions $ typeCheckContract untypedContract 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 . typeCheckingWith laxTcOptions $ typeCheckContract untypedContract putTextLn $ pretty $ analyze (cCode contract) TypeCheck TypeCheckOptions{..} -> do morleyContract <- prepareContract' tcoContractFile -- At the moment of writing, 'tcStrict' option does not change anything -- because it affects only values parsing; but this may change contract <- either throwM pure . typeCheckingWith tcoTcOptions $ typeCheckContract morleyContract when (TypeCheck.tcVerbose tcoTcOptions) $ putStrLn $ printSomeContract False contract putTextLn "Contract is well-typed" Run RunOptions {..} -> do michelsonContract <- prepareContract' roContractFile void $ runContract roNow roLevel roMaxSteps roInitBalance roDBPath roTcOptions roStorageValue michelsonContract roTxData ! #verbose roVerbose ! #dryRun (not roWrite) Originate OriginateOptions {..} -> do michelsonContract <- prepareContract' ooContractFile addr <- originateContract ooDBPath ooTcOptions ooOriginator ooDelegate ooBalance ooStorageValue michelsonContract ! #verbose ooVerbose putTextLn $ "Originated contract " <> pretty addr Transfer TransferOptions {..} -> do transfer toNow toLevel toMaxSteps toDBPath toTcOptions toDestination toTxData ! #verbose toVerbose ! #dryRun toDryRun REPL -> runRepl CreateChest CreateChestOptions {..} -> do (chest, key) <- createChestAndChestKey ccPayload ccTime putStrLn $ "Chest: 0x" <> encodeHex (chestBytes chest) putStrLn $ "Key: 0x" <> encodeHex (chestKeyBytes key) where -- TODO [#712]: Remove this next major release prepareContract' | exts = prepareContractExt | otherwise = prepareContract usageDoc :: Maybe Doc usageDoc = Just $ mconcat [ "You can use help for specific COMMAND", linebreak , "EXAMPLE:", linebreak , " morley emulate 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 emulate 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"]