morley-client-0.3.1: src/Morley/Client/Parser.hs
-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA
module Morley.Client.Parser
( ClientArgs (..)
, ClientArgsRaw (..)
, OriginateArgs (..)
, TransferArgs (..)
, GetScriptSizeArgs (..)
, TicketBalanceArgs (..)
, TransferTicketArgs (..)
, 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, keyHashOption, mutezOption, parserInfo, someAddressOrAliasOption,
valueOption)
import Morley.Client.Init
import Morley.Client.RPC.Types (BlockId(HeadId))
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Core
import Morley.Tezos.Crypto
import Morley.Util.CLI (mkCLOptionParser, mkCommandParser)
import Morley.Util.Named
data ClientArgs
= ClientArgs MorleyClientConfig ClientArgsRaw
data ClientArgsRaw where
Originate :: OriginateArgs -> ClientArgsRaw
GetScriptSize :: GetScriptSizeArgs -> ClientArgsRaw
Transfer :: TransferArgs -> ClientArgsRaw
TransferTicket :: TransferTicketArgs -> ClientArgsRaw
GetBalance :: L1AddressKind kind => AddressOrAlias kind -> ClientArgsRaw
GetBlockHeader :: BlockId -> ClientArgsRaw
GetBlockOperations :: BlockId -> ClientArgsRaw
TicketBalance :: SomeAddressOrAlias -> TicketBalanceArgs -> ClientArgsRaw
AllTicketBalances :: ContractAddressOrAlias -> ClientArgsRaw
data OriginateArgs = OriginateArgs
{ oaMbContractFile :: Maybe FilePath
, oaContractName :: ContractAlias
, oaInitialBalance :: Mutez
, oaInitialStorage :: U.Value
, oaOriginateFrom :: ImplicitAddressOrAlias
, oaMbFee :: Maybe Mutez
, oaDelegate :: Maybe KeyHash
}
data GetScriptSizeArgs = GetScriptSizeArgs
{ ssScriptFile :: FilePath
, ssStorage :: U.Value
}
data TransferArgs = TransferArgs
{ taSender :: ImplicitAddressOrAlias
, taDestination :: SomeAddressOrAlias
, taAmount :: Mutez
, taParameter :: U.Value
, taMbFee :: Maybe Mutez
}
data TransferTicketArgs = TransferTicketArgs
{ ttaSender :: ImplicitAddressOrAlias
, ttaTicketContents :: U.Value
, ttaTicketType :: U.Ty
, ttaTicketTicketer :: ContractAddressOrAlias
, ttaTicketAmount :: Natural
, ttaDestination :: SomeAddressOrAlias
, ttaMbFee :: 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 `octez-client` binary."
, value "octez-client"
, Opt.showDefault
]
dataDirOption :: Opt.Parser (Maybe FilePath)
dataDirOption = optional $ strOption $
mconcat [ short 'd', long "data-dir", metavar "PATH"
, help "Path to `octez-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."
)
data TicketBalanceArgs = TicketBalanceArgs
{ tbaTicketer :: ContractAddress
, tbaContent :: U.Value
, tbaContentType :: U.Ty
}
getTicketBalanceOption :: Opt.Parser TicketBalanceArgs
getTicketBalanceOption = do
tbaTicketer <- mkCLOptionParser Nothing
(#name :! "ticketer")
(#help :! "The contract that issued the ticket.")
tbaContentType <- mkCLOptionParser Nothing
(#name :! "content-type")
(#help :! "Content type.")
tbaContent <- valueOption Nothing
(#name :! "content")
(#help :! "Ticket content.")
pure TicketBalanceArgs{..}
-- | 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
, transferTicketCmd
, getBalanceCmd
, getScriptSizeCmd
, getBlockHeaderCmd
, getBlockOperationsCmd
, getTicketBalanceCmd
, getAllTicketBalancesCmd
]
where
ownerOption f = f
Nothing
(#name :! "owner")
(#help :! "Ticket owner")
getTicketBalanceCmd =
mkCommandParser "ticket-balance"
(TicketBalance <$> ownerOption someAddressOrAliasOption <*> getTicketBalanceOption)
"Get ticket balance for specific tickets"
getAllTicketBalancesCmd =
mkCommandParser "all-ticket-balances"
(AllTicketBalances <$> ownerOption addressOrAliasOption)
"Get all ticket balances"
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."
transferTicketCmd =
mkCommandParser "transfer-ticket"
(TransferTicket <$> transferTicketArgsOption)
"Perform a ticket transfer to the given contract with given amount and parameter."
getBalanceCmd =
mkCommandParser "get-balance"
((GetBalance <$>
addressOrAliasOption @'AddressKindContract
Nothing
(#name :! "contract-addr")
(#help :! "Contract address or alias to get balance for."))
<|> (GetBalance <$> addressOrAliasOption @'AddressKindImplicit
Nothing
(#name :! "implicit-addr")
(#help :! "Implicit 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
oaDelegate <- optional $
keyHashOption
Nothing
(#name :! "delegate")
(#help :! "Key hash of the contract's delegate")
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 ContractAlias
contractNameOption = fmap ContractAlias . 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 <-
someAddressOrAliasOption
Nothing
(#name :! "to")
(#help :! "Address or alias of the transfer's destination.")
taAmount <-
mutezOption
(Just zeroMutez)
(#name :! "amount")
(#help :! "Transfer amount.")
taParameter <-
valueOption
Nothing
(#name :! "parameter")
(#help :! "Transfer parameter.")
taMbFee <- feeOption
pure $ TransferArgs {..}
transferTicketArgsOption :: Opt.Parser TransferTicketArgs
transferTicketArgsOption = do
ttaSender <- addressOrAliasOption Nothing
! #name "from"
! #help "Address or alias from which transfer is performed."
ttaTicketAmount <- mkCLOptionParser Nothing
! #name "amount"
! #help "Ticket amount."
ttaTicketContents <- mkCLOptionParser Nothing
! #name "value"
! #help "Ticket value."
ttaTicketType <- mkCLOptionParser Nothing
! #name "type"
! #help "Ticket type."
ttaTicketTicketer <- mkCLOptionParser Nothing
! #name "ticketer"
! #help "Ticketer address or alias."
ttaDestination <- someAddressOrAliasOption Nothing
! #name "to"
! #help "Address or alias of the transfer's destination."
ttaMbFee <- feeOption
pure $ TransferTicketArgs {..}
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