Level.hs

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

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

import Test.Tasty
import Test.Tasty.HUnit

import Morley.Michelson.Runtime.Dummy (dummyLevel)
import Test.Cleveland
import Test.Cleveland.Internal.Abstract (EmulatedCaps)

-- | 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
  :: RunMode caps
  -> Natural  -- ^ Level we got
  -> Natural  -- ^ Expected level
  -> Bool
compareLevels = \case
  EmulationMode -> (==)
  NetworkMode -> \got expected -> and [got >= expected, got <= expected + 1]

test_CompareLevels :: TestTree
test_CompareLevels =
  testCase "compareLevels allows the desired numbers" do
    compareLevels (EmulationMode @(EmulatedCaps PureM)) 5 5 @?= True
    compareLevels (EmulationMode @(EmulatedCaps PureM)) 6 5 @?= False

    compareLevels NetworkMode 5 5 @?= True
    compareLevels NetworkMode 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

              runMode <- getRunMode
              assert (compareLevels runMode l1 (l0 + delta)) $
                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

                runMode <- getRunMode
                assert (compareLevels runMode l1 (l0 + delta)) $
                  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

              runMode <- getRunMode
              assert (compareLevels runMode l1 l0) $
                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]