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

module Test.Cardano.Ledger.Dijkstra.Binary.CddlSpec (spec) where

import Cardano.Ledger.Alonzo.Scripts (CostModels)
import Cardano.Ledger.Alonzo.TxWits (Redeemers)
import Cardano.Ledger.Block (Block (Block))
import Cardano.Ledger.Conway.Governance (
  GovAction,
  ProposalProcedure,
  VotingProcedure,
  VotingProcedures,
 )
import Cardano.Ledger.Core
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.HuddleSpec (dijkstraCDDL)
import Cardano.Ledger.Dijkstra.Scripts (AccountBalanceInterval, AccountBalanceIntervals)
import Cardano.Ledger.Dijkstra.Tx (Tx (..))
import Cardano.Ledger.Plutus.Data (Data, Datum)
import Cardano.Protocol.Crypto (StandardCrypto)
import qualified Cardano.Protocol.Leios.BlockHeader as Leios
import Data.OSet.Strict (OSet)
import Test.Cardano.Ledger.Alonzo.Arbitrary (genDatumPresent, genNonEmptyRedeemers)
import Test.Cardano.Ledger.Binary.Cuddle (
  huddleDecoderEquivalenceSpec,
  huddleRoundTripAnnCborSpec,
  huddleRoundTripCborSpec,
  huddleRoundTripGenValidate,
  noTwiddle,
  specWithHuddle,
 )
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Arbitrary (genNonEmptyVotingProcedures)
import Test.Cardano.Ledger.Core.Arbitrary (genEraProtVer)
import Test.Cardano.Ledger.Core.Binary (
  fullAnnCddlSpec,
  fullAnnGenCddlSpec,
  fullCddlSpec,
  fullGenCddlSpec,
 )
import Test.Cardano.Ledger.Dijkstra.Arbitrary (
  genNonEmptyAccountBalanceIntervals,
  genSmallDijkstraCertBlockBody,
  genSmallDijkstraTxsBlockBody,
 )
import Test.Cardano.Ledger.Dijkstra.Binary.Annotator ()
import Test.Cardano.Protocol.Leios.BlockHeader.Arbitrary ()

genLeiosHeader :: Gen (Leios.Header StandardCrypto)
genLeiosHeader :: Gen (Header StandardCrypto)
genLeiosHeader = do
  h <- Gen (Header StandardCrypto)
forall a. Arbitrary a => Gen a
arbitrary
  pv <- genEraProtVer @DijkstraEra
  pure $ Leios.Header ((Leios.headerBody h) {Leios.hbProtVer = pv}) (Leios.headerSig h)

genLeiosHeaderBody :: Gen (Leios.HeaderBody StandardCrypto)
genLeiosHeaderBody :: Gen (HeaderBody StandardCrypto)
genLeiosHeaderBody = do
  hb <- Gen (HeaderBody StandardCrypto)
forall a. Arbitrary a => Gen a
arbitrary
  pv <- genEraProtVer @DijkstraEra
  pure hb {Leios.hbProtVer = pv}

genLeiosBlock :: Gen (Block (Leios.Header StandardCrypto) DijkstraEra)
genLeiosBlock :: Gen (Block (Header StandardCrypto) DijkstraEra)
genLeiosBlock = Header StandardCrypto
-> BlockBody DijkstraEra
-> Block (Header StandardCrypto) DijkstraEra
Header StandardCrypto
-> DijkstraBlockBody DijkstraEra
-> Block (Header StandardCrypto) DijkstraEra
forall h era. h -> BlockBody era -> Block h era
Block (Header StandardCrypto
 -> DijkstraBlockBody DijkstraEra
 -> Block (Header StandardCrypto) DijkstraEra)
-> Gen (Header StandardCrypto)
-> Gen
     (DijkstraBlockBody DijkstraEra
      -> Block (Header StandardCrypto) DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Header StandardCrypto)
genLeiosHeader Gen
  (DijkstraBlockBody DijkstraEra
   -> Block (Header StandardCrypto) DijkstraEra)
