{-# LANGUAGE TemplateHaskell #-}

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

import Cardano.Chain.Slotting (EpochSlots (..), SlotNumber)
import Cardano.Prelude
import Hedgehog (Property)
import Test.Cardano.Chain.Slotting.Example (
  exampleEpochAndSlotCount,
  exampleEpochNumber,
 )
import Test.Cardano.Chain.Slotting.Gen (
  feedPMEpochSlots,
  genEpochAndSlotCount,
  genEpochNumber,
  genEpochSlots,
  genSlotNumber,
 )
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  goldenTestCBOR,
  roundTripsCBORBuildable,
 )
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS)

--------------------------------------------------------------------------------
-- EpochNumber
--------------------------------------------------------------------------------
golden_EpochNumber :: Property
golden_EpochNumber :: Property
golden_EpochNumber = EpochNumber -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR EpochNumber
exampleEpochNumber FilePath
"golden/cbor/slotting/EpochNumber"

ts_roundTripEpochNumberCBOR :: TSProperty
ts_roundTripEpochNumberCBOR :: TSProperty
ts_roundTripEpochNumberCBOR = TestLimit
-> Gen EpochNumber
-> (EpochNumber -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen EpochNumber
genEpochNumber EpochNumber -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- SlotNumber
--------------------------------------------------------------------------------
golden_SlotNumber :: Property
golden_SlotNumber :: Property
golden_SlotNumber = SlotNumber -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR SlotNumber
fsi FilePath
"golden/cbor/slotting/SlotNumber"
  where
    fsi :: SlotNumber
fsi = SlotNumber
5001 :: SlotNumber

ts_roundTripSlotNumberCBOR :: TSProperty
ts_roundTripSlotNumberCBOR :: TSProperty
ts_roundTripSlotNumberCBOR = TestLimit
-> Gen SlotNumber -> (SlotNumber -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen SlotNumber
genSlotNumber SlotNumber -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- EpochSlots
--------------------------------------------------------------------------------
golden_EpochSlots :: Property
golden_EpochSlots :: Property
golden_EpochSlots = EpochSlots -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR EpochSlots
sc FilePath
"golden/cbor/slotting/EpochSlots"
  where
    sc :: EpochSlots
sc = Word64 -> EpochSlots
EpochSlots Word64
474747

ts_roundTripEpochSlotsCBOR :: TSProperty
ts_roundTripEpochSlotsCBOR :: TSProperty
ts_roundTripEpochSlotsCBOR = TestLimit
-> Gen EpochSlots -> (EpochSlots -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen EpochSlots
genEpochSlots EpochSlots -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- EpochAndSlotCount
--------------------------------------------------------------------------------
golden_EpochAndSlotCount :: Property
golden_EpochAndSlotCount :: Property
golden_EpochAndSlotCount =
  EpochAndSlotCount -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR EpochAndSlotCount
exampleEpochAndSlotCount FilePath
"golden/cbor/slotting/EpochAndSlotCount"

ts_roundTripEpochAndSlotCountCBOR :: TSProperty
ts_roundTripEpochAndSlotCountCBOR :: TSProperty
ts_roundTripEpochAndSlotCountCBOR = TestLimit
-> Gen EpochAndSlotCount
-> (EpochAndSlotCount -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen EpochAndSlotCount
gen EpochAndSlotCount -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable
  where
    gen :: Gen EpochAndSlotCount
gen = (ProtocolMagicId -> EpochSlots -> Gen EpochAndSlotCount)
-> Gen EpochAndSlotCount
forall a. (ProtocolMagicId -> EpochSlots -> Gen a) -> Gen a
feedPMEpochSlots (\ProtocolMagicId
_pm EpochSlots
es -> EpochSlots -> Gen EpochAndSlotCount
genEpochAndSlotCount EpochSlots
es)

--------------------------------------------------------------------------------
-- Main test export
--------------------------------------------------------------------------------

tests :: TSGroup
tests :: TSGroup
tests = [TSGroup] -> TSGroup
concatTSGroups [Group -> TSGroup
forall a b. a -> b -> a
const $$FilePath
[(PropertyName, Property)]
Property
FilePath -> GroupName
FilePath -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
golden_EpochNumber :: Property
golden_SlotNumber :: Property
golden_EpochSlots :: Property
golden_EpochAndSlotCount :: Property
discoverGolden, $$discoverRoundTripArg]