Entrypoints.hs

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

{-# OPTIONS_HADDOCK not-home #-}

-- | Internal utilities for unit testing.
module Test.Cleveland.Lorentz.Internal.Entrypoints
  ( module Test.Cleveland.Lorentz.Internal.Entrypoints
  ) where

import Lorentz hiding (contract)

import Data.Map qualified as Map
import Test.Tasty (TestName, TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Morley.Michelson.Typed (HandleImplicitDefaultEp(..), 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 =
  let entrypoints = flattenEntrypoints WithoutImplicitDefaultEp $
        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 =
  let entrypointsInType = flattenEntrypoints wantsDefaultEp $
        parameterEntrypointsToNotes @contractEps
      wantsDefaultEp
        | Map.member DefEpName spec = WithImplicitDefaultEp
        | otherwise = WithoutImplicitDefaultEp
      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
      ]