-> Gen (DijkstraBlockBody DijkstraEra)
-> Gen (Block (Header StandardCrypto) DijkstraEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (DijkstraBlockBody DijkstraEra)
forall era.
(AlonzoEraTx era, Arbitrary (Tx TopTx era)) =>
Gen (DijkstraBlockBody era)
genSmallDijkstraTxsBlockBody

spec :: Spec
spec :: Spec
spec = do
  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
    let v :: Version
v = forall era. Era era => Version
eraProtVerHigh @DijkstraEra
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Huddle" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Huddle -> SpecWith HuddleEnv -> Spec
specWithHuddle Huddle
dijkstraCDDL (SpecWith HuddleEnv -> Spec)
-> (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv
-> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecWith HuddleEnv -> SpecWith HuddleEnv
noTwiddle (SpecWith HuddleEnv -> Spec) -> SpecWith HuddleEnv -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxsRB" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$
        forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, DecCBOR (Annotator a),
 HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullAnnGenCddlSpec @(BlockBody DijkstraEra) Gen (BlockBody DijkstraEra)
Gen (DijkstraBlockBody DijkstraEra)
forall era.
(AlonzoEraTx era, Arbitrary (Tx TopTx era)) =>
Gen (DijkstraBlockBody era)
genSmallDijkstraTxsBlockBody Version
v Text
"block_body"
      String -> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"CertRB" (SpecWith HuddleEnv -> SpecWith HuddleEnv)
-> SpecWith HuddleEnv -> SpecWith HuddleEnv
forall a b. (a -> b) -> a -> b
$
        forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, DecCBOR (Annotator a),
 HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullAnnGenCddlSpec @(BlockBody DijkstraEra) Gen (BlockBody DijkstraEra)
Gen (DijkstraBlockBody DijkstraEra)
forall era. AlonzoEraTx era => Gen (DijkstraBlockBody era)
genSmallDijkstraCertBlockBody Version
v Text
"block_body"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(AccountBalanceInterval DijkstraEra) Version
v Text
"account_balance_interval"
      forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullGenCddlSpec @(AccountBalanceIntervals DijkstraEra)
        Gen (AccountBalanceIntervals DijkstraEra)
forall era. Gen (AccountBalanceIntervals era)
genNonEmptyAccountBalanceIntervals
        Version
v
        Text
"account_balance_intervals"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(Value DijkstraEra) Version
v Text
"value"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(TxBody TopTx DijkstraEra) Version
v Text
"transaction_body"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(TxBody SubTx DijkstraEra) Version
v Text
"sub_transaction_body"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(TxAuxData DijkstraEra) Version
v Text
"auxiliary_data"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(NativeScript DijkstraEra) Version
v Text
"native_script"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(Data DijkstraEra) Version
v Text
"plutus_data"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(TxOut DijkstraEra) Version
v Text
"transaction_output"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(Script DijkstraEra) Version
v Text
"script"
      forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullGenCddlSpec @(Datum DijkstraEra) Gen (Datum DijkstraEra)
forall era. Era era => Gen (Datum era)
genDatumPresent Version
v Text
"datum_option"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(TxWits DijkstraEra) Version
v Text
"transaction_witness_set"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(PParamsUpdate DijkstraEra) Version
v Text
"protocol_param_update"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @CostModels Version
v Text
"cost_models"
      forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, DecCBOR (Annotator a),
 HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullAnnGenCddlSpec @(Redeemers DijkstraEra) Gen (Redeemers DijkstraEra)
forall era.
(AlonzoEraScript era, Arbitrary (PlutusPurpose AsIx era)) =>
Gen (Redeemers era)
genNonEmptyRedeemers Version
v Text
"redeemers"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a,
 DecCBOR (Annotator a), HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullAnnCddlSpec @(Tx TopTx DijkstraEra) Version
v Text
"transaction"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(VotingProcedure DijkstraEra) Version
v Text
"voting_procedure"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(ProposalProcedure DijkstraEra) Version
v Text
"proposal_procedure"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(GovAction DijkstraEra) Version
v Text
"gov_action"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(TxCert DijkstraEra) Version
v Text
"certificate"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(OSet (TxCert DijkstraEra)) Version
v Text
"certificates"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @(OSet (ProposalProcedure DijkstraEra)) Version
v Text
"proposal_procedures"
      forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
fullGenCddlSpec @(VotingProcedures DijkstraEra) Gen (VotingProcedures DijkstraEra)
forall era. Era era => Gen (VotingProcedures era)
genNonEmptyVotingProcedures Version
v Text
"voting_procedures"
      -- Leios block header
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripAnnCborSpec @(Leios.Header StandardCrypto) Version
v Text
"header"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Leios.Header StandardCrypto) Version
v Text
"header"
      forall a.
(DecCBOR a, Show a, EncCBOR a) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
huddleRoundTripGenValidate @(Leios.Header StandardCrypto) Gen (Header StandardCrypto)
genLeiosHeader Version
v Text
"header"
      forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith HuddleEnv
huddleDecoderEquivalenceSpec @(Leios.Header StandardCrypto) Version
v Text
"header"
      forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith HuddleEnv
huddleRoundTripCborSpec @(Leios.HeaderBody StandardCrypto) Version
v Text
"header_body"
      forall a.
(DecCBOR a, Show a, EncCBOR a) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
huddleRoundTripGenValidate @(Leios.HeaderBody StandardCrypto) Gen (HeaderBody StandardCrypto)
genLeiosHeaderBody Version
v Text
"header_body"
      forall a.
(DecCBOR a, Show a, EncCBOR a) =>
Gen a -> Version -> Text -> SpecWith HuddleEnv
huddleRoundTripGenValidate @(Block (Leios.Header StandardCrypto) DijkstraEra)
        Gen (Block (Header StandardCrypto) DijkstraEra)
genLeiosBlock
        Version
v
        Text
"block"
      forall a.
(Eq a, Show a, Arbitrary a, EncCBOR a, DecCBOR a, HasCallStack) =>
Version -> Text -> SpecWith HuddleEnv
fullCddlSpec @Leios.EbAnnouncement Version
v Text
"eb_announcement"