packages feed

cleveland-0.1.0: morley-test/Test/Interpreter/Conditionals.hs

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

{-# OPTIONS_GHC -Wno-orphans #-}

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

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

import Hedgehog.Gen.Michelson (genMText)
import Morley.Michelson.Text
import Morley.Michelson.Typed (ToT, convertContract)
import Morley.Michelson.Untyped
import Test.Cleveland
import Test.Cleveland.Michelson.Import (embedContract)

import Test.Util.Contracts

type Param = Either MText (Maybe Integer)

-- | Spec to test conditionals.tz contract.
test_conditionals :: [TestTree]
test_conditionals =
  [ testScenarioOnEmulator "single test" $ scenario do
      handle <- originateUntypedSimple "conditionals" (ValueString "storage") $ convertContract contract
      transfer $ TransferData
        { tdTo = handle
        , tdEntrypoint = DefEpName
        , tdParameter = Left "abc" :: Param
        , tdAmount = 0
        }
      getStorage @MText handle @@== "abc"
  , testProperty "randomized check" $ property do
      inputParam :: Param <- forAll $ Gen.either
        genMText
        (Gen.maybe (Gen.integral (Range.linearFrom 0 -1000 1000)))
      testScenarioProps $ scenario do
        handle <- originateUntypedSimple "conditionals" (ValueString "storage") $ convertContract contract
        transfer TransferData
          { tdTo = handle
          , tdEntrypoint = DefEpName
          , tdParameter = inputParam
          , tdAmount = 0
          }
          & case inputParam of
              Left str -> (>> (getStorage @MText handle @@== str))
              Right Nothing -> expectFailedWith ()
              Right (Just a)
                | a < 0 -> expectFailedWith ()
                | otherwise -> (>> (getStorage @MText handle @@== ""))
  ]
  where
    contract = $$(embedContract @(ToT Param) @(ToT MText) (inContractsDir "tezos_examples/attic/conditionals.tz"))