Conditionals.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-orphans #-}

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

import Hedgehog (forAll, property)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified 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"))