morley-1.7.1: app/Main.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Main
  ( main
  ) where

import qualified Data.Text.Lazy.IO.Utf8 as Utf8 (writeFile)
import Data.Version (showVersion)
import Fmt (pretty)
import Main.Utf8 (withUtf8)
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 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)
import Michelson.Runtime.GState (genesisAddress)
import Michelson.TypeCheck (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.Exception (displayUncaughtException)
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
  | 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
  , 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 <>
  replSubCmd
  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"

    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

    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
      <*> 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
        <*> 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 $ withUtf8 $ 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
      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 Utf8.writeFile mOutputFile
        write $ printUntypedContract forceSingleLine contract
      Optimize OptimizeOptions{..} -> do
        untypedContract <- prepareContract optoContractFile
        checkedContract <- either throwM pure $ 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 $ typeCheckContract untypedContract
        putTextLn $ pretty $ analyze (cCode contract)
      TypeCheck TypeCheckOptions{..} -> do
        morleyContract <- prepareContract tcoContractFile
        either throwM (const pass) $ typeCheckContract morleyContract
        putTextLn "Contract is well-typed"
      Run RunOptions {..} -> do
        michelsonContract <- prepareContract roContractFile
        void $ runContract roNow 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 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"]