Level.hs

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

module TestSuite.Cleveland.Level
  ( test_CompareLevels
  , test_Level
  ) where

import Test.Tasty (TestTree, testGroup)

import Morley.Michelson.Runtime.Dummy (dummyLevel)
import Test.Cleveland

-- | Smart comparison for levels.
--
-- In a run against real chain, level can manage to advance during the test
-- execution, so we have to allow inaccuracy in return values of @getLevel@.
compareLevels
  :: MonadCleveland caps m
  => Natural  -- ^ Level we got
  -> Natural  -- ^ Expected level
  -> m Bool
compareLevels x y = do
  cmp <- ifEmulation (pure (==)) (pure \got expected -> and [got >= expected, got <= expected + 1])
  pure $ cmp x y

test_CompareLevels :: [TestTree]
test_CompareLevels =
  [ testScenarioOnEmulator "compareLevels allows the desired numbers on emulator" $ scenario do
      compareLevels 5 5 @@== True
      compareLevels 6 5 @@== False
  , testScenarioOnNetwork "compareLevels allows the desired numbers on network" $ scenario do
      compareLevels 5 5 @@== True
      compareLevels 6 5 @@== True
  ]

test_Level :: TestTree
test_Level =
  testGroup "functions for level advancing" $
    [ testGroup "advanceLevel" $
      [ testGroup "advances levels by the exact number" $
          testDeltas <&> \delta ->
            testScenario (show delta) $ scenario do
              l0 <- getLevel
              advanceLevel delta
              l1 <- getLevel

              result <- compareLevels l1 (l0 + delta)
              assert result $
                mconcat
                  [ "Expected exactly "
                  , show delta
                  , " levels to be skipped, but "
                  , show (l1 - l0)
                  , " were actually skipped."
                  ]
      ]
    , testGroup "advanceToLevel" $
        [ testGroup "advances levels to the exact level" $
            testDeltas <&> \delta ->
              testScenario (show delta) $ scenario do
                l0 <- getLevel
                advanceToLevel (l0 + delta)
                l1 <- getLevel

                result <- compareLevels l1 (l0 + delta)
                assert result $
                  mconcat
                    [ "Expected to be at level "
                    , show (l0 + delta)
                    , " but was at "
                    , show l1
                    , "."
                    ]
        , testScenario "is no-op if target level is lower than current level"  $ scenario do
              l0 <- getLevel
              advanceToLevel (fromInteger $ (fromIntegral @_ @Integer l0) - 4)
              l1 <- getLevel

              result <- compareLevels l1 l0
              assert result $
                mconcat
                  [ "Expected to be at level "
                  , show l0
                  , " but was at "
                  , show l1
                  , "."
                  ]
        ]
    , testScenarioOnEmulator "initial level is 'dummyLevel' in the emulator" $ scenarioEmulated do
        l0 <- getLevel
        l0 @== dummyLevel
    ]
  where
    testDeltas :: [Natural]
    testDeltas =
      [0, 1, 2, 3, 4]