Entrypoints.hs

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

-- | Internal utilities for unit testing.

module Test.Cleveland.Lorentz.Internal.Entrypoints
  ( -- * Entrypoint spec passed on the type level
    testCompareContractEntrypointsT

    -- * Entrypoint spec passed as a value
  , testCompareContractEntrypoints

    -- * Utility types
  , ContractEPTypeTest
  , ContractEPTest
  ) where

import Lorentz hiding (contract)

import Test.Tasty (TestName, TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Morley.Michelson.Typed (convertContract, flattenEntrypoints)
import Morley.Michelson.Untyped qualified as U
import Morley.Util.Named

import Test.Cleveland.Michelson.Internal.Entrypoints qualified as M

-- | Utility type synonym
type ContractEPTypeTest expectedEps
  =  forall contractEps st vd.
     (NiceParameterFull expectedEps, NiceParameterFull contractEps)
  => Contract contractEps st vd -> TestTree

-- | Utility type synonym
type ContractEPTest contractEps st vd
  =  Contract contractEps st vd
  -> Map EpName U.Ty
  -> TestTree

-- | Expect the contract to match with the entrypoints given in spec passed as the first type
-- argument. Checks both the contract type and the contract itself (when represented as an untyped
-- Michelson contract).
-- Comparison is defined by the first argument; use @ignoreExtraEntrypoints@ for cover test,
-- @id@ for match test.
testCompareContractEntrypointsT
  :: forall expectedEps.
     (M.EPMismatch -> M.EPMismatch)
  -> TestName -> ContractEPTypeTest expectedEps
testCompareContractEntrypointsT compareMode name contract =
  withDict (niceParameterEvi @expectedEps) $
    let entrypoints = flattenEntrypoints $ parameterEntrypointsToNotes @expectedEps
    in testCompareContractEntrypoints compareMode name contract entrypoints

-- | Expect the contract to match with the entrypoints given in spec (with matching types).
-- Checks both the contract type and the contract itself (when represented as an untyped Michelson
-- contract).
-- Comparison is defined by the first argument; use @ignoreExtraEntrypoints@ for cover test,
-- @id@ for match test.
testCompareContractEntrypoints
  :: forall contractEps st vd.
     NiceParameterFull contractEps
  => (M.EPMismatch -> M.EPMismatch)
  -> TestName -> ContractEPTest contractEps st vd
testCompareContractEntrypoints compareMode name contract@Contract{} spec =
  withDict (niceParameterEvi @contractEps) $
  withDict (niceStorageEvi @st) $
    let entrypointsInType = flattenEntrypoints $ parameterEntrypointsToNotes @contractEps
        contract' = convertContract . toMichelsonContract $ contract
    in testGroup name
        [ testCase "Contract type matches entrypoint spec" $
            M.assertEPComparisonSuccessful . Right . compareMode $
              M.compareEntrypoints (#expected :! spec) (#actual :! entrypointsInType)
        , M.testContractEntrypoints compareMode
            "Untyped contract matches entrypoint spec" contract' spec
        ]