{-# LANGUAGE TemplateHaskell #-}

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

import Cardano.Prelude
import Test.Cardano.Chain.Genesis.Gen
import Test.Cardano.Crypto.Gen (genProtocolMagicId)
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  roundTripsCBORBuildable,
  roundTripsCBORShow,
 )
import Test.Cardano.Prelude (discoverRoundTripArg)
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS)

--------------------------------------------------------------------------------
-- GenesisKeyHash
--------------------------------------------------------------------------------
ts_roundTripGenesisKeyHashesCBOR :: TSProperty
ts_roundTripGenesisKeyHashesCBOR :: TSProperty
ts_roundTripGenesisKeyHashesCBOR =
  TestLimit
-> Gen GenesisKeyHashes
-> (GenesisKeyHashes -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen GenesisKeyHashes
genGenesisKeyHashes GenesisKeyHashes -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

tests :: TSGroup
tests :: TSGroup
tests =
  [TSGroup] -> TSGroup
concatTSGroups
    [$$discoverRoundTripArg]

--------------------------------------------------------------------------------
-- GenesisAvvmBalances
--------------------------------------------------------------------------------
ts_roundTripGenesisAvvmBalances :: TSProperty
ts_roundTripGenesisAvvmBalances :: TSProperty
ts_roundTripGenesisAvvmBalances =
  TestLimit
-> Gen GenesisAvvmBalances
-> (GenesisAvvmBalances -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen GenesisAvvmBalances
genGenesisAvvmBalances GenesisAvvmBalances -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- GenesisNonAvvmBalances
--------------------------------------------------------------------------------
ts_roundTripGenesisNonAvvmBalances :: TSProperty
ts_roundTripGenesisNonAvvmBalances :: TSProperty
ts_roundTripGenesisNonAvvmBalances =
  TestLimit
-> Gen GenesisNonAvvmBalances
-> (GenesisNonAvvmBalances -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen GenesisNonAvvmBalances
genGenesisNonAvvmBalances GenesisNonAvvmBalances -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- GenesisDelegation
--------------------------------------------------------------------------------
ts_roundTripGenesisDelegation :: TSProperty
ts_roundTripGenesisDelegation :: TSProperty
ts_roundTripGenesisDelegation =
  TestLimit
-> Gen GenesisDelegation
-> (GenesisDelegation -> PropertyT IO ())
-> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 (ProtocolMagicId -> Gen GenesisDelegation
genGenesisDelegation (ProtocolMagicId -> Gen GenesisDelegation)
-> GenT Identity ProtocolMagicId -> Gen GenesisDelegation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity ProtocolMagicId
genProtocolMagicId) GenesisDelegation -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- GenesisData
--------------------------------------------------------------------------------
ts_roundTripGenesisData :: TSProperty
ts_roundTripGenesisData :: TSProperty
ts_roundTripGenesisData =
  TestLimit
-> Gen Config -> (Config -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 (ProtocolMagicId -> Gen Config
genConfig (ProtocolMagicId -> Gen Config)
-> GenT Identity ProtocolMagicId -> Gen Config
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity ProtocolMagicId
genProtocolMagicId) Config -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow