MorleyLogs.hs

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

-- | Tests for checking MorleyLogs processing.
module Test.Lorentz.MorleyLogs
  ( test_MorleyLogs
  ) where

import Prelude hiding (drop, swap)
import Test.Tasty (TestTree, testGroup)

import Lorentz hiding (assert)
import Morley.Michelson.Interpret (MorleyLogs(..))
import Morley.Michelson.Untyped (Contract)
import Morley.Michelson.Untyped.Value (Value'(..))
import Test.Cleveland
import Test.Cleveland.Michelson (testTreesWithUntypedContract)

test_MorleyLogs :: IO [TestTree]
test_MorleyLogs =
  testTreesWithUntypedContract "../../contracts/empties.tz" $ \withoutLogs ->
  testTreesWithUntypedContract "../../contracts/single_log.mtz" $ \withSingleLog ->
  testTreesWithUntypedContract "../../contracts/multiple_logs.mtz" $ \withMultiLogs ->
  pure
  [ testGroup "Checking MorleyLogs processing"
    [ testScenarioOnEmulator "Calling contract with single log" $ scenarioEmulated do
        idAddr <- originateS withSingleLog
        logsInfo <- getMorleyLogs_ $ do
          call idAddr CallDefault ()
          call idAddr CallDefault ()
        logsForAddress idAddr logsInfo @== fmap MorleyLogs [["log"], ["log"]]
        collectLogs logsInfo @== MorleyLogs ["log", "log"]

    , testScenarioOnEmulator "Calling several contracts with and without logs" $ scenarioEmulated do
        idAddrW <- originateW withoutLogs
        idAddrS <- originateS withSingleLog
        idAddrM <- originateM withMultiLogs
        logsInfo <- getMorleyLogs_ $ do
          call idAddrW CallDefault ()
          call idAddrS CallDefault ()
          call idAddrM CallDefault ()
        logsForAddress idAddrW logsInfo @== fmap MorleyLogs [[]]
        logsForAddress idAddrS logsInfo @== fmap MorleyLogs [["log"]]
        logsForAddress idAddrM logsInfo @== fmap MorleyLogs [["log1", "log2", "log3"]]
        collectLogs logsInfo @== MorleyLogs ["log", "log1", "log2", "log3"]

    , testScenarioOnEmulator "Calling several contracts to check the logging order" $ scenarioEmulated do
        idAddrS <- originateS withSingleLog
        idAddrM <- originateM withMultiLogs
        logsInfo <- getMorleyLogs_ $ do
          call idAddrS CallDefault ()
          call idAddrM CallDefault ()
          call idAddrS CallDefault ()
        logsForAddress idAddrM logsInfo @== fmap MorleyLogs [["log1", "log2", "log3"]]
        logsForAddress idAddrS logsInfo @== fmap MorleyLogs [["log"], ["log"]]
        collectLogs logsInfo @== MorleyLogs ["log", "log1", "log2", "log3", "log"]

    , testScenarioOnEmulator "Calling contracts in parallel with branchout" $ scenarioEmulated do
        branchout
          [ ("1", do
            idAddr <- originateS withSingleLog
            logsInfo <- getMorleyLogs_ $
              call idAddr CallDefault ()
            logsForAddress idAddr logsInfo @== fmap MorleyLogs [["log"]])

          , ("2", do
            idAddr <- originateS withSingleLog
            logsInfo <- getMorleyLogs_ $
              call idAddr CallDefault ()
            collectLogs logsInfo @== MorleyLogs ["log"])
          ]
    -- This test checks the behavior of MorleyLogs when one
    -- contract is called by another contract. In this case contracts contain only
    -- logs produced by themselves.
    , testScenarioOnEmulator "Calling a contract inside another contract" $ scenarioEmulated do
        logsInfo <- getMorleyLogs_ $ do
          caller <- originateSimple "caller" () callerContract
          target <- originateSimple "target" () targetContract
          call caller CallDefault (toContractRef target)
        collectLogs logsInfo @==
          MorleyLogs ["Caller contract called", "Target contract called with 5"]
    ]
  ]
  where
    originateContract
      :: forall caps m. MonadCleveland caps m
      => AliasHint
      -> Morley.Michelson.Untyped.Contract
      -> m (TAddress () ())
    originateContract name c = do
      addr <- originateUntyped $
        UntypedOriginateData name 100 ValueUnit c
      return $ toTAddress addr

    originateW, originateS, originateM
      :: forall caps m. MonadCleveland caps m
      => Morley.Michelson.Untyped.Contract
      -> m (TAddress () ())
    originateW = originateContract "without logs"
    originateS = originateContract "with single log"
    originateM = originateContract "with multiple logs"

    callerContract :: Lorentz.Contract (ContractRef Integer) () ()
    callerContract = defaultContract $
        car #
        printComment "Caller contract called" #
        (push zeroMutez # push 5 # transferTokens |:| nil) #
        unit # swap # pair

    targetContract :: Lorentz.Contract Integer () ()
    targetContract = defaultContract $
        car #
        printComment ("Target contract called with " <> stackRef @0) #
        drop #
        unit # nil # pair