-- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA 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, 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(..), unContractCode) import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address import Morley.Tezos.Address.Alias 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 , roMinBlockTime :: Maybe Natural , roMaxSteps :: Word64 , roInitBalance :: Mutez , roWrite :: Bool } data OriginateOptions = OriginateOptions { ooContractFile :: Maybe FilePath , ooDBPath :: FilePath , ooTcOptions :: TypeCheck.TypeCheckOptions , ooOriginator :: ImplicitAddress , ooAlias :: Maybe ContractAlias , ooDelegate :: Maybe KeyHash , ooStorageValue :: U.Value , ooBalance :: Mutez , ooVerbose :: Bool } data TransferOptions = TransferOptions { toDBPath :: FilePath , toTcOptions :: TypeCheck.TypeCheckOptions , toDestination :: SomeAddressOrAlias , toTxData :: TxData , toNow :: Maybe Timestamp , toLevel :: Maybe Natural , toMinBlockTime :: Maybe Natural , toMaxSteps :: Word64 , toVerbose :: Bool , toDryRun :: Bool } argParser :: Opt.Parser CmdLnArgs argParser = subparser $ printSubCmd <> typecheckSubCmd <> emulateSubCmd <> optimizeSubCmd <> analyzeSubCmd <> createChestSubCmd <> replSubCmd where 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: `octez-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 `octez-client run` but forbidden in \ \e.g. `octez-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 <*> minBlockTimeOption <*> 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 (aliasOption "alias") <*> 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 <- someAddressOrAliasOption Nothing (#name :! "to") (#help :! "Address or alias of the transfer's destination.") toTxData <- txDataOption toNow <- nowOption toLevel <- levelOption toMinBlockTime <- minBlockTimeOption 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 $ run =<< execParser programInfo 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 . 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 (unContractCode $ 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 roMinBlockTime roMaxSteps roInitBalance roDBPath roTcOptions roStorageValue michelsonContract roTxData ! #verbose roVerbose ! #dryRun (not roWrite) Originate OriginateOptions {..} -> do michelsonContract <- prepareContract ooContractFile addr <- originateContract ooDBPath ooTcOptions ooOriginator ooAlias ooDelegate ooBalance ooStorageValue michelsonContract ! #verbose ooVerbose putTextLn $ "Originated contract " <> pretty addr Transfer TransferOptions {..} -> do transfer toNow toLevel toMinBlockTime 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) 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"]