morley-client-0.1.0: app/Main.hs

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

module Main
  ( main
  ) where

import Control.Exception.Safe (throwString)
import qualified Data.Aeson as Aeson
import Data.Default (def)
import Fmt (pretty)
import GHC.IO.Encoding (setFileSystemEncoding)
import qualified Options.Applicative as Opt
import System.IO (utf8)

import Morley.Client
import Morley.Client.Parser
import Morley.Client.RPC (BlockOperation(..), OperationResp(..))
import Morley.Client.RPC.Getters
import Morley.Client.Util (extractAddressesFromValue)
import Morley.Michelson.Runtime (prepareContract)
import Morley.Michelson.TypeCheck (typeCheckContract, typeCheckingWith, typeVerifyParameter)
import Morley.Michelson.Typed (Contract, Contract'(..), SomeContract(..))
import Morley.Michelson.Typed.Value (Value'(..))
import qualified Morley.Michelson.Untyped as U
import Morley.Tezos.Address (Address(..), formatAddress)
import Morley.Tezos.Core (prettyTez)
import Morley.Util.Exception (throwLeft)
import Morley.Util.Main (wrapMain)

mainImpl :: ClientArgsRaw -> MorleyClientM ()
mainImpl cmd =
  case cmd of
    Originate OriginateArgs{..} -> do
      contract <- liftIO $ prepareContract oaMbContractFile
      let originator = oaOriginateFrom
      (operationHash, contractAddr) <-
        originateUntypedContract True oaContractName originator oaInitialBalance
        contract oaInitialStorage oaMbFee

      putTextLn "Contract was successfully deployed."
      putTextLn $ "Operation hash: " <> pretty operationHash
      putTextLn $ "Contract address: " <> formatAddress contractAddr

    Transfer TransferArgs{..} -> do
      sendAddress <- resolveAddress taSender
      destAddress <- resolveAddress taDestination
      operationHash <- case destAddress of
        ContractAddress _ -> do
          contract <- getContract destAddress
          SomeContract fullContract <-
            throwLeft $ pure $ typeCheckingWith def $ typeCheckContract contract
          case fullContract of
            (Contract{} :: Contract cp st) -> do
              let addrs = extractAddressesFromValue taParameter
              tcOriginatedContracts <- getContractsParameterTypes addrs
              parameter <- throwLeft $ pure $ typeCheckingWith def $
                typeVerifyParameter @cp tcOriginatedContracts taParameter
              transfer sendAddress destAddress taAmount U.DefEpName parameter taMbFee
        KeyAddress _ -> case taParameter of
          U.ValueUnit -> transfer sendAddress destAddress taAmount U.DefEpName VUnit Nothing
          _ -> throwString ("The transaction parameter must be 'Unit' "
            <> "when transferring to an implicit account")

      putTextLn $ "Transaction was successfully sent.\nOperation hash " <> pretty operationHash <> "."

    GetBalance addrOrAlias -> do
      balance <- getBalance =<< resolveAddress addrOrAlias
      putTextLn $ prettyTez balance

    GetBlockHeader blockId -> do
      blockHeader <- getBlockHeader blockId
      putStrLn $ Aeson.encode blockHeader

    GetBlockOperations blockId -> do
      operationLists <- getBlockOperations blockId
      forM_ operationLists $ \operations -> do
        forM_ operations $ \BlockOperation {..} -> do
          putTextLn $ "Hash: " <> boHash
          putTextLn $ "Contents: "
          forM_ boContents $ \case
            TransactionOpResp to -> putStrLn $ Aeson.encode to
            OtherOpResp -> putTextLn "Non-transaction operation"
          putTextLn ""
      putTextLn "——————————————————————————————————————————————————\n"

main :: IO ()
main = wrapMain $ do
  -- grepcake: the following line is needed to parse CL arguments (argv) in
  -- utf-8. It might be necessary to add the similar line to other
  -- executables. However, I've filed the issue for `with-utf8`
  -- (https://github.com/serokell/haskell-with-utf8/issues/8). If it gets fixed
  -- in upstream, this line should be safe to remove. In that case, FIXME.
  setFileSystemEncoding utf8

  disableAlphanetWarning
  ClientArgs parsedConfig cmd <- Opt.execParser morleyClientInfo
  env <- mkMorleyClientEnv parsedConfig
  runMorleyClientM env (mainImpl cmd)