CLI.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-orphans #-}

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

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

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

import Morley.Michelson.Parser (MichelsonSource(..))
import Morley.Michelson.Parser qualified as P
import Morley.Michelson.Runtime (TxData(..), TxParam(..))
import Morley.Michelson.Runtime.GState (genesisAddress)
import Morley.Michelson.Text (MText)
import Morley.Michelson.Untyped (EpName)
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address (Address)
import Morley.Tezos.Core (Mutez, Timestamp, parseTimestamp, timestampFromSeconds)
import Morley.Tezos.Crypto
import Morley.Util.CLI
import Morley.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 timelocked chest payload.
payloadOption :: Opt.Parser ByteString
payloadOption = strOption $
  long "payload" <>
  metavar "PAYLOAD" <>
  help "Chest payload"

-- | Parser for timelocked chest time.
timeOption :: Opt.Parser TLTime
timeOption = mkCLOptionParser
  Nothing
  (#name :! "time")
  (#help :! "Time constant for timelocked chest")

-- | 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)


levelOption :: Opt.Parser (Maybe Natural)
levelOption = optional $ option parser $
  long "level" <>
  metavar "NATURAL" <>
  help "Level of the block in transaction chain"
  where
    parser = Opt.maybeReader (Just . read)

-- | 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 = TxUntypedParam 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 'SecretKey' type.
secretKeyOption ::
  Maybe SecretKey -> "name" :! String -> "help" :! String -> Opt.Parser SecretKey
secretKeyOption = 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 MSCli .
        toText
  getMetavar = "MICHELSON VALUE"