{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Chain.Slotting.Properties (
  tests,
)
where

import Cardano.Chain.Slotting (
  SlotCount (..),
  SlotNumber (..),
  addSlotCount,
  fromSlotNumber,
  toSlotNumber,
 )
import Cardano.Prelude
import Hedgehog (forAll, property, success, (===))
import Test.Cardano.Chain.Slotting.Gen (
  genConsistentEpochAndSlotCountEpochSlots,
  genEpochAndSlotCount,
  genEpochSlots,
  genSlotCount,
  genSlotNumber,
 )
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, withTestsTS)

--------------------------------------------------------------------------------
-- EpochAndSlotCount
--------------------------------------------------------------------------------

-- Check that `fromSlotNumber` does not panic for
-- allowed values of `EpochSlots` and `SlotNumber`.
ts_prop_fromSlotNumber :: TSProperty
ts_prop_fromSlotNumber :: TSProperty
ts_prop_fromSlotNumber = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  EpochSlots
sc <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  SlotNumber
fsId <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ Gen SlotNumber
genSlotNumber
  EpochAndSlotCount
_ <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
sc SlotNumber
fsId
  forall (m :: * -> *). MonadTest m => m ()
success

-- Check that `fromSlotNumber . toSlotNumber == id`.
ts_prop_unflattenFlattenEpochAndSlotCount :: TSProperty
ts_prop_unflattenFlattenEpochAndSlotCount :: TSProperty
ts_prop_unflattenFlattenEpochAndSlotCount = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  (EpochAndSlotCount
sId, EpochSlots
sc) <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen (EpochAndSlotCount, EpochSlots)
genConsistentEpochAndSlotCountEpochSlots
  EpochAndSlotCount
sId forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
sc (EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber EpochSlots
sc EpochAndSlotCount
sId)

-- Check that `genEpochAndSlotCount` does not panic for
-- allowed values of `EpochSlots`.
ts_prop_genEpochAndSlotCount :: TSProperty
ts_prop_genEpochAndSlotCount :: TSProperty
ts_prop_genEpochAndSlotCount = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  EpochSlots
sc <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  EpochAndSlotCount
_ <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ EpochSlots -> Gen EpochAndSlotCount
genEpochAndSlotCount EpochSlots
sc
  forall (m :: * -> *). MonadTest m => m ()
success

-- Check that `toSlotNumber . fromSlotNumber == id`.
ts_prop_fromToSlotNumber :: TSProperty
ts_prop_fromToSlotNumber :: TSProperty
ts_prop_fromToSlotNumber = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  EpochSlots
es <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  SlotNumber
slot <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SlotNumber
genSlotNumber
  let fromTo :: SlotNumber
fromTo = EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber EpochSlots
es forall a b. (a -> b) -> a -> b
$ EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
es SlotNumber
slot
  SlotNumber
slot forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== SlotNumber
fromTo

-- Check that `addSlotCount` actually adds.
ts_prop_addSlotCount :: TSProperty
ts_prop_addSlotCount :: TSProperty
ts_prop_addSlotCount = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  SlotCount
sc <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SlotCount
genSlotCount
  SlotNumber
fs <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SlotNumber
genSlotNumber
  let added :: SlotNumber
added = SlotNumber
fs forall a. Num a => a -> a -> a
+ (Word64 -> SlotNumber
SlotNumber forall a b. (a -> b) -> a -> b
$ SlotCount -> Word64
unSlotCount SlotCount
sc)
  SlotCount -> SlotNumber -> SlotNumber
addSlotCount SlotCount
sc SlotNumber
fs
    forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== if SlotNumber -> Word64
unSlotNumber SlotNumber
fs forall a. Ord a => a -> a -> Bool
<= forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- (SlotCount -> Word64
unSlotCount SlotCount
sc)
      then SlotNumber
added
      else Word64 -> SlotNumber
SlotNumber forall a. Bounded a => a
maxBound

tests :: TSGroup
tests :: TSGroup
tests = $$discoverPropArg