Fees.hs

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

module Test.Fees
  ( test_Fees_comp_iterations
  ) where

import Test.HUnit ((@?=))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)

import Lorentz qualified as L
import Morley.Client (AliasBehavior(..))
import Morley.Client.Action.Origination
import Morley.Client.Action.Transaction
import Morley.Client.RPC.Types
import Morley.Client.Types
import Morley.Michelson.Untyped.Entrypoints
import Morley.Tezos.Core (tz)
import Test.Addresses
import Test.Util
import TestM

fakeState
  :: FakeState
fakeState = defaultFakeState
  { fsContracts = fromList $ one $ (contractAddress2, dumbContractState)
  , fsImplicits = fromList $ one $ second revealKeyState $ genesisState @1
  }

countForgesHandlers :: Handlers $ TestT (State Word)
countForgesHandlers = chainOperationHandlers
  { hForgeOperation = \blkId op -> do
      assertHeadBlockId blkId
      liftToFakeTest $ modify (+1)
      hForgeOperation chainOperationHandlers blkId op

  , hRunOperation = \blkId RunOperation{..} -> do
      assertHeadBlockId blkId
      originatedContracts <- handleRunOperationInternal roOperation
      return RunOperationResult
        { rrOperationContents =
          one $ OperationContent $ RunMetadata
            { rmOperationResult = OperationApplied $
              -- Real-life numbers
              AppliedResult
                { arConsumedMilliGas = 10100000
                , arStorageSize = 250
                , arPaidStorageDiff = 250
                , arOriginatedContracts = concatMap arOriginatedContracts originatedContracts
                , arAllocatedDestinationContracts = 0
                }
            , rmInternalOperationResults = []
            }
        }
  }

runForgesCountingTest :: HasCallStack => TestT (State Word) a -> Word
runForgesCountingTest action = do
  let (res, count) =
        usingState 0 $ runFakeTestT countForgesHandlers fakeState action
  case res of
    Left e -> error . toText $ "Test action failed: " <> displayException e
    Right _ -> count

averageContract :: L.Contract () () ()
averageContract = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $
  L.unpair L.# L.drop L.#
  foldl' (L.#) L.nop (replicate 100 (L.push () L.# L.drop)) L.#
  L.nil L.# L.pair

-- | For small contracts we would like to find proper fees in
-- one hop since fees evaluation requires RPC calls
-- (though lightweight ones like forgeOperation).
--
-- In case this test fails, it would be nice to adjust initial fees
-- so that we again need only one iteration. If that is impossible,
-- update/remove this test.
test_Fees_comp_iterations :: [TestTree]
test_Fees_comp_iterations =
  [ testCase "One transaction" $
      let forgeCalls =
            runForgesCountingTest $
              lTransfer addr1 contractAddress2
                [tz|10u|] DefEpName () Nothing
      in forgeCalls @?= sum
          [ 2  -- for fees adjustment
          , 1  -- check on fees being on par
          , 0  -- forging the entire batch - reusing the previously forged op
          ]

  , testCase "One origination"
      let forgeCalls =
            runForgesCountingTest $
              lOriginateContract OverwriteDuplicateAlias "c"
                addr1 [tz|10u|]
                averageContract () Nothing Nothing
      in forgeCalls @?= sum
          [ 2  -- for fees adjustment
          , 1  -- check on fees being on par
          , 0  -- forging the entire batch - reusing the previously forged op
          ]

  ]

addr1 :: ImplicitAddressWithAlias
addr1 = addrAndAliasFromGenesisState @1