ContractOp.hs

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

-- | Module, containing spec to test contract_op.tz contract.
module Test.Interpreter.ContractOp
  ( test_contract_op
  ) where

import Fmt (pretty)
import Test.Tasty (TestTree)

import Morley.Michelson.Untyped
import Morley.Tezos.Address
import Test.Cleveland
import Test.Cleveland.Lorentz.Import (embedContract)

import Test.Util.Contracts

-- | Spec to test @contract_op.tz@ contract.
--
-- Test results are confirmed by the reference implementation.
test_contract_op :: [TestTree]
test_contract_op =
    [ testScenarioOnEmulator "contract not found" $ scenario do
        contract_op <- originateSimple "contract_op" False contract
        call contract_op CallDefault [ta|KT1WsLzQ61xtMNJHfwgCHh2RnALGgFAzeSx9|]
        getStorage contract_op @@== False
    ] <>
    map (\(res, notes) -> testScenarioOnEmulator (msg res notes) $ scenario do
            contract_op <- originateSimple "contract_op" False contract
            test <- originateUntypedSimple "test_contract" ValueUnit $
              minimalContract notes
            transfer TransferData
              { tdTo = contract_op
              , tdParameter = test
              , tdAmount = 0
              , tdEntrypoint = DefEpName
              }
            getStorage contract_op @@== res
        )
    [ (True,  intQ   "root"         )
    , (True,  int    "root"         )
    , (False, intQ   noAnn        )
    , (False, int    noAnn        )
    , (False, intP   noAnn        )
    , (False, string noAnn        )
    , (False, intP   "root"         )
    , (False, intQ   "another_root" )
    ]
  where
    contract = $$(embedContract @Address @Bool @() (inContractsDir "contract_op.tz"))

    minimalContract :: ParameterType -> Contract
    minimalContract contractParameter = Contract
      { contractStorage = Ty TUnit noAnn
      , contractCode = PrimEx <$>
          [ CDR noAnn noAnn
          , NIL noAnn noAnn (Ty TOperation noAnn)
          , PAIR noAnn noAnn noAnn noAnn
          ]
      , entriesOrder = PSC
      , contractViews = []
      , ..
      }

    msg isGood paramType =
      "parameter in environment is '" <> pretty paramType <> "', " <>
      bool "" "but "  isGood <> "contract expects '%root int :q'"

    intQ   = ParameterType $ Ty TInt "q"
    int    = ParameterType $ Ty TInt noAnn
    intP   = ParameterType $ Ty TInt "p"
    string = ParameterType $ Ty TString noAnn