Parser.hs

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

module Morley.Client.Parser
  ( ClientArgs (..)
  , ClientArgsRaw (..)
  , OriginateArgs (..)
  , TransferArgs (..)
  , addressOrAliasOption
  , clientConfigParser
  , morleyClientInfo
  , parserInfo

  , originateArgsOption
  , mbContractFileOption
  , contractNameOption

    -- * Parser utilities
  , baseUrlReader
  ) where

import Options.Applicative
  (ReadM, eitherReader, help, long, metavar, option, short, strOption, subparser, value)
import qualified Options.Applicative as Opt
import Options.Applicative.Help.Pretty (Doc, linebreak)
import Servant.Client (BaseUrl(..), parseBaseUrl)

import Morley.CLI
import Morley.Client.Init
import Morley.Client.RPC.Types (BlockId(HeadId))
import Morley.Client.TezosClient.Types (AddressOrAlias, AliasHint)
import qualified Morley.Michelson.Untyped as U
import Morley.Tezos.Core
import Morley.Util.CLI (mkCLOptionParser, mkCommandParser)
import Morley.Util.Named

data ClientArgs
  = ClientArgs MorleyClientConfig ClientArgsRaw

data ClientArgsRaw
  = Originate OriginateArgs
  | Transfer TransferArgs
  | GetBalance AddressOrAlias
  | GetBlockHeader BlockId
  | GetBlockOperations BlockId

data OriginateArgs = OriginateArgs
  { oaMbContractFile :: Maybe FilePath
  , oaContractName   :: AliasHint
  , oaInitialBalance :: Mutez
  , oaInitialStorage :: U.Value
  , oaOriginateFrom  :: AddressOrAlias
  , oaMbFee :: Maybe Mutez
  }

data TransferArgs = TransferArgs
  { taSender      :: AddressOrAlias
  , taDestination :: AddressOrAlias
  , taAmount      :: Mutez
  , taParameter   :: U.Value
  , taMbFee :: Maybe Mutez
  }

