StringCaller.hs

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

-- | Tests for the 'stringCaller.tz' contract and its interaction with
-- the 'failOrStoreAndTransfer.tz' contract. Both of them have comments describing
-- their behavior.

module Test.Interpreter.StringCaller
  ( test_stringCaller
  ) where

import Hedgehog (forAll, property, withTests)
import Test.Tasty (testGroup, TestTree)
import Test.Tasty.Hedgehog (testProperty)
import Test.Tasty.HUnit (testCase)

import Michelson.Runtime.GState
import Michelson.Test (testTreesWithContract)
import Michelson.Test.Integrational
import Michelson.Text
import Michelson.Typed
import qualified Michelson.Typed as T
import qualified Michelson.Untyped as U
import Tezos.Address
import Tezos.Core

import Test.Util.Contracts

test_stringCaller :: IO [TestTree]
test_stringCaller =
  testTreesWithContract (inContractsDir "string_caller.tz") $ \stringCaller ->
  testTreesWithContract (inContractsDir "fail_or_store_and_transfer.tz") $
    \failOrStoreAndTransfer ->
      pure $ [testImpl stringCaller failOrStoreAndTransfer]

testImpl ::
     (U.Contract, T.Contract 'TString 'TAddress)
  -> (U.Contract, T.Contract 'TString 'TString)
  -> TestTree
testImpl (uStringCaller, _stringCaller) (uFailOrStore, _failOrStoreAndTransfer) =
  let scenario = integrationalScenario uStringCaller uFailOrStore
  in
    -- failOrStoreAndTransfer's pre-conditions:
    -- balance is >= 1300 and NOW >= 500
    testGroup "calls failOrStoreAndTransfer, updates storage & balance, checks pre-conditions"
      [ testCase "when parameter is a constant" $
          integrationalTestExpectation (scenario constStr)
      -- The test is trivial, so it's kinda useless to run it many times
      , testProperty "when parameter is an arbitrary value" $
        withTests 2 $ property $ do
          mtext <- forAll genMText
          integrationalTestProp (scenario mtext)
      ]
  where
    constStr = [mt|caller|]

integrationalScenario :: U.Contract -> U.Contract -> MText -> IntegrationalScenario
integrationalScenario stringCaller failOrStoreAndTransfer str = do
  let
    initFailOrStoreBalance = unsafeMkMutez 900
    initStringCallerBalance = unsafeMkMutez 500

  -- Originate both contracts
  failOrStoreAndTransferAddress <-
    originate failOrStoreAndTransfer "failOrStoreAndTransfer" (U.ValueString [mt|hello|]) initFailOrStoreBalance
  stringCallerAddress <-
    originate stringCaller "stringCaller"
    (U.ValueString $ mformatAddress failOrStoreAndTransferAddress)
    initStringCallerBalance

  -- NOW = 500, so stringCaller shouldn't fail
  setNow (timestampFromSeconds 500)

  -- Transfer 100 tokens to stringCaller, it should transfer 300 tokens
  -- to failOrStoreAndTransfer
  let
    newValue = untypeValue $ toVal str
    txData = TxData
      { tdSenderAddress = genesisAddress
      , tdParameter = newValue
      , tdEntrypoint = DefEpName
      , tdAmount = unsafeMkMutez 100
      }
    transferToStringCaller = transfer txData stringCallerAddress
  transferToStringCaller

  -- Execute operations and check balances and storage of 'failOrStoreAndTransfer'
  do
    let
      -- `stringCaller.tz` transfers 300 mutez.
      -- 'failOrStoreAndTransfer.tz' transfers 5 tokens.
      -- Also 100 tokens are transferred from the genesis address.
      expectedStringCallerBalance = unsafeMkMutez (500 - 300 + 100)
      expectedFailOrStoreBalance = unsafeMkMutez (900 + 300 - 5)
      expectedConstAddrBalance = unsafeMkMutez 5

    expectStorageUpdateConst failOrStoreAndTransferAddress newValue
    expectBalance failOrStoreAndTransferAddress expectedFailOrStoreBalance
    expectBalance stringCallerAddress expectedStringCallerBalance
    expectBalance constAddr expectedConstAddrBalance

  -- Now let's transfer 100 tokens to stringCaller again.
  -- This time execution should fail, because failOrStoreAndTransfer should fail
  -- because its balance is greater than 1300.
  transferToStringCaller `catchExpectedError`
    expectMichelsonFailed (const True) failOrStoreAndTransferAddress

  -- We can also send tokens from failOrStoreAndTransfer to tz1 address directly
  let
    txDataToConst = TxData
      { tdSenderAddress = failOrStoreAndTransferAddress
      , tdParameter = U.ValueUnit
      , tdEntrypoint = DefEpName
      , tdAmount = unsafeMkMutez 200
      }
  transfer txDataToConst constAddr

  -- Let's check balance of failOrStoreAndTransfer and tz1 address.
  -- We transferred 200 tokens from failOrStoreAndTransferAddress to constAddr.
  do
    let
      expectedFailOrStoreBalance = unsafeMkMutez (900 + 300 - 5 - 200)
      expectedConstAddrBalance = unsafeMkMutez (5 + 200)

    expectBalance failOrStoreAndTransferAddress expectedFailOrStoreBalance
    expectBalance constAddr expectedConstAddrBalance

  -- Now we can transfer to stringCaller again and it should succeed
  -- this time, because the balance of failOrStoreAndTransfer decreased
  transferToStringCaller

  -- Now let's set NOW to 600 and expect stringCaller to fail
  setNow (timestampFromSeconds 600)
  transferToStringCaller `catchExpectedError`
    expectMichelsonFailed (const True) stringCallerAddress

-- Address hardcoded in 'failOrStoreAndTransfer.tz'.
constAddr :: Address
constAddr = unsafeParseAddress "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU"