FailureLogs.hs

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

module TestSuite.Cleveland.FailureLogs
  ( test_FailureLogs
  ) where

import Lorentz qualified as L hiding (comment)

import Test.Tasty (TestTree)

import Morley.Michelson.Interpret (unMorleyLogs)
import Test.Cleveland

test_FailureLogs :: TestTree
test_FailureLogs =
  testScenarioOnEmulator "Can get logs even on scenario failure" $ scenarioEmulated do
    contractAddr <- originate "test catchTransferFailure" () testContract

    (logs1, result1) <- fmap (first collectLogs) . getMorleyLogs $ try @_ @SomeException do
      transfer contractAddr $ calling def 0
      transfer contractAddr $ calling def 1
      failure "some failure"
    assert (isLeft result1) "result1 should be Left"
    unMorleyLogs logs1 @== ["One", "Two", "Three", "Four", "One", "Two"]

    (logs2, result2) <- fmap (first collectLogs) . getMorleyLogs $ try @_ @SomeException do
      transfer contractAddr $ calling def 0
      failure "some failure"
      transfer contractAddr $ calling def 1
    assert (isLeft result2) "result2 should be Left"
    unMorleyLogs logs2 @== ["One", "Two", "Three", "Four"]

testContract :: L.Contract Integer () ()
testContract =  L.defaultContract @Integer $
      L.car
  L.# L.printComment "One"
  L.# L.printComment "Two"
  L.# L.ifEq0 L.nop (L.push () L.# L.failWith)
  L.# L.printComment "Three"
  L.# L.printComment "Four"
  L.# L.unit
  L.# L.nil
  L.# L.pair