{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Chain.Buildable (
  tests,
)
where

import Cardano.Chain.Common (
  Attributes (Attributes),
  UnparsedFields (UnparsedFields),
 )
import Cardano.Prelude
import Formatting (Buildable, build, sformat)
import Hedgehog (PropertyT, eval, property)
import Test.Cardano.Chain.Block.Gen (
  genBlockSignature,
  genBlockWithEpochSlots,
  genHeader,
 )
import qualified Test.Cardano.Chain.Block.Gen as Block
import qualified Test.Cardano.Chain.Common.Gen as Common
import qualified Test.Cardano.Chain.Delegation.Gen as Delegation
import qualified Test.Cardano.Chain.Genesis.Gen as Genesis
import Test.Cardano.Chain.Slotting.Gen (feedPMEpochSlots)
import qualified Test.Cardano.Chain.Slotting.Gen as Slotting
import qualified Test.Cardano.Chain.UTxO.Gen as UTxO
import qualified Test.Cardano.Chain.Update.Gen as Update
import Test.Cardano.Crypto.Gen (feedPM)
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, eachOfTS)

--------------------------------------------------------------------------------
-- Test helpers
--------------------------------------------------------------------------------

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

-- | Check that the 'Buildable' instance for @a@ doesn't throw exceptions
isBuildable :: Buildable a => a -> PropertyT IO ()
isBuildable :: forall a. Buildable a => a -> PropertyT IO ()
isBuildable = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. (MonadTest m, HasCallStack) => a -> m a
eval forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format Text a -> a
sformat forall a r. Buildable a => Format r (a -> r)
build

--------------------------------------------------------------------------------
-- Block
--------------------------------------------------------------------------------

ts_prop_blockIsBuildable :: TSProperty
ts_prop_blockIsBuildable :: TSProperty
ts_prop_blockIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen (WithEpochSlots Block)
genBlockWithEpochSlots) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_blockProofIsBuildable :: TSProperty
ts_prop_blockProofIsBuildable :: TSProperty
ts_prop_blockProofIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Proof
Block.genProof) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_headerIsBuildable :: TSProperty
ts_prop_headerIsBuildable :: TSProperty
ts_prop_headerIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS
    TestLimit
100
    (forall a. (ProtocolMagicId -> EpochSlots -> Gen a) -> Gen a
feedPMEpochSlots (forall a.
(ProtocolMagicId -> EpochSlots -> Gen a)
-> ProtocolMagicId -> EpochSlots -> Gen (WithEpochSlots a)
Slotting.genWithEpochSlots ProtocolMagicId -> EpochSlots -> Gen Header
genHeader))
    forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_blockSignatureIsBuildable :: TSProperty
ts_prop_blockSignatureIsBuildable :: TSProperty
ts_prop_blockSignatureIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> EpochSlots -> Gen a) -> Gen a
feedPMEpochSlots ProtocolMagicId -> EpochSlots -> Gen BlockSignature
genBlockSignature) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

--------------------------------------------------------------------------------
-- Common
--------------------------------------------------------------------------------

ts_prop_addrAttributesIsBuildable :: TSProperty
ts_prop_addrAttributesIsBuildable :: TSProperty
ts_prop_addrAttributesIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen AddrAttributes
Common.genAddrAttributes forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_addrSpendingData :: TSProperty
ts_prop_addrSpendingData :: TSProperty
ts_prop_addrSpendingData = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen AddrSpendingData
Common.genAddrSpendingData forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_addressIsBuildable :: TSProperty
ts_prop_addressIsBuildable :: TSProperty
ts_prop_addressIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen Address
Common.genAddress forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_attributesUnitIsBuildable :: TSProperty
ts_prop_attributesUnitIsBuildable :: TSProperty
ts_prop_attributesUnitIsBuildable =
  forall a b. a -> b -> a
const 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
$ forall a. Buildable a => a -> PropertyT IO ()
isBuildable (forall h. h -> UnparsedFields -> Attributes h
Attributes () (Map Word8 ByteString -> UnparsedFields
UnparsedFields forall a. Monoid a => a
mempty))

