MorleyLogs.hs

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

-- | 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)

singleLog :: Lorentz.Contract () () ()
singleLog = defaultContract $
  printComment "log" # car # nil # pair

multiLog :: Lorentz.Contract () () ()
multiLog = defaultContract $
  printComment "log1" # car # nil # printComment "log2" # pair # printComment "log3"

test_MorleyLogs :: IO [TestTree]
test_MorleyLogs =
  testTreesWithUntypedContract "../../contracts/empties.tz" $ \withoutLogs ->
  pure
  [ testGroup "Checking MorleyLogs processing"
    [ testScenarioOnEmulator "Calling contract with single log" $ scenarioEmulated do
        idAddr <- originateS
        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
        idAddrM <- originateM
        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
        idAddrM <- originateM
        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
            logsInfo <- getMorleyLogs_ $
              call idAddr CallDefault ()
            logsForAddress idAddr logsInfo @== fmap MorleyLogs [["log"]])

          , ("2", do
            idAddr <- originateS
            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
      :: forall caps m. MonadCleveland caps m
      => Morley.Michelson.Untyped.Contract
      -> m (TAddress () ())
    originateW = originateContract "without logs"

    originateS, originateM :: MonadCleveland caps m => m (ContractHandle () () ())
    originateS = originateSimple "with single log" () singleLog
    originateM = originateSimple "with multiple logs" () multiLog

    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