ComparePairs.hs

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

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

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

import Hedgehog.Gen.Tezos.Core (genMutez)
import Morley.Tezos.Core (Mutez, toMutez)
import Test.Cleveland
import Test.Cleveland.Lorentz.Import (embedContract)
import Test.Cleveland.Util (genTuple2)

import Test.Util.Contracts

type Param = ((Mutez, Mutez), (Mutez, Mutez))

-- | Spec to test compare.tz contract.
test_compare_pairs :: [TestTree]
test_compare_pairs =
    [ testScenarioOnEmulator "success test" $ myScenario
          ( (toMutez 10, toMutez 11)
          , (toMutez 10, toMutez 12)
          )
    , testProperty "Random check" $
        withTests 200 $ property $ do
          inputParam <- forAll $ genTuple2 (genTuple2 genMutez genMutez) (genTuple2 genMutez genMutez)
          testScenarioProps $ myScenario inputParam
    ]
  where
    myScenario :: Monad m => Param -> Scenario m
    myScenario inp = scenario do
      handle <- originateSimple "compare_pairs" [] contract
      call handle CallDefault inp
      getStorage handle @@== mkExpected inp
      pure ()

    contract = $$(embedContract @Param @[Bool] @() (inContractsDir "compare_pairs.tz"))

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