Conditionals.hs

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

-- | Module, containing spec to test conditionals.tz contract.
module Test.Interpreter.Conditionals
  ( test_conditionals
  ) where

import Hedgehog (MonadTest, forAll, property, withTests, (===))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty (TestTree)
import Test.Tasty.Hedgehog (testProperty)

import Michelson.Interpret (InterpreterState, MichelsonFailed)
import Michelson.Test (contractProp, testTreesWithTypedContract)
import Michelson.Test.Dummy (dummyContractEnv)
import Michelson.Test.Util (eitherIsLeft, eitherIsRight, failedTest, genEither)
import Michelson.Text
import qualified Michelson.Typed as T

import Test.Util.Contracts

type Param = Either MText (Maybe Integer)
type ContractStorage = T.Value (T.ToT MText)
type ContractResult x
   = ( Either MichelsonFailed ([x], ContractStorage)
     , InterpreterState)

-- | Spec to test conditionals.tz contract.
test_conditionals :: IO [TestTree]
test_conditionals =
  testTreesWithTypedContract (inContractsDir "tezos_examples/attic/conditionals.tz") $ \contract ->
    let
      contractProp' :: MonadTest m => Param -> m ()
      contractProp' inputParam =
        contractProp contract (validate inputParam) dummyContractEnv inputParam
          [mt|storage|]
    in pure
    [ testProperty "success 1 test" $
        property $ contractProp' $ Left [mt|abc|]
    , testProperty "Random check" $
        withTests 200 $ property $ do
          inputParam <- forAll $ genEither
            genMText
            (Gen.maybe (Gen.integral (Range.linearFrom 0 -1000 1000)))
          contractProp' inputParam
    ]
  where
    validate
      :: MonadTest m
      => Show x
      => Param
      -> ContractResult x
      -> m ()
    validate (Left a) (Right ([], T.VString b), _) = a === b
    validate (Right Nothing) r = eitherIsLeft $ fst r
    validate (Right (Just a)) r
      | a < 0 = eitherIsLeft $ fst r
      | otherwise = eitherIsRight $ fst r
    validate _ res = failedTest $ "Unexpected result: " <> show res