-- 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 :: T -> (EpName, Ty) -> Bool
hasEp (TOr FieldAnn
lFieldAnn FieldAnn
rFieldAnn lType :: Ty
lType@(Ty T
lT TypeAnn
_) rType :: Ty
rType@(Ty T
rT TypeAnn
_))
      ep :: (EpName, Ty)
ep@(EpName -> FieldAnn
epNameToParamAnn -> FieldAnn
epAnn, Ty
epType) = [Bool] -> Element [Bool]
forall c.
(Container c, BooleanMonoid (Element c)) =>
c -> Element c
or
  [ (FieldAnn
epAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
lFieldAnn Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Ty
epType Ty -> Ty -> Bool
forall a. Eq a => a -> a -> Bool
== Ty
lType)
  , (FieldAnn
epAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
rFieldAnn Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Ty
epType Ty -> Ty -> Bool
forall a. Eq a => a -> a -> Bool
== Ty
rType)
  , T -> (EpName, Ty) -> Bool
hasEp T
lT (EpName, Ty)
ep
  , T -> (EpName, Ty) -> Bool
hasEp T
rT (EpName, Ty)
ep ]
hasEp T
_ (EpName, Ty)
_ = Bool
False

-- | Check whether the given set of entrypoints is present in contract.
contractHasEntrypoints :: U.Contract -> Map EpName U.Ty -> Bool
contractHasEntrypoints :: Contract -> Map EpName Ty -> Bool
contractHasEntrypoints Contract
contract Map EpName Ty
eps = case Contract -> Map EpName Ty -> Either TcTypeError EPMismatch
contractCoversEntrypoints Contract
contract Map EpName Ty
eps of
  Right EPMismatch
EPComparisonResultOK -> Bool
True
  Either TcTypeError EPMismatch
_ -> Bool
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 :: TestName -> Contract -> Map EpName Ty -> TestTree
testContractCoversEntrypoints = (EPMismatch -> EPMismatch)
-> TestName -> Contract -> Map EpName Ty -> TestTree
testContractEntrypoints EPMismatch -> EPMismatch
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 :: TestName -> Contract -> Map EpName Ty -> TestTree
testContractMatchesEntrypoints = (EPMismatch -> EPMismatch)
-> TestName -> Contract -> Map EpName Ty -> TestTree
testContractEntrypoints EPMismatch -> EPMismatch
forall a. a -> a
id