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