packages feed

morley-client-0.4.0: test/Test/Resolve.hs

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

module Test.Resolve
  ( test_Resolve_calls
  ) 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.Batched
import Morley.Client.Action.Common
import Morley.Client.Action.Delegation
import Morley.Client.Action.Origination
import Morley.Client.Action.Reveal
import Morley.Client.Action.Transaction
import Morley.Client.Types
import Morley.Michelson.Untyped.Entrypoints
import Morley.Tezos.Address
import Morley.Tezos.Core (tz)
import Test.Addresses
import Test.Util
import TestM

fakeState :: Bool -> FakeState
fakeState initRevealed = defaultFakeState
  { fsContracts = fromList $ one $ (contractAddress2, dumbContractState)
  , fsImplicits = fromList $ one $ second revelation $ genesisState @1
  }
  where
    revelation | initRevealed = revealKeyState
               | otherwise = id

countAliasStoreCalls :: Handlers (TestT (State Word))
countAliasStoreCalls = chainOperationHandlers
  { hGetAliasesAndAddresses = do
      liftToFakeTest $ modify (+ 1)
      hGetAliasesAndAddresses chainOperationHandlers
  }

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

averageContract :: L.Contract () () ()
averageContract = L.defaultContract $ L.car L.# L.nil L.# L.pair

test_Resolve_calls :: [TestTree]
test_Resolve_calls =
  [ testCase "One transaction" $
      let storeCalls =
            runAliasStoreCounterTest True $
              lTransfer addr1 contractAddress2
                [tz|10u|] DefEpName () Nothing
      in storeCalls @?= 1 -- one call in operations log.

  , testCase "One origination"
      let storeCalls =
            runAliasStoreCounterTest True $
              lOriginateContract OverwriteDuplicateAlias "c"
                addr1 [tz|10u|]
                averageContract () Nothing Nothing
      in storeCalls @?= 0

  , testCase "One revelation"
      let storeCalls =
            runAliasStoreCounterTest False $ revealKey addr1
      in storeCalls @?= 1 -- one call in operations log.

  , testCase "One delegation"
      let storeCalls =
            runAliasStoreCounterTest True $ registerDelegateOp addr1
      in storeCalls @?= 1 -- one call in operations log.

  , testCase "Mix"
      let storeCalls = runAliasStoreCounterTest False do
            revealKeyUnlessRevealed addr1
            registerDelegateOp addr1
            lOriginateContract OverwriteDuplicateAlias "c" addr1 [tz|10u|] averageContract ()
              Nothing Nothing
            lTransfer addr1 contractAddress2 [tz|10u|] DefEpName () Nothing
      in storeCalls @?= 3 -- one per injection except origination

  , testCase "Batch"
      let storeCalls = runAliasStoreCounterTest False do
            void $ runOperationsBatch addr1 $ do
              delegateM $ DelegationData (Just $ unImplicitAddress $ awaAddress addr1) Nothing
              originateContractM OriginationData
                { odAliasBehavior = OverwriteDuplicateAlias
                , odName = "c"
                , odContract = L.toMichelsonContract averageContract
                , odStorage = L.toVal ()
                , odDelegate = Nothing
                , odMbFee = Nothing
                , odBalance = [tz|10u|] }
              runTransactionM $ TransactionData TD
                { tdParam = L.toVal ()
                , tdReceiver = Constrained contractAddress2
                , tdAmount = [tz|10u|]
                , tdEpName = DefEpName
                , tdMbFee = Nothing
                }
              pure ()
      in storeCalls @?= 1 -- one per batch


  ]

addr1 :: ImplicitAddressWithAlias
addr1 = addrAndAliasFromGenesisState @1