{-# 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
  EpochSlots
sc <- Gen EpochSlots -> PropertyT IO EpochSlots
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  SlotNumber
fsId <- Gen SlotNumber -> PropertyT IO SlotNumber
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen SlotNumber -> PropertyT IO SlotNumber)
-> Gen SlotNumber -> PropertyT IO SlotNumber
forall a b. (a -> b) -> a -> b
$ Gen SlotNumber
genSlotNumber
  EpochAndSlotCount
_ <- EpochAndSlotCount -> PropertyT IO EpochAndSlotCount
forall a. a -> PropertyT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochAndSlotCount -> PropertyT IO EpochAndSlotCount)
-> EpochAndSlotCount -> PropertyT IO EpochAndSlotCount
forall a b. (a -> b) -> a -> b
$ EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
sc SlotNumber
fsId
  PropertyT IO ()
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 (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
  (EpochAndSlotCount
sId, EpochSlots
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
  EpochAndSlotCount
sId EpochAndSlotCount -> EpochAndSlotCount -> PropertyT IO ()
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 (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
  EpochSlots
sc <- Gen EpochSlots -> PropertyT IO EpochSlots
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  EpochAndSlotCount
_ <- Gen EpochAndSlotCount -> PropertyT IO EpochAndSlotCount
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen EpochAndSlotCount -> PropertyT IO EpochAndSlotCount)
-> Gen EpochAndSlotCount -> PropertyT IO EpochAndSlotCount
forall a b. (a -> b) -> a -> b
$ EpochSlots -> Gen EpochAndSlotCount
genEpochAndSlotCount EpochSlots
sc
  PropertyT IO ()
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 (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
  EpochSlots
es <- Gen EpochSlots -> PropertyT IO EpochSlots
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen EpochSlots
genEpochSlots
  SlotNumber
slot <- Gen SlotNumber -> PropertyT IO SlotNumber
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 (EpochAndSlotCount -> SlotNumber)
-> EpochAndSlotCount -> SlotNumber
forall a b. (a -> b) -> a -> b
$ EpochSlots -> SlotNumber -> EpochAndSlotCount
fromSlotNumber EpochSlots
es SlotNumber
slot
  SlotNumber
slot SlotNumber -> SlotNumber -> PropertyT IO ()
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 (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
  SlotCount
sc <- Gen SlotCount -> PropertyT IO SlotCount
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SlotCount
genSlotCount
  SlotNumber
fs <- Gen SlotNumber -> PropertyT IO SlotNumber
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SlotNumber
genSlotNumber
  let added :: SlotNumber
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)
  SlotCount -> SlotNumber -> SlotNumber
addSlotCount SlotCount
sc SlotNumber
fs
    SlotNumber -> SlotNumber -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== if SlotNumber -> Word64
unSlotNumber SlotNumber
fs Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (SlotCount -> Word64
unSlotCount SlotCount
sc)
      then SlotNumber
added
      else Word64 -> SlotNumber
SlotNumber Word64
forall a. Bounded a => a
maxBound

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