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 (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), (Mutez, Mutez))
type ContractStorage = T.Value (ToT [Bool])
type ContractResult x
   = ( Either MichelsonFailed ([x], ContractStorage)
     , InterpreterState)

-- | Spec to test compare.tz contract.
test_compare_pairs :: IO [TestTree]
test_compare_pairs =
  testTreesWithTypedContract (inContractsDir "compare_pairs.tz") $ \contract ->
    let
      contractProp' inputParam =
        contractProp contract (validate (mkExpected inputParam))
          dummyContractEnv inputParam initStorage
    in pure
    [ testProperty "success test" $ property $
        contractProp'
          ( (unsafeMkMutez 10, unsafeMkMutez 11)
          , (unsafeMkMutez 10, unsafeMkMutez 12)
          )
    , testProperty "Random check" $
        withTests 200 $ property $ do
          inputParam <- forAll $ genTuple2 (genTuple2 genMutez genMutez) (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."