{-# 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 Codec.CBOR.Cuddle.CDDL.CTree (CTreeRoot)
import Codec.CBOR.Cuddle.CDDL.Resolve (MonoReferenced)
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 (CTreeRoot MonoReferenced)
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 (CTreeRoot MonoReferenced)
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 (CTreeRoot MonoReferenced)
huddleRoundTripAnnCborSpec @(bh c) Version
v Text
"header"
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith (CTreeRoot MonoReferenced)
huddleRoundTripCborSpec @(bh c) Version
v Text
"header"
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith (CTreeRoot MonoReferenced)
huddleRoundTripCborSpec @(bhbody c) Version
v Text
"header_body"
  String
-> SpecWith (CTreeRoot MonoReferenced)
-> SpecWith (CTreeRoot MonoReferenced)
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence via CDDL - Huddle" (SpecWith (CTreeRoot MonoReferenced)
 -> SpecWith (CTreeRoot MonoReferenced))
-> SpecWith (CTreeRoot MonoReferenced)
-> SpecWith (CTreeRoot MonoReferenced)
forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith (CTreeRoot MonoReferenced)
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 (CTreeRoot MonoReferenced)
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 (CTreeRoot MonoReferenced)
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 (CTreeRoot MonoReferenced)
huddleBlockSpec @era @c @bh @bhbody
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith (CTreeRoot MonoReferenced)
huddleRoundTripCborSpec @(OCert StandardCrypto) Version
v Text
"operational_cert"
  where
    _atLeastBabbage :: ()
_atLeastBabbage = forall (eraName :: Symbol) era. AtLeastEra eraName era => ()
atLeastEra @"Babbage" @era