Time.hs

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

module TestSuite.Cleveland.Time
  ( test_Time
  ) where

import Data.Time (diffUTCTime)
import Test.Tasty (TestTree, testGroup)
import Time (Second, Time)

import Morley.Michelson.Runtime.Dummy (dummyNow)
import Morley.Tezos.Core as Tezos
import Test.Cleveland
import Test.Cleveland.Util

{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}

test_Time :: TestTree
test_Time =
  testGroup "time-related functions" $
    [ testGroup "advanceTime" $
      [ testGroup "advances time by at least the specified amount" $
          testDeltas <&> \delta ->
            testScenario (show delta) $ scenario do
              t0 <- getNow
              advanceTime delta
              t1 <- getNow
              let actualDelta = timestampToUTCTime t1 `diffUTCTime` timestampToUTCTime t0

              assert (actualDelta >= timeToNominalDiffTime delta) $
                mconcat
                  [ "Expected at least "
                  , show delta
                  , " to have passed, but only "
                  , show actualDelta
                  , " have passed."
                  ]

      , testGroup "advances time by exact amount (up to the nearest second) in the emulator" $
          testDeltas <&> \delta ->
            testScenarioOnEmulator (show delta) $ scenarioEmulated do
              t0 <- getNow
              advanceTime delta
              t1 <- getNow
              let actualDelta = timestampToUTCTime t1 `diffUTCTime` timestampToUTCTime t0

              assert (actualDelta == timeToNominalDiffTime (ceilingUnit delta)) $
                mconcat
                  [ "Expected exactly "
                  , show delta
                  , " to have passed, but "
                  , show actualDelta
                  , " have passed."
                  ]
      ]
    , testScenarioOnEmulator "initial time is 'dummyNow' in the emulator" $ scenarioEmulated do
        t0 <- getNow
        t0 @== dummyNow
    ]
  where
    testDeltas :: [Time Second]
    testDeltas =
      [ sec 0
      , sec 0.1
      , sec 0.9
      , sec 1
      , sec 2
      , sec 3
      ]