EmitMachinery.hs

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

module TestSuite.Cleveland.EmitMachinery
  ( test_SimpleEmit
  , test_InferredEmit
  , test_MultipleEmit
  ) where

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

import Lorentz (Contract)
import Test.Cleveland
import Test.Cleveland.Lorentz (embedContract)
import TestSuite.Util.Contracts

test_SimpleEmit :: TestTree
test_SimpleEmit =
  testScenario "transferWithEmit works on simple emit" $ scenario do
    simpleEmit <- originate "simple_emit" () contract
    [ContractEvent{..}] <- transfer simpleEmit WithContractEvents $ calling def ()
    pretty cePayload @== ("Right \"right\" :: or (nat %int) (string %str)" :: Text)
    toAddress ceSource @== toAddress simpleEmit
    ceTag @== "notify_client"
  where
    contract :: Contract () () ()
    contract = $$(embedContract (inContractsDir "simple_emit.tz"))

test_InferredEmit :: TestTree
test_InferredEmit =
  testScenario " on WithContractEvents inferred emit" $ scenario do
    inferredEmit <- originate "inferred_emit" () contract
    [ContractEvent{..}] <- transfer inferredEmit WithContractEvents $ calling def ()
    pretty cePayload @== ("Right \"right\" :: or nat string" :: Text)
    toAddress ceSource @== toAddress inferredEmit
    ceTag @== ""
  where
    contract :: Contract () () ()
    contract = $$(embedContract (inContractsDir "inferred_emit.tz"))

test_MultipleEmit :: TestTree
test_MultipleEmit =
  testScenario "transferWithEmit works on multiple emit" $ scenario do
    multipleEmit <- originate "multiple_emit" () contract
    evs <- transfer multipleEmit WithContractEvents $ calling def ()
    length evs @== 4
    let expected =
          [("one", Just "Right \"right\" :: or nat string")
          ,("two", Just "Left 123 :: or nat string")
          ,("three", Just "False :: bool")
          ,("four", Nothing)]
        check ContractEvent{..} (tag, ty) = do
          pretty <$> cePayload @== (ty :: Maybe Text)
          toAddress ceSource @== toAddress multipleEmit
          ceTag @== tag
    -- events are CONS'ed in the contract and hence end up reversed;
    -- the expectation is reversed here to simplify reasoning a bit.
    zipWithM_ check evs $ reverse expected
  where
    contract :: Contract () () ()
    contract = $$(embedContract (inContractsDir "multiple_emit.tz"))