-- SPDX-FileCopyrightText: 2021 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | 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 qualified Morley.Michelson.Untyped as U

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

-- | Utility type synonym
type ContractEPTypeTest expectedEps
  =  forall contractEps st vd. NiceParameterFull expectedEps
  => 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 :: (EPMismatch -> EPMismatch)
-> TestName -> ContractEPTypeTest expectedEps
testCompareContractEntrypointsT EPMismatch -> EPMismatch
compareMode TestName
name Contract contractEps st vd
contract =
  (((SingI (ToT expectedEps),
   FailOnOperationFound (ContainsOp (ToT expectedEps)),
   FailOnNestedBigMapsFound
     (ContainsNestedBigMaps (ToT expectedEps))),
  KnownValue expectedEps)
 :- ParameterScope (ToT expectedEps))
-> (ParameterScope (ToT expectedEps) => TestTree) -> TestTree
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (((SingI (ToT expectedEps),
  FailOnOperationFound (ContainsOp (ToT expectedEps)),
  FailOnNestedBigMapsFound
    (ContainsNestedBigMaps (ToT expectedEps))),
 KnownValue expectedEps)
:- ParameterScope (ToT expectedEps)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @expectedEps) ((ParameterScope (ToT expectedEps) => TestTree) -> TestTree)
-> (ParameterScope (ToT expectedEps) => TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$
    let entrypoints :: Map EpName Ty
entrypoints = ParamNotes (ToT expectedEps) -> Map EpName Ty
forall (t :: T). SingI t => ParamNotes t -> Map EpName Ty
flattenEntrypoints (ParamNotes (ToT expectedEps) -> Map EpName Ty)
-> ParamNotes (ToT expectedEps) -> Map EpName Ty
forall a b. (a -> b) -> a -> b
$ ParameterDeclaresEntrypoints expectedEps =>
ParamNotes (ToT expectedEps)
forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp)
parameterEntrypointsToNotes @expectedEps
    in (EPMismatch -> EPMismatch)
-> TestName -> ContractEPTest contractEps st vd
forall contractEps st vd.
(EPMismatch -> EPMismatch)
-> TestName -> ContractEPTest contractEps st vd
testCompareContractEntrypoints EPMismatch -> EPMismatch
compareMode TestName
name Contract contractEps st vd
contract Map EpName Ty
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.
     (M.EPMismatch -> M.EPMismatch)
  -> TestName -> ContractEPTest contractEps st vd
testCompareContractEntrypoints :: (EPMismatch -> EPMismatch)
-> TestName -> ContractEPTest contractEps st vd
testCompareContractEntrypoints EPMismatch -> EPMismatch
compareMode TestName
name contract :: Contract contractEps st vd
contract@Contract{} Map EpName Ty
spec =
  (((SingI (ToT contractEps),
   FailOnOperationFound (ContainsOp (ToT contractEps)),
   FailOnNestedBigMapsFound
     (ContainsNestedBigMaps (ToT contractEps))),
  KnownValue contractEps)
 :- ParameterScope (ToT contractEps))
-> (ParameterScope (ToT contractEps) => TestTree) -> TestTree
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (((SingI (ToT contractEps),
  FailOnOperationFound (ContainsOp (ToT contractEps)),
  FailOnNestedBigMapsFound
    (ContainsNestedBigMaps (ToT contractEps))),
 KnownValue contractEps)
:- ParameterScope (ToT contractEps)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @contractEps) ((ParameterScope (ToT contractEps) => TestTree) -> TestTree)
-> (ParameterScope (ToT contractEps) => TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$
  (((SingI (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
   FailOnContractFound (ContainsContract (ToT st))),
  HasAnnotation st, KnownValue st)
 :- StorageScope (ToT st))
-> (StorageScope (ToT st) => TestTree) -> TestTree
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (((SingI (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
  FailOnContractFound (ContainsContract (ToT st))),
 HasAnnotation st, KnownValue st)
:- StorageScope (ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st) ((StorageScope (ToT st) => TestTree) -> TestTree)
-> (StorageScope (ToT st) => TestTree) -> TestTree
forall a b. (a -> b) -> a -> b
$
    let entrypointsInType :: Map EpName Ty
entrypointsInType = ParamNotes (ToT contractEps) -> Map EpName Ty
forall (t :: T). SingI t => ParamNotes t -> Map EpName Ty
flattenEntrypoints (ParamNotes (ToT contractEps) -> Map EpName Ty)
-> ParamNotes (ToT contractEps) -> Map EpName Ty
forall a b. (a -> b) -> a -> b
$ ParameterDeclaresEntrypoints contractEps =>
ParamNotes (ToT contractEps)
forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp)
parameterEntrypointsToNotes @contractEps
        contract' :: Contract
contract' = Contract (ToT contractEps) (ToT st) -> Contract
forall (param :: T) (store :: T). Contract param store -> Contract
convertContract (Contract (ToT contractEps) (ToT st) -> Contract)
-> (Contract contractEps st vd
    -> Contract (ToT contractEps) (ToT st))
-> Contract contractEps st vd
-> Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract contractEps st vd -> Contract (ToT contractEps) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract (Contract contractEps st vd -> Contract)
-> Contract contractEps st vd -> Contract
forall a b. (a -> b) -> a -> b
$ Contract contractEps st vd
contract
    in TestName -> [TestTree] -> TestTree
testGroup TestName
name
        [ TestName -> Assertion -> TestTree
testCase TestName
"Contract type matches entrypoint spec" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
            Either TCError EPMismatch -> Assertion
M.assertEPComparisonSuccessful (Either TCError EPMismatch -> Assertion)
-> (EPMismatch -> Either TCError EPMismatch)
-> EPMismatch
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPMismatch -> Either TCError EPMismatch
forall a b. b -> Either a b
Right (EPMismatch -> Either TCError EPMismatch)
-> (EPMismatch -> EPMismatch)
-> EPMismatch
-> Either TCError EPMismatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPMismatch -> EPMismatch
compareMode (EPMismatch -> Assertion) -> EPMismatch -> Assertion
forall a b. (a -> b) -> a -> b
$
              EPExpected (Map EpName Ty)
-> EPActual (Map EpName Ty) -> EPMismatch
M.compareEntrypoints (Map EpName Ty -> EPExpected (Map EpName Ty)
forall a. a -> EPExpected a
M.EPExpected Map EpName Ty
spec) (Map EpName Ty -> EPActual (Map EpName Ty)
forall a. a -> EPActual a
M.EPActual Map EpName Ty
entrypointsInType)
        , (EPMismatch -> EPMismatch)
-> TestName -> Contract -> Map EpName Ty -> TestTree
M.testContractEntrypoints EPMismatch -> EPMismatch
compareMode
            TestName
"Untyped contract matches entrypoint spec" Contract
contract' Map EpName Ty
spec
        ]