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

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

import Cardano.Ledger.Babbage (BabbageEra)
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.Cddl (
  CddlData,
  cddlDecoderEquivalenceSpec,
  cddlRoundTripAnnCborSpec,
  cddlRoundTripCborSpec,
 )
import Test.Cardano.Ledger.Binary.Cuddle
import Test.Cardano.Ledger.Common

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

-- To be used in Consensus with the appropriate new header types
praosBlockCddlSpec ::
  forall era c bh bhbody.
  ( Era era
  , AtLeastEra BabbageEra 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 CddlData
praosBlockCddlSpec :: forall era c (bh :: * -> *) (bhbody :: * -> *).
(Era era, AtLeastEra BabbageEra 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 CddlData
praosBlockCddlSpec = 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 CddlData
cddlBlockSpec @era @c @bh @bhbody
  forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CddlData
cddlRoundTripCborSpec @(OCert StandardCrypto) Version
v Text
"operational_cert"
  where
    _atLeastBabbage :: ()
_atLeastBabbage = forall eraName era. AtLeastEra eraName era => ()
atLeastEra @BabbageEra @era

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"
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence via CDDL - Huddle" 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 BabbageEra 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 BabbageEra 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 era. AtLeastEra eraName era => ()
atLeastEra @BabbageEra @era