EnvironmentSpec.hs

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

-- | Tests for the 'environment.tz' contract

module Test.Interpreter.EnvironmentSpec
  ( test_environment
  ) where

import Hedgehog (Gen, forAll, property, withTests)
import qualified Hedgehog.Gen as Gen
import Test.Tasty (TestTree)
import Test.Tasty.Hedgehog (testProperty)
import Test.Tasty.HUnit (testCase)

import Michelson.Interpret (RemainingSteps(..))
import Michelson.Runtime.GState
import Michelson.Test (testTreesWithContract)
import Michelson.Test.Integrational
import Michelson.Typed
import qualified Michelson.Typed as T
import qualified Michelson.Untyped as U
import Tezos.Address
import Tezos.Core
import Tezos.Crypto (detSecretKey, toPublic)

import Test.Util.Contracts

test_environment :: IO [TestTree]
test_environment =
  testTreesWithContract (inContractsDir "environment.tz") $
  \contract -> pure
    [ testImpl contract
    , testCase ("Default balance") $
      integrationalTestExpectation testDefaultBalance
    ]

data Fixture = Fixture
  { fNow :: Timestamp
  , fMaxSteps :: RemainingSteps
  , fPassOriginatedAddress :: Bool
  , fBalance :: Mutez
  , fAmount :: Mutez
  } deriving stock (Show)

genFixture :: Gen Fixture
genFixture = do
  fNow <- timestampFromSeconds <$> Gen.enum 100000 111111
  fMaxSteps <- RemainingSteps <$> Gen.enum 1015 1028
  fPassOriginatedAddress <- Gen.bool
  fBalance <- unsafeMkMutez <$> Gen.enum 1 1234
  fAmount <- unsafeMkMutez <$> Gen.enum 1 42
  return Fixture {..}

shouldExpectFailed :: Fixture -> Bool
shouldExpectFailed fixture =
  or
    [ fBalance fixture `unsafeAddMutez` fAmount fixture > unsafeMkMutez 1000
    , fNow fixture < timestampFromSeconds 100500
    , fPassOriginatedAddress fixture
    , fAmount fixture < unsafeMkMutez 15
    ]

testImpl
  :: (U.Contract, T.Contract 'TAddress 'TUnit)
  -> TestTree
testImpl (uEnvironment, _environment)  = do
  testProperty description $
    withTests 50 $ property $ do
      fixture <- forAll genFixture
      integrationalTestProp (scenario fixture)
  where
    scenario :: Fixture -> IntegrationalScenario
    scenario = integrationalScenario uEnvironment
    description =
      -- The conditions under which this contract fails are described in a comment
      -- at the beginning of the contract.
      "contract fails under certain conditions and returns whether remaining gas > 1000"

integrationalScenario :: U.Contract -> Fixture -> IntegrationalScenario
integrationalScenario contract fixture = do
  -- First of all let's set desired gas limit and NOW
  setNow $ fNow fixture
  setMaxSteps $ fMaxSteps fixture

  -- Then let's originated the 'environment.tz' contract
  environmentAddress <-
    originate contract "environment" U.ValueUnit (fBalance fixture)

  -- And transfer tokens to it
  let
    param
      | fPassOriginatedAddress fixture = environmentAddress
      | otherwise = genesisAddress
    txData = TxData
      { tdSenderAddress = genesisAddress
      , tdParameter = U.ValueString (mformatAddress param)
      , tdEntrypoint = DefEpName
      , tdAmount = fAmount fixture
      }
    transferToEnvironment = transfer txData environmentAddress

  -- Execute operations and check that interpreter fails when one of
  -- failure conditions is met or updates environment's storage
  -- approriately
  if shouldExpectFailed fixture
    then transferToEnvironment `catchExpectedError` expectMichelsonFailed (const True) environmentAddress
    else transferToEnvironment

testDefaultBalance :: IntegrationalScenario
testDefaultBalance = do
  let genKey seed = mkKeyAddress . toPublic . detSecretKey $ seed
      addr = genKey "random address testDefaultBalance"
      txData = TxData
        { tdSenderAddress = genesisAddress
        , tdParameter = U.ValueString mempty
        , tdEntrypoint = DefEpName
        , tdAmount = unsafeMkMutez 1
        }
  transfer txData addr
  expectBalance addr (unsafeMkMutez 1)