CLI.hs

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

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Utilities for parsing Morley types using @optparse-applicative@.

module Morley.CLI
  ( -- * Full parsers
    parserInfo
    -- * Options
  , contractFileOption
  , nowOption
  , maxStepsOption
  , dbPathOption
  , txDataOption
  , keyHashOption
  , valueOption
  , mutezOption
  , addressOption
  , onelineOption
  , entrypointOption
  , mTextOption
  ) where

import Named (arg)
import Options.Applicative
  (footerDoc, fullDesc, header, help, helper, info, long, metavar, option, progDesc, strOption,
  switch)
import qualified Options.Applicative as Opt
import Options.Applicative.Help.Pretty (Doc)

import qualified Michelson.Parser as P
import Michelson.Runtime (TxData(..))
import Michelson.Runtime.GState (genesisAddress)
import Michelson.Text (MText)
import Michelson.Untyped (EpName)
import qualified Michelson.Untyped as U
import Tezos.Address (Address)
import Tezos.Core (Mutez, Timestamp, parseTimestamp, timestampFromSeconds)
import Tezos.Crypto
import Util.CLI
import Util.Named

----------------------------------------------------------------------------
-- These options are mostly specifications of 'mkCLOptionParser'
-- for concrete types (with more specific names).
----------------------------------------------------------------------------

-- | Full parser for a client.
parserInfo
  :: "usage" :! Doc
  -> "description" :! String
  -> "header" :! String
  -> "parser" :! Opt.Parser s
  -> Opt.ParserInfo s
parserInfo
  (arg #usage -> usage)
  (arg #description -> description)
  (arg #header -> clientHeader)
  (arg #parser -> parser) =
  info (helper <*> parser) $
  mconcat
    [ fullDesc
    , progDesc description
    , header clientHeader
    , footerDoc $ pure usage
    ]

-- | Parser for path to a contract code.
contractFileOption :: Opt.Parser FilePath
contractFileOption = strOption $
  long "contract" <>
  metavar "FILEPATH" <>
  help "Path to contract file"

-- | Parser for the time returned by @NOW@ instruction.
nowOption :: Opt.Parser (Maybe Timestamp)
nowOption = optional $ option parser $
  long "now" <>
  metavar "TIMESTAMP" <>
  help "Timestamp that you want the runtime interpreter to use (default is now)"
  where
    parser =
      (timestampFromSeconds <$> Opt.auto) <|>
      Opt.maybeReader (parseTimestamp . toText)

-- | Parser for gas limit on contract execution.
maxStepsOption :: Opt.Parser Word64
maxStepsOption = mkCLOptionParser
  (Just 100500)
  (#name .! "max-steps")
  (#help .! "Max steps that you want the runtime interpreter to use")

-- | Parser for path to database with Morley state.
dbPathOption :: Opt.Parser FilePath
dbPathOption = Opt.strOption $
  long "db" <>
  metavar "FILEPATH" <>
  Opt.value "db.json" <>
  help "Path to DB with data which is used instead of real blockchain data" <>
  Opt.showDefault

-- | Parser for transaction parameters.
txDataOption :: Opt.Parser TxData
txDataOption =
  mkTxData
    <$> addressOption (Just genesisAddress)
      (#name .! "sender") (#help .! "Sender address")
    <*> valueOption Nothing
      (#name .! "parameter") (#help .! "Parameter of passed contract")
    <*> mutezOption (Just minBound)
      (#name .! "amount") (#help .! "Amount sent by a transaction")
    <*> entrypointOption (#name .! "entrypoint") (#help .! "Entrypoint to call")
  where
    mkTxData :: Address -> U.Value -> Mutez -> EpName -> TxData
    mkTxData addr param amount epName =
      TxData
        { tdSenderAddress = addr
        , tdParameter = param
        , tdEntrypoint = epName
        , tdAmount = amount
        }

-- | Generic parser to read an option of 'KeyHash' type.
keyHashOption ::
  Maybe KeyHash -> "name" :! String -> "help" :! String -> Opt.Parser KeyHash
keyHashOption = mkCLOptionParser

-- | Generic parser to read an option of 'U.Value' type.
valueOption ::
  Maybe U.Value -> "name" :! String -> "help" :! String -> Opt.Parser U.Value
valueOption = mkCLOptionParser

-- | Generic parser to read an option of 'Mutez' type.
mutezOption ::
  Maybe Mutez -> "name" :! String -> "help" :! String -> Opt.Parser Mutez
mutezOption = mkCLOptionParser

-- | Generic parser to read an option of 'Address' type.
addressOption ::
  Maybe Address -> "name" :! String -> "help" :! String -> Opt.Parser Address
addressOption = mkCLOptionParser

-- | @--oneline@ flag.
onelineOption :: Opt.Parser Bool
onelineOption = switch (
  long "oneline" <>
  help "Force single line output")

-- | Generic parser to read an option of 'EpName' type.
entrypointOption :: "name" :! String -> "help" :! String -> Opt.Parser EpName
entrypointOption = mkCLOptionParser (Just U.DefEpName)

-- | Generic parser to read an option of 'MText' type.
mTextOption ::
  Maybe MText -> "name" :! String -> "help" :! String -> Opt.Parser MText
mTextOption = mkCLOptionParser

----------------------------------------------------------------------------
-- 'HasCLReader' orphan instances (better to avoid)
----------------------------------------------------------------------------

-- This instance uses parser which is not in the place where 'U.Value'
-- is defined, hence it is orphan.
instance HasCLReader U.Value where
  getReader = eitherReader parseValue
    where
      parseValue :: String -> Either String U.Value
      parseValue =
        first (mappend "Failed to parse value: " . displayException) .
        P.parseExpandValue .
        toText
  getMetavar = "MICHELSON VALUE"