morley-1.3.0: app/Main.hs
-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ
module Main
( main
) where
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 System.IO (utf8)
import Text.Pretty.Simple (pPrint)
import Michelson.Analyzer (analyze)
import Michelson.Macro (expandContract)
import Michelson.Optimizer (optimize)
import Michelson.Printer (printSomeContract, printUntypedContract)
import Michelson.Runtime
(TxData(..), originateContract, prepareContract, readAndParseContract, runContract, transfer,
typeCheckWithDb)
import Michelson.Runtime.GState (genesisAddress)
import Michelson.TypeCheck.Types (SomeContract(..), mapSomeContract)
import Michelson.Typed (Contract(..))
import qualified Michelson.Untyped as U
import Morley.CLI
import Tezos.Address (Address)
import Tezos.Core (Mutez, Timestamp(..), unsafeMkMutez)
import Tezos.Crypto
import Util.CLI (outputOption)
import Util.Exception (displayUncaughtException)
import Util.IO (hSetTranslit, withEncoding, writeFileUtf8)
import Util.Named
----------------------------------------------------------------------------
-- Command line options
----------------------------------------------------------------------------
data CmdLnArgs
= Parse (Maybe FilePath) Bool
| Print ("input" :? FilePath) ("output" :? FilePath) ("singleLine" :! Bool)
| Optimize OptimizeOptions
| Analyze AnalyzeOptions
| TypeCheck TypeCheckOptions
| Run RunOptions
| Originate OriginateOptions
| Transfer TransferOptions
data OptimizeOptions = OptimizeOptions
{ optoContractFile :: Maybe FilePath
, optoDBPath :: FilePath
, optoOutput :: Maybe FilePath
, optoSingleLine :: Bool
}
data AnalyzeOptions = AnalyzeOptions
{ aoContractFile :: Maybe FilePath
, aoDBPath :: FilePath
}
data TypeCheckOptions = TypeCheckOptions
{ tcoContractFile :: Maybe FilePath
, tcoDBPath :: FilePath
, tcoVerbose :: Bool
}
data RunOptions = RunOptions
{ roContractFile :: Maybe FilePath
, roDBPath :: FilePath
, roStorageValue :: U.Value
, roTxData :: TxData
, roVerbose :: Bool
, roNow :: Maybe Timestamp
, 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
, toMaxSteps :: Word64
, toVerbose :: Bool
, toDryRun :: Bool
}
argParser :: Opt.Parser CmdLnArgs
argParser = subparser $
parseSubCmd <>
printSubCmd <>
typecheckSubCmd <>
runSubCmd <>
originateSubCmd <>
transferSubCmd <>
optimizeSubCmd <>
analyzeSubCmd
where
mkCommandParser commandName parser desc =
command commandName $
info (helper <*> parser) $
progDesc desc
parseSubCmd =
mkCommandParser "parse"
(uncurry Parse <$> parseOptions)
"Parse passed contract"
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"
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
<*> dbPathOption
<*> verboseFlag
parseOptions :: Opt.Parser (Maybe FilePath, Bool)
parseOptions = (,)
<$> optional contractFileOption
<*> switch (
long "expand-macros" <>
help "Whether expand macros after parsing or not")
defaultBalance :: Mutez
defaultBalance = unsafeMkMutez 4000000
optimizeOptions :: Opt.Parser OptimizeOptions
optimizeOptions = OptimizeOptions
<$> optional contractFileOption
<*> dbPathOption
<*> outputOption
<*> onelineOption
analyzeOptions :: Opt.Parser AnalyzeOptions
analyzeOptions = AnalyzeOptions
<$> optional contractFileOption
<*> dbPathOption
runOptions :: Opt.Parser RunOptions
runOptions =
RunOptions
<$> optional contractFileOption
<*> dbPathOption
<*> valueOption Nothing (#name .! "storage")
(#help .! "Initial storage of a running contract")
<*> txDataOption
<*> verboseFlag
<*> nowOption
<*> 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
toMaxSteps <- maxStepsOption
toVerbose <- verboseFlag
toDryRun <- dryRunFlag
pure TransferOptions {..}
----------------------------------------------------------------------------
-- Actual main
----------------------------------------------------------------------------
main :: IO ()
main = displayUncaughtException $ withEncoding stdin utf8 $ do
hSetTranslit stdout
hSetTranslit stderr
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
Parse mFilename hasExpandMacros -> do
contract <- readAndParseContract mFilename
if hasExpandMacros
then pPrint $ expandContract contract
else pPrint contract
Print (argF #input -> mInputFile)
(argF #output -> mOutputFile)
(arg #singleLine -> forceSingleLine) -> do
contract <- prepareContract mInputFile
let write = maybe putStrLn writeFileUtf8 mOutputFile
write $ printUntypedContract forceSingleLine contract
Optimize OptimizeOptions{..} -> do
untypedContract <- prepareContract optoContractFile
checkedContract <- either throwM pure =<<
typeCheckWithDb optoDBPath untypedContract
let optimizedContract = mapSomeContract optimize checkedContract
let write = maybe putStrLn writeFileUtf8 optoOutput
write $ printSomeContract optoSingleLine optimizedContract
Analyze AnalyzeOptions{..} -> do
untypedContract <- prepareContract aoContractFile
SomeContract contract <- either throwM pure =<<
typeCheckWithDb aoDBPath untypedContract
putTextLn $ pretty $ analyze (cCode contract)
TypeCheck TypeCheckOptions{..} -> do
morleyContract <- prepareContract tcoContractFile
either throwM (const pass) =<< typeCheckWithDb tcoDBPath morleyContract
putTextLn "Contract is well-typed"
Run RunOptions {..} -> do
michelsonContract <- prepareContract roContractFile
runContract roNow roMaxSteps roInitBalance roDBPath roStorageValue michelsonContract roTxData
! #verbose roVerbose
! #dryRun (not roWrite)
Originate OriginateOptions {..} -> do
michelsonContract <- prepareContract ooContractFile
let origination = U.OriginationOperation
{ U.ooOriginator = ooOriginator
, U.ooDelegate = ooDelegate
, U.ooStorage = ooStorageValue
, U.ooBalance = ooBalance
, U.ooContract = michelsonContract
}
addr <- originateContract ooDBPath origination ! #verbose ooVerbose
putTextLn $ "Originated contract " <> pretty addr
Transfer TransferOptions {..} -> do
transfer toNow toMaxSteps toDBPath toDestination toTxData
! #verbose toVerbose
! #dryRun toDryRun
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"]