{-# LANGUAGE TypeApplications #-}

module Test.Consensus.Cardano.SupportedNetworkProtocolVersion (tests) where

import Data.Proxy
import Ouroboros.Consensus.Cardano
import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import Test.Tasty
import Test.Tasty.HUnit
import Test.Util.SupportedNetworkProtocolVersion

tests :: TestTree
tests :: TestTree
tests =
  TestName -> Assertion -> TestTree
testCase TestName
"Cardano exhaustive network protocol versions" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    Proxy (CardanoBlock StandardCrypto) -> Assertion
forall blk.
(Typeable blk, SupportedNetworkProtocolVersion blk) =>
Proxy blk -> Assertion
exhaustiveSupportedNetworkProtocolVersions
      (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(CardanoBlock StandardCrypto))