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

-- | Unit tests for Lorentz.
module Lorentz.Test.Unit
    ( expectContractEntrypoints
    ) where

import Test.HUnit (Assertion, assertFailure)

import Lorentz hiding (contract)
import Michelson.Test.Unit (matchContractEntryPoints)
import Michelson.Typed (convertContract, flattenEntryPoints)

-- | Expect the given contract to have some specific entrypoints.
expectContractEntrypoints
  :: forall expectedEps contractEps st.
     ( NiceParameterFull expectedEps
     , NiceParameterFull contractEps
     , NiceStorage st
     )
  => Contract contractEps st -> Assertion
expectContractEntrypoints :: Contract contractEps st -> Assertion
expectContractEntrypoints contract :: Contract contractEps st
contract =
  ((KnownValue expectedEps,
  (KnownT (ToT expectedEps),
   FailOnOperationFound (ContainsOp (ToT expectedEps)),
   FailOnNestedBigMapsFound
     (ContainsNestedBigMaps (ToT expectedEps))))
 :- ParameterScope (ToT expectedEps))
-> (ParameterScope (ToT expectedEps) => Assertion) -> Assertion
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue expectedEps,
 (KnownT (ToT expectedEps),
  FailOnOperationFound (ContainsOp (ToT expectedEps)),
  FailOnNestedBigMapsFound
    (ContainsNestedBigMaps (ToT expectedEps))))
:- ParameterScope (ToT expectedEps)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @expectedEps) ((ParameterScope (ToT expectedEps) => Assertion) -> Assertion)
-> (ParameterScope (ToT expectedEps) => Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$
  ((KnownValue contractEps,
  (KnownT (ToT contractEps),
   FailOnOperationFound (ContainsOp (ToT contractEps)),
   FailOnNestedBigMapsFound
     (ContainsNestedBigMaps (ToT contractEps))))
 :- ParameterScope (ToT contractEps))
-> (ParameterScope (ToT contractEps) => Assertion) -> Assertion
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue contractEps,
 (KnownT (ToT contractEps),
  FailOnOperationFound (ContainsOp (ToT contractEps)),
  FailOnNestedBigMapsFound
    (ContainsNestedBigMaps (ToT contractEps))))
:- ParameterScope (ToT contractEps)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @contractEps) ((ParameterScope (ToT contractEps) => Assertion) -> Assertion)
-> (ParameterScope (ToT contractEps) => Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$
  ((KnownValue st,
  (KnownT (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
   FailOnContractFound (ContainsContract (ToT st))))
 :- StorageScope (ToT st))
-> (StorageScope (ToT st) => Assertion) -> Assertion
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue st,
 (KnownT (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
  FailOnContractFound (ContainsContract (ToT st))))
:- StorageScope (ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st) ((StorageScope (ToT st) => Assertion) -> Assertion)
-> (StorageScope (ToT st) => Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ do
    let entrypoints :: Map EpName Type
entrypoints = ParamNotes (ToT expectedEps) -> Map EpName Type
forall (t :: T). SingI t => ParamNotes t -> Map EpName Type
flattenEntryPoints (ParamNotes (ToT expectedEps) -> Map EpName Type)
-> ParamNotes (ToT expectedEps) -> Map EpName Type
forall a b. (a -> b) -> a -> b
$ ParameterDeclaresEntryPoints expectedEps =>
ParamNotes (ToT expectedEps)
forall cp. ParameterDeclaresEntryPoints cp => ParamNotes (ToT cp)
parameterEntryPointsToNotes @expectedEps
        contract' :: Contract
contract' = Contract (ToT contractEps) (ToT st) -> Contract
forall (param :: T) (store :: T).
(SingI param, SingI store) =>
Contract param store -> Contract
convertContract (Contract (ToT contractEps) (ToT st) -> Contract)
-> (Contract contractEps st -> Contract (ToT contractEps) (ToT st))
-> Contract contractEps st
-> Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract contractEps st -> Contract (ToT contractEps) (ToT st)
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Contract cp st -> Contract (ToT cp) (ToT st)
compileLorentzContract (Contract contractEps st -> Contract)
-> Contract contractEps st -> Contract
forall a b. (a -> b) -> a -> b
$ Contract contractEps st
contract
    case HasCallStack =>
Contract -> Map EpName Type -> Either (NonEmpty (EpName, Type)) ()
Contract -> Map EpName Type -> Either (NonEmpty (EpName, Type)) ()
matchContractEntryPoints Contract
contract' Map EpName Type
entrypoints of
      Left eps :: NonEmpty (EpName, Type)
eps -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ "Some entrypoints were not found " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NonEmpty (EpName, Type) -> String
forall b a. (Show a, IsString b) => a -> b
show NonEmpty (EpName, Type)
eps
      Right _ -> Assertion
forall (f :: * -> *). Applicative f => f ()
pass