{-# 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  sc <- Gen EpochSlots -> PropertyT IO EpochSlots
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  fsId <- forAll $ genSlotNumber
  _ <- pure $ fromSlotNumber sc fsId
  success

-- Check that `fromSlotNumber . toSlotNumber == id`.
ts_prop_unflattenFlattenEpochAndSlotCount :: TSProperty
ts_prop_unflattenFlattenEpochAndSlotCount :: TSProperty
ts_prop_unflattenFlattenEpochAndSlotCount = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  (sId, sc) <- Gen (EpochAndSlotCount, EpochSlots)
-> PropertyT IO (EpochAndSlotCount, EpochSlots)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen (EpochAndSlotCount, EpochSlots)
genConsistentEpochAndSlotCountEpochSlots
  sId === fromSlotNumber sc (toSlotNumber sc 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 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  sc <- Gen EpochSlots -> PropertyT IO EpochSlots
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  _ <- forAll $ genEpochAndSlotCount sc
  success

-- Check that `toSlotNumber . fromSlotNumber == id`.
ts_prop_fromToSlotNumber :: TSProperty
ts_prop_fromToSlotNumber :: TSProperty
ts_prop_fromToSlotNumber = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  es <- Gen EpochSlots -> PropertyT IO EpochSlots
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  slot <- forAll genSlotNumber
  let fromTo = EpochSlots -> EpochAndSlotCount -> SlotNumber
toSlotNumber EpochSlots
es (EpochAndSlotCount -> SlotNumber)
-> EpochAndSlotCount -> SlotNumber
forall a b. (a -> b) -> a -> b
$ EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
es SlotNumber
slot
  slot === fromTo

-- Check that `addSlotCount` actually adds.
ts_prop_addSlotCount :: TSProperty
ts_prop_addSlotCount :: TSProperty
ts_prop_addSlotCount = TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100 (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
  sc <- Gen SlotCount -> PropertyT IO SlotCount
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SlotCount
genSlotCount
  fs <- forAll genSlotNumber
  let added = SlotNumber
fs SlotNumber -> SlotNumber -> SlotNumber
forall a. Num a => a -> a -> a
+ (Word64 -> SlotNumber
SlotNumber (Word64 -> SlotNumber) -> Word64 -> SlotNumber
forall a b. (a -> b) -> a -> b
$ SlotCount -> Word64
unSlotCount SlotCount
sc)
  addSlotCount sc fs
    === if unSlotNumber fs <= maxBound - (unSlotCount sc)
      then added
      else SlotNumber maxBound

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