ts_prop_blockCountIsBuildable :: TSProperty
ts_prop_blockCountIsBuildable :: TSProperty
ts_prop_blockCountIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen BlockCount
Common.genBlockCount forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_chainDifficultyIsBuildable :: TSProperty
ts_prop_chainDifficultyIsBuildable :: TSProperty
ts_prop_chainDifficultyIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen ChainDifficulty
Common.genChainDifficulty forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_keyHashIsBuildable :: TSProperty
ts_prop_keyHashIsBuildable :: TSProperty
ts_prop_keyHashIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen KeyHash
Common.genKeyHash forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_lovelaceIsBuildable :: TSProperty
ts_prop_lovelaceIsBuildable :: TSProperty
ts_prop_lovelaceIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen Lovelace
Common.genLovelace forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_lovelacePortionIsBuildable :: TSProperty
ts_prop_lovelacePortionIsBuildable :: TSProperty
ts_prop_lovelacePortionIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen LovelacePortion
Common.genLovelacePortion forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_merkleRootIsBuildable :: TSProperty
ts_prop_merkleRootIsBuildable :: TSProperty
ts_prop_merkleRootIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. EncCBOR a => Gen a -> Gen (MerkleRoot a)
Common.genMerkleRoot (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_networkMagicIsBuildable :: TSProperty
ts_prop_networkMagicIsBuildable :: TSProperty
ts_prop_networkMagicIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen NetworkMagic
Common.genNetworkMagic forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_txFeePolicyIsBuildable :: TSProperty
ts_prop_txFeePolicyIsBuildable :: TSProperty
ts_prop_txFeePolicyIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen TxFeePolicy
Common.genTxFeePolicy forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_txSizeLinearIsBuildable :: TSProperty
ts_prop_txSizeLinearIsBuildable :: TSProperty
ts_prop_txSizeLinearIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen TxSizeLinear
Common.genTxSizeLinear forall a. Buildable a => a -> PropertyT IO ()
isBuildable

--------------------------------------------------------------------------------
-- Delegation
--------------------------------------------------------------------------------

ts_prop_delegationCertificateIsBuildable :: TSProperty
ts_prop_delegationCertificateIsBuildable :: TSProperty
ts_prop_delegationCertificateIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Certificate
Delegation.genCertificate) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_delegationPayloadIsBuildable :: TSProperty
ts_prop_delegationPayloadIsBuildable :: TSProperty
ts_prop_delegationPayloadIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Payload
Delegation.genPayload) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

--------------------------------------------------------------------------------
-- Genesis
--------------------------------------------------------------------------------

ts_prop_genesisKeyHashesIsBuildable :: TSProperty
ts_prop_genesisKeyHashesIsBuildable :: TSProperty
ts_prop_genesisKeyHashesIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisKeyHashes
Genesis.genGenesisKeyHashes forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_genesisNonAvvmBalancesIsBuildable :: TSProperty
ts_prop_genesisNonAvvmBalancesIsBuildable :: TSProperty
ts_prop_genesisNonAvvmBalancesIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen GenesisNonAvvmBalances
Genesis.genGenesisNonAvvmBalances forall a. Buildable a => a -> PropertyT IO ()
isBuildable

--------------------------------------------------------------------------------
-- Slotting
--------------------------------------------------------------------------------

ts_prop_epochAndSlotCountIsBuildable :: TSProperty
ts_prop_epochAndSlotCountIsBuildable :: TSProperty
ts_prop_epochAndSlotCountIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS
    TestLimit
100
    (Gen EpochSlots
Slotting.genEpochSlots forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EpochSlots -> GenT Identity EpochAndSlotCount
Slotting.genEpochAndSlotCount)
    forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_epochNumberIsBuildable :: TSProperty
