{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Main where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Protocol.Crypto (StandardCrypto)
import Cardano.Protocol.TPraos.BHeader (BHeader)
import Test.Cardano.Ledger.Allegra.Binary.Annotator ()
import Test.Cardano.Ledger.Alonzo.Binary.Annotator ()
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Mary.Binary.Annotator ()
import Test.Cardano.Ledger.Shelley.Binary.Annotator ()
import qualified Test.Cardano.Protocol.Binary.BinarySpec as Binary
import qualified Test.Cardano.Protocol.Binary.CddlSpec as Cddl
import Test.Cardano.Protocol.Binary.RoundTrip
import Test.Cardano.Protocol.TPraos.Arbitrary ()

main :: IO ()
IO ()
main =
  Spec -> IO ()
ledgerTestMain (Spec -> IO ()) -> Spec -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TPraos" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      Spec
Cddl.spec
      Spec
Binary.spec
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        forall h era.
(Eq h, Show h, DecCBOR h, DecCBOR (Annotator h), EncCBOR h,
 EraBlockBody era, Arbitrary (Block h era),
 DecCBOR (BlockBody era)) =>
Spec
roundTripBlockSpec @(BHeader StandardCrypto) @ShelleyEra
        forall h era.
(Eq h, Show h, DecCBOR h, DecCBOR (Annotator h), EncCBOR h,
 EraBlockBody era, Arbitrary (Block h era),
 DecCBOR (BlockBody era)) =>
Spec
roundTripBlockSpec @(BHeader StandardCrypto) @AllegraEra
        forall h era.
(Eq h, Show h, DecCBOR h, DecCBOR (Annotator h), EncCBOR h,
 EraBlockBody era, Arbitrary (Block h era),
 DecCBOR (BlockBody era)) =>
Spec
roundTripBlockSpec @(BHeader StandardCrypto) @MaryEra
        forall h era.
(Eq h, Show h, DecCBOR h, DecCBOR (Annotator h), EncCBOR h,
 EraBlockBody era, Arbitrary (Block h era),
 DecCBOR (BlockBody era)) =>
Spec
roundTripBlockSpec @(BHeader StandardCrypto) @AlonzoEra