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

module Test.Cardano.Protocol.Binary.Cddl (
  huddleBlockSpec,
  praosBlockHuddleSpec,
) where

import Cardano.Ledger.Binary (Annotator, DecCBOR, EncCBOR)
import Cardano.Ledger.Core
import Cardano.Protocol.Crypto (StandardCrypto)
import Cardano.Protocol.TPraos.OCert (OCert)
import Test.Cardano.Ledger.Binary.Cuddle
import Test.Cardano.Ledger.Common

huddleBlockSpec ::
  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 HuddleEnv
huddleBlockSpec :: 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 HuddleEnv
huddleBlockSpec = do
  let v :: Version
v = forall era. Era era => Version
eraProtVerLow @era
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(bh c) Version
v Text
"header"
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(bh c) Version
v Text
"header"
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(bhbody c) Version
v Text
"header_body"
  String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence via CDDL - Huddle" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(bh c) Version
v Text
"header"

-- To be used in Consensus with the appropriate new header types
praosBlockHuddleSpec ::
  forall era c bh bhbody.
  ( Era era
  , AtLeastEra "Babbage" 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 HuddleEnv
praosBlockHuddleSpec :: forall era c (bh :: * -> *) (bhbody :: * -> *).
(Era era, AtLeastEra "Babbage" 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 HuddleEnv
praosBlockHuddleSpec = do
  let v :: Version
v = forall era. Era era => Version
eraProtVerLow @era
  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 HuddleEnv
huddleBlockSpec @era @c @bh @bhbody
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(OCert StandardCrypto) Version
v Text
"operational_cert"
  where
    _atLeastBabbage :: ()
_atLeastBabbage = forall (eraName :: Symbol) era. AtLeastEra eraName era => ()
atLeastEra @"Babbage" @era