ts_prop_epochNumberIsBuildable :: TSProperty
ts_prop_epochNumberIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen EpochNumber
Slotting.genEpochNumber forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_epochSlotsIsBuildable :: TSProperty
ts_prop_epochSlotsIsBuildable :: TSProperty
ts_prop_epochSlotsIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen EpochSlots
Slotting.genEpochSlots forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_slotCountIsBuildable :: TSProperty
ts_prop_slotCountIsBuildable :: TSProperty
ts_prop_slotCountIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen SlotCount
Slotting.genSlotCount forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_slotNumberIsBuilable :: TSProperty
ts_prop_slotNumberIsBuilable :: TSProperty
ts_prop_slotNumberIsBuilable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen SlotNumber
Slotting.genSlotNumber forall a. Buildable a => a -> PropertyT IO ()
isBuildable

--------------------------------------------------------------------------------
-- Update
--------------------------------------------------------------------------------

ts_prop_applicationNameIsBuildable :: TSProperty
ts_prop_applicationNameIsBuildable :: TSProperty
ts_prop_applicationNameIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen ApplicationName
Update.genApplicationName forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_installerHashIsBuildable :: TSProperty
ts_prop_installerHashIsBuildable :: TSProperty
ts_prop_installerHashIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen InstallerHash
Update.genInstallerHash forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_updatePayloadIsBuildable :: TSProperty
ts_prop_updatePayloadIsBuildable :: TSProperty
ts_prop_updatePayloadIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Payload
Update.genPayload) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_proposalIsBuiladble :: TSProperty
ts_prop_proposalIsBuiladble :: TSProperty
ts_prop_proposalIsBuiladble =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Proposal
Update.genProposal) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_protocolParametersIsBuildable :: TSProperty
ts_prop_protocolParametersIsBuildable :: TSProperty
ts_prop_protocolParametersIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen ProtocolParameters
Update.genProtocolParameters forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_protocolParametersUpdateIsBuildable :: TSProperty
ts_prop_protocolParametersUpdateIsBuildable :: TSProperty
ts_prop_protocolParametersUpdateIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen ProtocolParametersUpdate
Update.genProtocolParametersUpdate forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_protocolVersionIsBuildable :: TSProperty
ts_prop_protocolVersionIsBuildable :: TSProperty
ts_prop_protocolVersionIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen ProtocolVersion
Update.genProtocolVersion forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_softforkRuleIsBuildable :: TSProperty
ts_prop_softforkRuleIsBuildable :: TSProperty
ts_prop_softforkRuleIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen SoftforkRule
Update.genSoftforkRule forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_softwareVersionIsBuildable :: TSProperty
ts_prop_softwareVersionIsBuildable :: TSProperty
ts_prop_softwareVersionIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen SoftforkRule
Update.genSoftforkRule forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_systemTagIsBuildable :: TSProperty
ts_prop_systemTagIsBuildable :: TSProperty
ts_prop_systemTagIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen SystemTag
Update.genSystemTag forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_voteIsBuildable :: TSProperty
ts_prop_voteIsBuildable :: TSProperty
ts_prop_voteIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Vote
Update.genVote) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

--------------------------------------------------------------------------------
-- Update
--------------------------------------------------------------------------------

ts_prop_txIsBuildable :: TSProperty
ts_prop_txIsBuildable :: TSProperty
ts_prop_txIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen Tx
UTxO.genTx forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_txInIsBuildable :: TSProperty
ts_prop_txInIsBuildable :: TSProperty
ts_prop_txInIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen TxIn
UTxO.genTxIn forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_txOutIsBuildable :: TSProperty
ts_prop_txOutIsBuildable :: TSProperty
ts_prop_txOutIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen TxOut
UTxO.genTxOut forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_txAuxIsBuildable :: TSProperty
ts_prop_txAuxIsBuildable :: TSProperty
ts_prop_txAuxIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxAux
UTxO.genTxAux) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_txProofIsBuildable :: TSProperty
ts_prop_txProofIsBuildable :: TSProperty
ts_prop_txProofIsBuildable = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxProof
UTxO.genTxProof) forall a. Buildable a => a -> PropertyT IO ()
isBuildable

ts_prop_txInWitnessIsBuildable :: TSProperty
ts_prop_txInWitnessIsBuildable :: TSProperty
ts_prop_txInWitnessIsBuildable =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen TxInWitness
UTxO.genTxInWitness) forall a. Buildable a => a -> PropertyT IO ()
isBuildable