Fee.hs

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

-- | Tests for fee calculation implementation in 'morley-client'.
module Test.Fee
  ( test_FeeCalculation
  ) where

import Data.List.NonEmpty qualified as NE
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

import Morley.Client.Action (transfer)
import Morley.Client.Action.Common
  (OriginationData(..), RevealData(..), TD(..), TransactionData(..), computeStorageLimit,
  revealKeyUnlessRevealed)
import Morley.Client.Action.Operation (dryRunOperationsNonEmpty)
import Morley.Client.Full (runMorleyClientM)
import Morley.Client.OnlyRPC
import Morley.Client.RPC.Getters (getProtocolParameters)
import Morley.Client.TezosClient.Impl
  (calcOriginationFee, calcRevealFee, calcTransferFee, importKey)
import Morley.Client.TezosClient.Types
  (AddressOrAlias(..), AliasOrAliasHint(..), CalcOriginationFeeData(..), CalcTransferFeeData(..))
import Morley.Client.Types
import Morley.Micheline.Json (TezosMutez(..))
import Morley.Michelson.Runtime.GState (genesisAddress)
import Morley.Michelson.Typed (IsoValue(..))
import Morley.Michelson.Untyped (pattern DefEpName)
import Morley.Tezos.Address
import Morley.Tezos.Core (tz, zeroMutez)
import Morley.Tezos.Crypto
import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519
import Test.Cleveland (NetworkEnv(neMorleyClientEnv), mkMorleyOnlyRpcEnvNetwork)
import Test.Cleveland.Internal.Abstract (Moneybag(..))
import Test.Cleveland.Internal.Client (setupMoneybagAddress)
import Test.Cleveland.Michelson.Import (importContract)
import Test.Cleveland.Tasty (whenNetworkEnabled)

import Test.Util.Contracts (contractsDir, (</>))

test_FeeCalculation :: IO TestTree
test_FeeCalculation = pure $ whenNetworkEnabled $ \withEnv ->
  testGroup "Compare morley-client fee calulation with tezos-client"
    [ testCase "single transfer in a batch has the same fee" $ do
      compareTransferFeeCalculation withEnv $ one $ trivialTransfer
    , testCase "multiple transfers in a batch have the same fee" $ do
      compareTransferFeeCalculation withEnv $ NE.fromList $ replicate 5 trivialTransfer
    , testCase "origination has the same fee" $ do
      soBigContract <- importContract @(ToT ()) @(ToT ()) $ contractsDir </> "so_big.tz"
      compareOriginationFeeCalculation withEnv $ OriginationData
        { odReplaceExisting = True
        , odName = "so_big"
        , odBalance = zeroMutez
        , odContract = soBigContract
        , odStorage = toVal ()
        , odMbFee = Nothing
        }
    , testCase "reveal has the same fee" $ do
      compareRevealFeeCalculation withEnv
    ]
  where
    trivialTransfer = TransactionData $ TD
      { tdReceiver = genesisAddress
      , tdAmount = 100
      , tdEpName = DefEpName
      , tdParam = toVal ()
      , tdMbFee = Nothing
      }

compareTransferFeeCalculation
  :: ((forall a. (NetworkEnv -> IO a) -> IO a)) -> NonEmpty TransactionData -> Assertion
compareTransferFeeCalculation withEnv transferBatch = withEnv $ \env -> do
  Moneybag moneybagAddr <- setupMoneybagAddress env
  runMorleyClientM (neMorleyClientEnv env) $ revealKeyUnlessRevealed moneybagAddr Nothing
  (appliedResults, feesMorleyClient) <- fmap (unzip . toList) $ runMorleyClientM (neMorleyClientEnv env) $
    dryRunOperationsNonEmpty (AddressResolved moneybagAddr) (map OpTransfer transferBatch)
  pp <- runMorleyClientM (neMorleyClientEnv env) getProtocolParameters
  feesTezosClient <- runMorleyClientM (neMorleyClientEnv env) $ calcTransferFee
    (AddressResolved moneybagAddr) Nothing (computeStorageLimit appliedResults pp)
    (map transactionDataToCalcTransferFeeData $ toList transferBatch)
  feesMorleyClient @?= feesTezosClient
  where
    transactionDataToCalcTransferFeeData :: TransactionData -> CalcTransferFeeData
    transactionDataToCalcTransferFeeData (TransactionData TD{..}) = CalcTransferFeeData
      { ctfdTo = AddressResolved $ tdReceiver
      , ctfdParam = tdParam
      , ctfdEp = tdEpName
      , ctfdAmount = TezosMutez tdAmount
      }

compareOriginationFeeCalculation
  :: ((forall a. (NetworkEnv -> IO a) -> IO a)) -> OriginationData -> Assertion
compareOriginationFeeCalculation withEnv od@OriginationData{..} = withEnv $ \env -> do
  Moneybag moneybagAddr <- setupMoneybagAddress env
  runMorleyClientM (neMorleyClientEnv env) $ revealKeyUnlessRevealed moneybagAddr Nothing
  (appliedResults, feesMorleyClient) <- fmap (unzip . toList) $ runMorleyClientM (neMorleyClientEnv env) $
    dryRunOperationsNonEmpty (AddressResolved moneybagAddr) (one $ OpOriginate od)
  pp <- runMorleyClientM (neMorleyClientEnv env) getProtocolParameters
  feeTezosClient <- runMorleyClientM (neMorleyClientEnv env) $ calcOriginationFee
    CalcOriginationFeeData
      { cofdFrom = AddressResolved moneybagAddr
      , cofdBalance = TezosMutez odBalance
      , cofdMbFromPassword = Nothing
      , cofdContract = odContract
      , cofdStorage = odStorage
      , cofdBurnCap = computeStorageLimit appliedResults pp
      }
  feesMorleyClient @?= [feeTezosClient]

compareRevealFeeCalculation
  :: ((forall a. (NetworkEnv -> IO a) -> IO a)) -> Assertion
compareRevealFeeCalculation withEnv = withEnv $ \env -> do
  sk <- SecretKeyEd25519 <$> liftIO Ed25519.randomSecretKey
  let pub = toPublic sk
  let addr = mkKeyAddress pub

  alias <- runMorleyClientM (neMorleyClientEnv env) do
    alias <- importKey True (AnAliasHint "rpc-revealed-key") sk
    Moneybag moneybag <- liftIO $ setupMoneybagAddress env
    void $ transfer moneybag addr [tz|1 milli|] DefEpName (toVal ()) Nothing
    return alias

  (appliedResults, feesRPC) :| [] <- runMorleyOnlyRpcM (mkMorleyOnlyRpcEnvNetwork env [sk]) do
    let rd = RevealData{ rdPublicKey = pub, rdMbFee = Nothing }
    dryRunOperationsNonEmpty (AddressResolved addr) (one $ OpReveal rd)

  pp <- runMorleyClientM (neMorleyClientEnv env) getProtocolParameters
  feesTezosClient <- runMorleyClientM (neMorleyClientEnv env) $ calcRevealFee
    alias Nothing (computeStorageLimit [appliedResults] pp)

  feesRPC @?= feesTezosClient