Parser.hs

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

module Morley.Client.Parser
  ( ClientArgs (..)
  , ClientArgsRaw (..)
  , OriginateArgs (..)
  , TransferArgs (..)
  , GetScriptSizeArgs (..)
  , 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 Options.Applicative qualified as Opt
import Options.Applicative.Help.Pretty (Doc, linebreak)
import Servant.Client (BaseUrl(..), parseBaseUrl)

import Morley.CLI (addressOrAliasOption, mutezOption, parserInfo, valueOption)
import Morley.Client.Init
import Morley.Client.RPC.Types (BlockId(HeadId))
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address.Alias (AddressOrAlias, Alias(..))
import Morley.Tezos.Core
import Morley.Util.CLI (mkCLOptionParser, mkCommandParser)
import Morley.Util.Named

data ClientArgs
  = ClientArgs MorleyClientConfig ClientArgsRaw

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

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

data GetScriptSizeArgs = GetScriptSizeArgs
  { ssScriptFile :: FilePath
  , ssStorage    :: U.Value
  }

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 <*> argsRawParser

clientConfigParser :: Opt.Parser MorleyClientConfig
clientConfigParser = do
  let mccSecretKey = Nothing
  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 'BlockId' type.
blockIdOption
  :: Maybe BlockId
  -> "name" :! String
  -> "help" :! String
  -> Opt.Parser BlockId
blockIdOption = mkCLOptionParser

argsRawParser :: Opt.Parser ClientArgsRaw
argsRawParser = subparser $ mconcat
  [ originateCmd
  , transferCmd
  , getBalanceCmd
  , getScriptSizeCmd
  , 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"
    getScriptSizeCmd =
      mkCommandParser "compute-script-size"
      (GetScriptSize <$> getScriptSizeArgsOption)
      "Compute script size"

originateArgsOption :: Opt.Parser OriginateArgs
originateArgsOption = do
  oaMbContractFile <- mbContractFileOption
  oaContractName <- contractNameOption
  oaInitialBalance <-
    mutezOption
      (Just zeroMutez)
      (#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 {..}

getScriptSizeArgsOption :: Opt.Parser GetScriptSizeArgs
getScriptSizeArgsOption = GetScriptSizeArgs <$> scriptFileOption
  <*> valueOption Nothing (#name :! "storage")
                          (#help :! "Contract storage value")

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

scriptFileOption :: Opt.Parser FilePath
scriptFileOption = strOption $ mconcat
  [ long "script", metavar "FILEPATH"
  , help "Path to script file"
  ]

contractNameOption :: Opt.Parser Alias
contractNameOption = fmap Alias . 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 zeroMutez)
      (#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 displayException . parseBaseUrl