{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Protocol.Binary.CddlSpec (spec) where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Allegra.HuddleSpec (allegraCDDL)
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.HuddleSpec (alonzoCDDL)
import Cardano.Ledger.Binary.Group (CBORGroup)
import Cardano.Ledger.Core
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.HuddleSpec (maryCDDL)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.HuddleSpec (shelleyCDDL)
import Cardano.Protocol.Crypto (StandardCrypto)
import Cardano.Protocol.TPraos.BHeader (BHBody, BHeader)
import Cardano.Protocol.TPraos.OCert (OCert)
import Codec.CBOR.Cuddle.Huddle (Huddle)
import Test.Cardano.Ledger.Binary.Cuddle
import Test.Cardano.Ledger.Common
import Test.Cardano.Protocol.Binary.Annotator ()
import Test.Cardano.Protocol.Binary.Cddl (huddleBlockSpec)

spec :: Spec
spec :: Spec
spec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CDDL" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era. (Era era, AtMostEra "Alonzo" era) => Huddle -> Spec
specForEra @ShelleyEra Huddle
shelleyCDDL
    forall era. (Era era, AtMostEra "Alonzo" era) => Huddle -> Spec
specForEra @AllegraEra Huddle
allegraCDDL
    forall era. (Era era, AtMostEra "Alonzo" era) => Huddle -> Spec
specForEra @MaryEra Huddle
maryCDDL
    forall era. (Era era, AtMostEra "Alonzo" era) => Huddle -> Spec
specForEra @AlonzoEra Huddle
alonzoCDDL

specForEra ::
  forall era.
  (Era era, AtMostEra "Alonzo" era) =>
  Huddle ->
  Spec
specForEra :: forall era. (Era era, AtMostEra "Alonzo" era) => Huddle -> Spec
specForEra Huddle
cddlFiles = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall era. Era era => String
eraName @era) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    Huddle -> Int -> SpecWith CuddleData -> Spec
specWithHuddle Huddle
cddlFiles Int
100 (SpecWith CuddleData -> Spec) -> SpecWith CuddleData -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era c (bh :: * -> *) (bhbody :: * -> *).
(Era era, Eq (bh c), Show (bh c), DecCBOR (bh c), EncCBOR (bh c),
 DecCBOR (Annotator (bh c)), Eq (bhbody c), Show (bhbody c),
 DecCBOR (bhbody c), EncCBOR (bhbody c)) =>
SpecWith CuddleData
huddleBlockSpec @era @StandardCrypto @BHeader @BHBody
      String -> SpecWith CuddleData -> SpecWith CuddleData
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe String
"Cannot generate a CBOR term corresponding to a group with cuddle" (SpecWith CuddleData -> SpecWith CuddleData)
-> SpecWith CuddleData -> SpecWith CuddleData
forall a b. (a -> b) -> a -> b
$
        forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CuddleData
huddleRoundTripCborSpec @(CBORGroup (OCert StandardCrypto))
          (forall era. Era era => Version
eraProtVerLow @era)
          Text
"[ operational_cert ]"
  where
    _atMostAlonzo :: ()
_atMostAlonzo = forall (eraName :: Symbol) era. AtMostEra eraName era => ()
atMostEra @"Alonzo" @era