Compare.hs

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

-- | Module, containing spec to test compare.tz contract.
module Test.Interpreter.Compare
  ( test_compare
  ) where

import Hedgehog (MonadTest, forAll, property, withTests, (===))
import Test.Tasty (TestTree)
import Test.Tasty.Hedgehog (testProperty)

import Michelson.Interpret (InterpreterState, MichelsonFailed)
import Michelson.Test (contractProp, testTreesWithTypedContract)
import Michelson.Test.Dummy
import Michelson.Test.Gen (genMutez)
import Michelson.Test.Util (failedTest, genTuple2)
import Michelson.Typed (ToT, fromVal)
import qualified Michelson.Typed as T
import Tezos.Core (Mutez, unsafeMkMutez)

import Test.Util.Contracts

type Param = (Mutez, Mutez)
type ContractStorage = T.Value (ToT [Bool])
type ContractResult x
   = ( Either MichelsonFailed ([x], ContractStorage)
     , InterpreterState)

-- | Spec to test compare.tz contract.
test_compare :: IO [TestTree]
test_compare =
  testTreesWithTypedContract (inContractsDir "tezos_examples/macros/compare.tz") $ \contract ->
    let
      contractProp' inputParam =
        contractProp contract (validate (mkExpected inputParam))
        dummyContractEnv inputParam initStorage
    in pure
    [ testProperty "success test" $ property $
        contractProp' (unsafeMkMutez 10, unsafeMkMutez 11)
    , testProperty "Random check" $
        withTests 200 $ property $ do
          inputParam <- forAll $ genTuple2 genMutez genMutez
          contractProp' inputParam
    ]
  where
    initStorage :: [Bool]
    initStorage = []

    mkExpected :: Param -> [Bool]
    mkExpected (a, b) = [a == b, a > b, a < b, a >= b, a <= b]

    validate
      :: MonadTest m
      => [Bool]
      -> ContractResult x
      -> m ()
    validate e (Right ([], fromVal -> l), _) = l === e
    validate _ (Left _, _) = failedTest "Unexpected fail of sctipt."
    validate _ _ = failedTest "Invalid result got."