Entrypoints.hs

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

-- | Utility functions for checking predicates on contract's entrypoints.

module Test.Cleveland.Michelson.Entrypoints
  ( contractHasEntrypoints
  , testContractCoversEntrypoints
  , testContractMatchesEntrypoints
  , mkEntrypointsMap
  , hasEp
  ) where

import Test.Tasty (TestName, TestTree)

import Morley.Michelson.Untyped hiding (Contract)
import Morley.Michelson.Untyped qualified as U

import Test.Cleveland.Michelson.Internal.Entrypoints

-- | Check if entrypoint is present in `T`.
hasEp :: T -> (EpName, U.Ty) -> Bool
hasEp (TOr lFieldAnn rFieldAnn lType@(Ty lT _) rType@(Ty rT _))
      ep@(epNameToParamAnn -> epAnn, epType) = or
  [ (epAnn == lFieldAnn && epType == lType)
  , (epAnn == rFieldAnn && epType == rType)
  , hasEp lT ep
  , hasEp rT ep ]
hasEp _ _ = False

-- | Check whether the given set of entrypoints is present in contract.
contractHasEntrypoints :: U.Contract -> Map EpName U.Ty -> Bool
contractHasEntrypoints contract eps = case contractCoversEntrypoints contract eps of
  Right EPComparisonResultOK -> True
  _ -> False

-- | Assert the contract contains the entrypoints given in spec (with matching types).
-- Ignores any additional entrypoints present in the contract.
--
-- Also tests if the same holds after Michelson and Micheline roundtrips of the contract.
testContractCoversEntrypoints :: TestName -> U.Contract -> Map EpName U.Ty -> TestTree
testContractCoversEntrypoints = testContractEntrypoints ignoreExtraEntrypoints

-- | Assert the contract exactly matches the given entrypoints. Will report both
-- missing and extraneous entrypoint names, and type mismatches.
--
-- Also tests if the same holds after Michelson and Micheline roundtrips of the contract.
testContractMatchesEntrypoints :: TestName -> U.Contract -> Map EpName U.Ty -> TestTree
testContractMatchesEntrypoints = testContractEntrypoints id