Views.hs

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

-- | Tests on on-chain views.
module Test.Interpreter.Views
  ( test_runtime
  , test_step_constants
  , test_recursion
  , test_create_contract
  , test_context_restore_on_exit
  ) where

import Fmt (Buildable, (+|), (|+))
import Test.Tasty (TestTree, testGroup)

import Morley.Tezos.Address
import Morley.Tezos.Core
import Test.Cleveland
import Test.Cleveland.Instances ()
import Test.Cleveland.Lorentz.Types
import Test.Util.Contracts

-- Tests from Tezos
--
-- Taken from https://gitlab.com/tezos/tezos/-/blob/6eef585d8e897b94b330323987ee0e6228189791/tests_python/tests_alpha/test_contract.py#L681
----------------------------------------------------------------------------

amongTezosContracts :: FilePath -> FilePath
amongTezosContracts file = contractsDir </> "tezos_examples" </> "opcodes" </> file

originateViewedContract
  :: MonadCleveland caps m => m (ContractHandle Natural Natural ())
originateViewedContract =
  importContract (amongTezosContracts "view_toplevel_lib.tz")
    >>= \c -> originate OriginateData
      { odName = "viewedContract"
      , odBalance = 777
      , odStorage = 3 :: Natural
      , odContract = c
      }

test_runtime :: TestTree
test_runtime = testGroup "Basic interpreter logic"
  [ checkContract "view_op_id" ((0, 0) :: (Natural, Natural)) (10, 3)
  , checkContract "view_op_add" (42 :: Natural) 13
  , checkContract "view_fib" (0 :: Natural) 55
  , checkContract "view_mutual_recursion" (0 :: Natural) 20
  , checkContract "view_op_nonexistent_func" True False
  , checkContract "view_op_nonexistent_addr" True False
  , checkContract "view_op_toplevel_inconsistent_input_type" (5 :: Natural) 0
  , checkContract "view_op_toplevel_inconsistent_output_type" True False
  ]
  where
    checkContract
      :: (NiceStorage st, NicePackedValue st, Eq st, Buildable st, AsRPC st ~ st)
      => String -> st -> st -> TestTree
    checkContract fileName initSt expected =
      testScenario fileName $ scenario $ clarifyErrors ("For '" +| fileName |+ "'") do
        viewedContract <- originateViewedContract
        viewCaller
          <- importContract @(Natural, Address) @_ @() (amongTezosContracts $ fileName <> ".tz")
          >>= originateSimple "viewCaller" initSt
        call viewCaller CallDefault (10, toAddress viewedContract)
        getStorage viewCaller @@== expected

test_step_constants :: TestTree
test_step_constants =
  testScenario "Step constants contract" $ scenario do
    alice <- newAddress auto
    viewedContract <- originateViewedContract
    viewCaller
      <- importContract @Address @(Maybe ((Mutez, Mutez), ((Address, Address), Address))) @()
         (amongTezosContracts "view_op_test_step_contants.tz")
      >>= originateSimple "viewCaller" Nothing
    withSender alice do
      call viewCaller CallDefault (toAddress viewedContract)
    let expectedSelfAddress = toAddress viewedContract
        expectedSender = toAddress viewCaller
        expectedSource = alice
    getStorage viewCaller @@== Just
      ( ( 0
        , 777
        )
      , ( ( expectedSelfAddress
          , expectedSender
          )
        , expectedSource
        )
      )

test_recursion :: TestTree
test_recursion =
  testScenario "Recursive call" $ scenario do
    contract
      <- importContract @() @() @() (amongTezosContracts "view_rec.tz")
      >>= originateSimple "contract" ()
    call contract CallDefault ()
      & expectTransferFailure gasExhaustion

test_create_contract :: TestTree
test_create_contract =
  testScenario "Recursive call" $ scenario do
    contractCreator
      <- importContract @() @(Maybe Address) @()
         (amongTezosContracts "create_contract_with_view.tz")
      >>= originateSimple "contractCreator" Nothing
    call contractCreator CallDefault ()
    contractAddr <- getStorage contractCreator >>= \case
      Nothing -> failure "Unexpected outcome"
      Just addr -> pure addr

    constViewObserver
      <- importContract @(Natural, Address) @Natural @()
         (amongTezosContracts "view_op_constant.tz")
      >>= originateSimple "constViewObserver" 2
    call constViewObserver CallDefault (10, contractAddr)

    getStorage constViewObserver @@== 10

-- In Tezos they have a lot of tests covering the fact that environment must
-- be restored on view exist (the tests were added along with a bugfix),
-- but we don't need this, we use 'ReaderT' that makes the issue hard to produce.
test_context_restore_on_exit :: TestTree
test_context_restore_on_exit =
  testScenario "Context restores" $ scenario do
    viewedContract <- originateViewedContract
    selfAfterView
      <- importContract @Address @Address @()
         (amongTezosContracts "self_after_view.tz")
      >>= \c -> originate OriginateData
        { odName = "selfAfterView"
        , odBalance = 1500  -- transferred by the contract further
        , odStorage = toAddress viewedContract
        , odContract = c
        }

    call selfAfterView CallDefault (toAddress viewedContract)
    getStorage selfAfterView @@== toAddress selfAfterView