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

{-# OPTIONS_GHC -Wno-deprecations #-}

-- | Utility functions for unit testing.

module Test.Cleveland.Michelson.Unit
  {-# DEPRECATED "Use the new Test.Cleveland interface instead. Entrypoint utilities\
  \ are moved to Test.Cleveland.Michelson.Entrypoints" #-}
  ( ContractReturn
  , ContractPropValidator
  , EPMismatch
  , contractProp
  , contractPropVal
  , validateSuccess
  , validateStorageIs
  , validateMichelsonFailsWith
  ) where

import Data.Constraint ((\\))
import Fmt ((+|), (|+))
import Test.HUnit (Assertion, assertFailure, (@?=))
import Test.Hspec.Expectations (Expectation, shouldBe, shouldSatisfy)

import Lorentz.Constraints.Scopes (NiceConstant, niceConstantEvi)
import Morley.Michelson.Interpret
  (ContractEnv, ContractReturn, MichelsonFailed(..), MichelsonFailureWithStack(..), interpret)
import Morley.Michelson.Typed (Contract, IsoValue(..), ToT)
import Morley.Michelson.Typed qualified as T
import Test.Cleveland.Michelson.Dummy (dummyBigMapCounter, dummyGlobalCounter)
import Test.Cleveland.Michelson.Internal.Entrypoints

-- | Type for contract execution validation.
--
-- It's a function which is supplied with contract execution output
-- (failure or new storage with operation list).
--
-- Function returns a property which type is designated by type variable @prop@
-- and might be @Test.QuickCheck.Property@ or 'Expectation'
-- or anything else relevant.
type ContractPropValidator st prop = ContractReturn st -> prop

-- | ContractCode's property tester against given input.
-- Takes contract environment, initial storage and parameter,
-- interprets contract on this input and invokes validation function.
contractProp
  :: ( IsoValue param, IsoValue storage
     , ToT param ~ cp, ToT storage ~ st
     , T.ParameterScope cp
     )
  => Contract cp st
  -> ContractPropValidator st prop
  -> ContractEnv
  -> param
  -> storage
  -> prop
contractProp :: Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> param
-> storage
-> prop
contractProp Contract cp st
instr ContractPropValidator st prop
check ContractEnv
env param
param storage
initSt =
  Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> Value cp
-> Value st
-> prop
forall (cp :: T) (st :: T) prop.
ParameterScope cp =>
Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> Value cp
-> Value st
-> prop
contractPropVal Contract cp st
instr ContractPropValidator st prop
check ContractEnv
env (param -> Value (ToT param)
forall a. IsoValue a => a -> Value (ToT a)
toVal param
param) (storage -> Value (ToT storage)
forall a. IsoValue a => a -> Value (ToT a)
toVal storage
initSt)

-- | Version of 'contractProp' which takes 'T.Value' as arguments instead
-- of regular Haskell values.
--
-- This function assumes that contract has no explicit default entrypoints
-- and you always have to construct parameter manually; if you need to test
-- contract calling specific entrypoints, use integrational testing defined
-- by "Test.Cleveland.Michelson.Integrational" module.
contractPropVal
  :: (T.ParameterScope cp)
  => Contract cp st
  -> ContractPropValidator st prop
  -> ContractEnv
  -> T.Value cp
  -> T.Value st
  -> prop
contractPropVal :: Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> Value cp
-> Value st
-> prop
contractPropVal Contract cp st
instr ContractPropValidator st prop
check ContractEnv
env Value cp
param Value st
initSt =
  ContractPropValidator st prop
check ContractPropValidator st prop -> ContractPropValidator st prop
forall a b. (a -> b) -> a -> b
$ Contract cp st
-> EntrypointCallT cp cp
-> Value cp
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> ContractReturn st
forall (cp :: T) (st :: T) (arg :: T).
Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> ContractReturn st
interpret Contract cp st
instr EntrypointCallT cp cp
forall (param :: T).
ParameterScope param =>
EntrypointCallT param param
T.unsafeEpcCallRoot Value cp
param Value st
initSt GlobalCounter
dummyGlobalCounter BigMapCounter
dummyBigMapCounter ContractEnv
env

----------------------------------------------------------------------------
-- Validators
----------------------------------------------------------------------------

-- | 'ContractPropValidator' that expects a successful termination.
validateSuccess :: HasCallStack => ContractPropValidator st Expectation
validateSuccess :: ContractPropValidator st Expectation
validateSuccess (Either MichelsonFailureWithStack ([Operation], Value st)
res, (InterpreterState, MorleyLogs)
_) = Either MichelsonFailureWithStack ([Operation], Value st)
res Either MichelsonFailureWithStack ([Operation], Value st)
-> (Either MichelsonFailureWithStack ([Operation], Value st)
    -> Bool)
-> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` Either MichelsonFailureWithStack ([Operation], Value st) -> Bool
forall a b. Either a b -> Bool
isRight

-- | 'ContractPropValidator' that expects contract execution to
-- succeed and update storage to a particular constant value.
validateStorageIs
  :: IsoValue st
  => st -> ContractPropValidator (ToT st) Assertion
validateStorageIs :: st -> ContractPropValidator (ToT st) Expectation
validateStorageIs st
expected (Either MichelsonFailureWithStack ([Operation], Value (ToT st))
res, (InterpreterState, MorleyLogs)
_) =
  case Either MichelsonFailureWithStack ([Operation], Value (ToT st))
res of
    Left MichelsonFailureWithStack
err ->
      String -> Expectation
forall a. HasCallStack => String -> IO a
assertFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ Builder
"Unexpected interpretation failure: " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonFailureWithStack
err MichelsonFailureWithStack -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    Right ([Operation]
_ops, Value (ToT st)
got) ->
      Value (ToT st)
got Value (ToT st) -> Value (ToT st) -> Expectation
forall a. (HasCallStack, Eq a, Show a) => a -> a -> Expectation
@?= st -> Value (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
toVal st
expected

-- | 'ContractPropValidator' that expects a given failure.
validateMichelsonFailsWith
  :: forall v st. NiceConstant v
  => v -> ContractPropValidator st Expectation
validateMichelsonFailsWith :: v -> ContractPropValidator st Expectation
validateMichelsonFailsWith v
v (Either MichelsonFailureWithStack ([Operation], Value st)
res, (InterpreterState, MorleyLogs)
_) = case Either MichelsonFailureWithStack ([Operation], Value st)
res of
  Right ([Operation], Value st)
_ -> String -> Expectation
forall a. HasCallStack => String -> IO a
assertFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
    Builder
"contract was expected to fail with " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonFailed
expected MichelsonFailed -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" but didn't."
  Left MichelsonFailureWithStack{InstrCallStack
MichelsonFailed
mfwsInstrCallStack :: MichelsonFailureWithStack -> InstrCallStack
mfwsFailed :: MichelsonFailureWithStack -> MichelsonFailed
mfwsInstrCallStack :: InstrCallStack
mfwsFailed :: MichelsonFailed
..} -> MichelsonFailed
mfwsFailed MichelsonFailed -> MichelsonFailed -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` MichelsonFailed
expected
  where
    expected :: MichelsonFailed
expected = Value (ToT v) -> MichelsonFailed
forall (t :: T).
(SingI t, ConstantScope t) =>
Value t -> MichelsonFailed
MichelsonFailedWith (v -> Value (ToT v)
forall a. IsoValue a => a -> Value (ToT a)
toVal v
v) (ConstantScope (ToT v) => MichelsonFailed)
-> (((SingI (ToT v), WellTyped (ToT v),
      FailOnOperationFound (ContainsOp (ToT v)),
      FailOnBigMapFound (ContainsBigMap (ToT v)),
      FailOnContractFound (ContainsContract (ToT v)),
      FailOnTicketFound (ContainsTicket (ToT v)),
      FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
     KnownValue v)
    :- ConstantScope (ToT v))
-> MichelsonFailed
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT v), WellTyped (ToT v),
  FailOnOperationFound (ContainsOp (ToT v)),
  FailOnBigMapFound (ContainsBigMap (ToT v)),
  FailOnContractFound (ContainsContract (ToT v)),
  FailOnTicketFound (ContainsTicket (ToT v)),
  FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
 KnownValue v)
:- ConstantScope (ToT v)
forall a. NiceConstant a :- ConstantScope (ToT a)
niceConstantEvi @v