Unit.hs

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

{-# OPTIONS_GHC -Wno-deprecations #-}

-- | Utility functions for unit testing.

module Test.Cleveland.Michelson.Unit
  {-# DEPRECATED "Use the new Test.Cleveland interface instead. Entrypoint utilities\
  \ are moved to Test.Cleveland.Michelson.Entrypoints" #-}
  ( ContractReturn
  , ContractPropValidator
  , EPMismatch
  , contractProp
  , contractPropVal
  , validateSuccess
  , validateStorageIs
  , validateMichelsonFailsWith
  ) where

import Data.Constraint ((\\))
import Fmt ((+|), (|+))
import Test.HUnit (Assertion, assertFailure, (@?=))
import Test.Hspec.Expectations (Expectation, shouldBe, shouldSatisfy)

import Lorentz.Constraints.Scopes (NiceConstant, niceConstantEvi)
import Morley.Michelson.Interpret
  (ContractEnv, ContractReturn, MichelsonFailed(..), MichelsonFailureWithStack(..), interpret)
import Morley.Michelson.Typed (Contract, IsoValue(..), ToT)
import Morley.Michelson.Typed qualified as T
import Test.Cleveland.Michelson.Dummy (dummyBigMapCounter, dummyGlobalCounter)
import Test.Cleveland.Michelson.Internal.Entrypoints

-- | Type for contract execution validation.
--
-- It's a function which is supplied with contract execution output
-- (failure or new storage with operation list).
--
-- Function returns a property which type is designated by type variable @prop@
-- and might be @Test.QuickCheck.Property@ or 'Expectation'
-- or anything else relevant.
type ContractPropValidator st prop = ContractReturn st -> prop

-- | ContractCode's property tester against given input.
-- Takes contract environment, initial storage and parameter,
-- interprets contract on this input and invokes validation function.
contractProp
  :: ( IsoValue param, IsoValue storage
     , ToT param ~ cp, ToT storage ~ st
     , T.ParameterScope cp
     )
  => Contract cp st
  -> ContractPropValidator st prop
  -> ContractEnv
  -> param
  -> storage
  -> prop
contractProp instr check env param initSt =
  contractPropVal instr check env (toVal param) (toVal initSt)

-- | Version of 'contractProp' which takes 'T.Value' as arguments instead
-- of regular Haskell values.
--
-- This function assumes that contract has no explicit default entrypoints
-- and you always have to construct parameter manually; if you need to test
-- contract calling specific entrypoints, use integrational testing defined
-- by "Test.Cleveland.Michelson.Integrational" module.
contractPropVal
  :: (T.ParameterScope cp)
  => Contract cp st
  -> ContractPropValidator st prop
  -> ContractEnv
  -> T.Value cp
  -> T.Value st
  -> prop
contractPropVal instr check env param initSt =
  check $ interpret instr T.unsafeEpcCallRoot param initSt dummyGlobalCounter dummyBigMapCounter env

----------------------------------------------------------------------------
-- Validators
----------------------------------------------------------------------------

-- | 'ContractPropValidator' that expects a successful termination.
validateSuccess :: HasCallStack => ContractPropValidator st Expectation
validateSuccess (res, _) = res `shouldSatisfy` isRight

-- | 'ContractPropValidator' that expects contract execution to
-- succeed and update storage to a particular constant value.
validateStorageIs
  :: IsoValue st
  => st -> ContractPropValidator (ToT st) Assertion
validateStorageIs expected (res, _) =
  case res of
    Left err ->
      assertFailure $ "Unexpected interpretation failure: " +| err |+ ""
    Right (_ops, got) ->
      got @?= toVal expected

-- | 'ContractPropValidator' that expects a given failure.
validateMichelsonFailsWith
  :: forall v st. NiceConstant v
  => v -> ContractPropValidator st Expectation
validateMichelsonFailsWith v (res, _) = case res of
  Right _ -> assertFailure $
    "contract was expected to fail with " +| expected |+ " but didn't."
  Left MichelsonFailureWithStack{..} -> mfwsFailed `shouldBe` expected
  where
    expected = MichelsonFailedWith (toVal v) \\ niceConstantEvi @v