Scenario.hs

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

module Test.Cleveland.Internal.Scenario
  ( Scenario(..)
  , scenario
  , scenarioEmulated
  , withInitialNow
  , withInitialLevel
  , withMinBlockTime
  , withChainId
  ) where

import Morley.Michelson.Runtime.GState (gsChainIdL)
import Morley.Tezos.Core qualified as TC
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Pure

-- | A type representing a finalized scenario
data Scenario m where
  ScenarioCleveland :: ClevelandT m () -> Scenario m
  ScenarioEmulated :: EmulatedT PureM () -> Scenario PureM

-- | Finalize a generic cleveland scenario.
scenario :: ClevelandT m () -> Scenario m
scenario = ScenarioCleveland

-- | Finalize a scenario that needs emulator-only features.
scenarioEmulated :: EmulatedT PureM () -> Scenario PureM
scenarioEmulated = ScenarioEmulated

withModifiedState
  :: (PureState -> PureState)
  -> Scenario PureM
  -> Scenario PureM
withModifiedState modfn = \case
  ScenarioEmulated emulated ->
    ScenarioEmulated $ lift (modify modfn) >> emulated
  ScenarioCleveland cleveland ->
    ScenarioCleveland $ lift (modify modfn) >> cleveland

-- | Use with an emulated 'Scenario' to configure the initial @now@ value in tests.
--
-- Example :
-- > testScenarioOnEmulator "Testname" $ withInitialNow (Timestamp 10000000) $ scenarioEmulated $ tests
-- > testScenarioOnEmulator "Testname" $ withInitialNow (Timestamp 10000000) $ scenario $ tests
withInitialNow
  :: TC.Timestamp
  -> Scenario PureM
  -> Scenario PureM
withInitialNow = withModifiedState . set psNow

-- | Similar to 'withInitialNow' but for the initial level
withInitialLevel
  :: Natural
  -> Scenario PureM
  -> Scenario PureM
withInitialLevel = withModifiedState . set psLevel

-- | Similar to 'withInitialNow' but for the @MINIMAL_BLOCK_DELAY@ protocol constant.
withMinBlockTime
  :: Natural
  -> Scenario PureM
  -> Scenario PureM
withMinBlockTime = withModifiedState . set psMinBlockTime

-- | Similar to 'withInitialNow' but for the chain id
withChainId
  :: TC.ChainId
  -> Scenario PureM
  -> Scenario PureM
withChainId = withModifiedState . set (psGState . gsChainIdL)