morleyClientInfo :: Opt.ParserInfo ClientArgs
morleyClientInfo =
  parserInfo
    (#usage :! usageDoc)
    (#description :! "Morley Client: RPC client for interaction with tezos node")
    (#header :! "Morley Client")
    (#parser :! clientParser)

-- | Parser for the @morley-client@ executable.
clientParser :: Opt.Parser ClientArgs
clientParser = ClientArgs <$> clientConfigParser (pure Nothing) <*> argsRawParser

clientConfigParser :: Opt.Parser (Maybe Text) -> Opt.Parser MorleyClientConfig
clientConfigParser prefixParser = do
  let mccSecretKey = Nothing
  mccAliasPrefix <- prefixParser
  mccEndpointUrl <- endpointOption
  mccTezosClientPath <- pathOption
  mccMbTezosClientDataDir <- dataDirOption
  mccVerbosity <- genericLength <$> many verboseSwitch
  pure MorleyClientConfig{..}
  where
    verboseSwitch :: Opt.Parser ()
    verboseSwitch = Opt.flag' () . mconcat $
      [ short 'V'
      , help "Increase verbosity (pass several times to increase further)"
      ]

-- | Parses URL of the Tezos node.
endpointOption :: Opt.Parser (Maybe BaseUrl)
endpointOption = optional . option baseUrlReader $
  long "endpoint"
  <> short 'E'
  <> help "URL of the remote Tezos node"
  <> metavar "URL"

pathOption :: Opt.Parser FilePath
pathOption = strOption $
  mconcat [ short 'I', long "client-path", metavar "PATH"
          , help "Path to tezos-client binary"
          , value "tezos-client"
          , Opt.showDefault
          ]

dataDirOption :: Opt.Parser (Maybe FilePath)
dataDirOption = optional $ strOption $
  mconcat [ short 'd', long "data-dir", metavar "PATH"
          , help "Path to tezos-client data directory"
          ]

feeOption :: Opt.Parser (Maybe Mutez)
feeOption = optional $ mutezOption
            Nothing
            (#name :! "fee")
            (#help :! "Fee that is going to be used for the transaction. \
                      \By default fee will be computed automatically."
            )

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

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

argsRawParser :: Opt.Parser ClientArgsRaw
argsRawParser = subparser $ mconcat
  [ originateCmd
  , transferCmd
  , getBalanceCmd
  , getBlockHeaderCmd
  , getBlockOperationsCmd
  ]
  where
    originateCmd =
      mkCommandParser "originate"
      (Originate <$> originateArgsOption)
      "Originate passed contract on real network"
    transferCmd =
      mkCommandParser "transfer"
      (Transfer <$> transferArgsOption)
      "Perform a transfer to the given contract with given amount and parameter"
    getBalanceCmd =
      mkCommandParser "get-balance"
      (GetBalance <$> addressOrAliasOption
        Nothing
        (#name :! "addr")
        (#help :! "Address or alias to get balance for.")
      )
      "Get balance for given address"
    getBlockHeaderCmd =
      mkCommandParser "get-block-header"
      (GetBlockHeader <$> blockIdOption
        (Just HeadId)
        (#name :! "block-id")
        (#help :! "Id of the block whose header will be queried.")
      )
      "Get header of a block"
    getBlockOperationsCmd =
      mkCommandParser "get-block-operations"
      (GetBlockOperations <$> blockIdOption
        (Just HeadId)
        (#name :! "block-id")
        (#help :! "Id of the block whose operations will be queried.")
      )
      "Get operations contained in a block"

originateArgsOption :: Opt.Parser OriginateArgs
originateArgsOption = do
  oaMbContractFile <- mbContractFileOption
  oaContractName <- contractNameOption
  oaInitialBalance <-
    mutezOption
      (Just (toMutez 0))
      (#name :! "initial-balance")
      (#help :! "Inital balance of the contract")
  oaInitialStorage <-
    valueOption
      Nothing
      (#name :! "initial-storage")
      (#help :! "Initial contract storage value")
  oaOriginateFrom <-
    addressOrAliasOption
      Nothing
      (#name :! "from")
      (#help :! "Address or alias of address from which origination is performed")
  oaMbFee <- feeOption
  pure $ OriginateArgs {..}

mbContractFileOption :: Opt.Parser (Maybe FilePath)
mbContractFileOption = optional . strOption $ mconcat
  [ long "contract", metavar "FILEPATH"
  , help "Path to contract file"
  ]

contractNameOption :: Opt.Parser AliasHint
contractNameOption = strOption $ mconcat
  [ long "contract-name"
  , value "stdin"
  , help "Alias of originated contract"
  ]

transferArgsOption :: Opt.Parser TransferArgs
transferArgsOption = do
  taSender <-
    addressOrAliasOption
      Nothing
      (#name :! "from")
      (#help :! "Address or alias from which transfer is performed")
  taDestination <-
    addressOrAliasOption
      Nothing
      (#name :! "to")
      (#help :! "Address or alias of the contract that receives transfer")
  taAmount <-
    mutezOption
      (Just (toMutez 0))
      (#name :! "amount")
      (#help :! "Transfer amount")
  taParameter <-
    valueOption
      Nothing
      (#name :! "parameter")
      (#help :! "Transfer parameter")
  taMbFee <- feeOption
  pure $ TransferArgs {..}

usageDoc :: Doc
usageDoc = mconcat
  [ "You can use help for specific COMMAND", linebreak
  , "EXAMPLE:", linebreak
  , "morley-client originate --help"
  , "USAGE EXAMPLE:", linebreak
  , "morley-client -E florence.testnet.tezos.serokell.team:8732 originate \\", linebreak
  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak
  , "  --contract ../contracts/tezos_examples/attic/add1.tz --initial-balance 1 --initial-storage 0", linebreak
  , linebreak
  , "  This command will originate contract with code stored in add1.tz", linebreak
  , "  on real network with initial balance 1 and initial storage set to 0", linebreak
  , "  and return info about operation: operation hash and originated contract address", linebreak
  , linebreak
  , "morley-client -E florence.testnet.tezos.serokell.team:8732 transfer \\", linebreak
  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak
  , "  --to KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW --amount 1 --parameter 0", linebreak
  , linebreak
  , "  This command will perform tranfer to contract with address on real network", linebreak
  , "  KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW with amount 1 and parameter 0", linebreak
  , "  as a result it will return operation hash"
  ]

--------------------------------------------------------------------------------
-- Parser utilities
--------------------------------------------------------------------------------

-- | Utility reader to use in parsing 'BaseUrl'.
baseUrlReader :: ReadM BaseUrl
baseUrlReader = eitherReader $ first show . parseBaseUrl