diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 8ded77268f..bb406759ce 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -138,6 +138,22 @@ jobs: - name: Build projects [build] run: cabal build all -j + - name: Install cddlc + run: gem install cddlc + + - name: Clone cuddle with validator + uses: actions/checkout + with: + repo: 'input-output-hk/cuddle' + ref: 'js/validator' + path: 'cuddle' + + - name: Install cuddle + run: | + ( cd $GITHUB_WORKSPACE/cuddle + cabal install --ignore-project exe:cuddle + ) + - name: Test if: matrix.test-set == 'all' run: cabal test all -j --test-show-details=streaming diff --git a/nix/cddlc/Gemfile b/nix/cddlc/Gemfile new file mode 100644 index 0000000000..3cc0760bb2 --- /dev/null +++ b/nix/cddlc/Gemfile @@ -0,0 +1,2 @@ +source 'https://rubygems.org' +gem 'cddlc' diff --git a/nix/cddlc/Gemfile.lock b/nix/cddlc/Gemfile.lock new file mode 100644 index 0000000000..da7f3d68cd --- /dev/null +++ b/nix/cddlc/Gemfile.lock @@ -0,0 +1,19 @@ +GEM + remote: https://rubygems.org/ + specs: + cddlc (0.4.2) + neatjson (~> 0.10) + treetop (~> 1) + neatjson (0.10.5) + polyglot (0.3.5) + treetop (1.6.14) + polyglot (~> 0.3) + +PLATFORMS + ruby + +DEPENDENCIES + cddlc + +BUNDLED WITH + 2.6.2 diff --git a/nix/cddlc/gemset.nix b/nix/cddlc/gemset.nix new file mode 100644 index 0000000000..997b4c7cab --- /dev/null +++ b/nix/cddlc/gemset.nix @@ -0,0 +1,47 @@ +{ + cddlc = { + dependencies = [ + "neatjson" + "treetop" + ]; + groups = [ "default" ]; + platforms = [ ]; + source = { + remotes = [ "https://rubygems.org" ]; + sha256 = "1s3fbgd5yqgji162zsmlwnva1v1r3zc1qiyv6im7karv5f08r8m3"; + type = "gem"; + }; + version = "0.4.2"; + }; + neatjson = { + groups = [ "default" ]; + platforms = [ ]; + source = { + remotes = [ "https://rubygems.org" ]; + sha256 = "0wm1lq8yl6rzysh3wg6fa55w5534k6ppiz0qb7jyvdy582mk5i0s"; + type = "gem"; + }; + version = "0.10.5"; + }; + polyglot = { + groups = [ "default" ]; + platforms = [ ]; + source = { + remotes = [ "https://rubygems.org" ]; + sha256 = "1bqnxwyip623d8pr29rg6m8r0hdg08fpr2yb74f46rn1wgsnxmjr"; + type = "gem"; + }; + version = "0.3.5"; + }; + treetop = { + dependencies = [ "polyglot" ]; + groups = [ "default" ]; + platforms = [ ]; + source = { + remotes = [ "https://rubygems.org" ]; + sha256 = "1m5fqy7vq6y7bgxmw7jmk7y6pla83m16p7lb41lbqgg53j8x2cds"; + type = "gem"; + }; + version = "1.6.14"; + }; +} diff --git a/nix/cddlc/package.nix b/nix/cddlc/package.nix new file mode 100644 index 0000000000..ad8c2eb888 --- /dev/null +++ b/nix/cddlc/package.nix @@ -0,0 +1,23 @@ +{ lib +, bundlerApp +, bundlerUpdateScript +}: + +bundlerApp { + pname = "cddlc"; + + gemdir = ./.; + + exes = [ "cddlc" ]; + + passthru.updateScript = bundlerUpdateScript "cddlc"; + + meta = { + description = "CDDL conversion utilities"; + homepage = "https://github.com/cabo/cddlc"; + license = lib.licenses.mit; + maintainers = with lib.maintainers; [ amesgen ]; + platforms = lib.platforms.unix; + mainProgram = "cddlc"; + }; +} diff --git a/nix/haskell.nix b/nix/haskell.nix index aadf40a2b7..1ca65b2074 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -34,6 +34,14 @@ let extraSrcFiles = [ "golden/${n}/**/*" ]; }) [ "byron" "shelley" "cardano" ]); } + ({ pkgs, ... }: { + # Tools for CBOR/CDDL tests: + packages.ouroboros-consensus-cardano.components.tests.cardano-test = { + build-tools = + [ pkgs.cddlc pkgs.cuddle ]; + extraSrcFiles = [ "cddl/**/*" ]; + }; + }) ]; flake.variants = { noAsserts = { diff --git a/nix/tools.nix b/nix/tools.nix index 368fe9a202..1260dfd89a 100644 --- a/nix/tools.nix +++ b/nix/tools.nix @@ -41,6 +41,18 @@ in compiler-nix-name = "ghc98"; }; + cuddle = tool "cuddle" "git" { + src = final.fetchFromGitHub { + owner = "input-output-hk"; + repo = "cuddle"; + rev = "43050522b2c3326dc2bcb95a3fde852bce5bc729"; + hash = "sha256-S3GJBmvBmnbdb7tD2Fq9FNr9Z8iuT/eWwRpRxq9is10="; + }; + }; + + # remove once our nixpkgs contains https://github.com/NixOS/nixpkgs/pull/394873 + cddlc = final.callPackage ./cddlc/package.nix { }; + haskellBuildUtils = prev.haskellBuildUtils.override { inherit (final.hsPkgs.args) compiler-nix-name; index-state = tool-index-state; diff --git a/ouroboros-consensus-cardano/cddl/base.cddl b/ouroboros-consensus-cardano/cddl/base.cddl new file mode 100644 index 0000000000..8d252b579d --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/base.cddl @@ -0,0 +1,53 @@ +telescope7 + = [pastEra, pastEra, pastEra, pastEra, pastEra, pastEra, currentEra] / + [pastEra, pastEra, pastEra, pastEra, pastEra, currentEra] / + [pastEra, pastEra, pastEra, pastEra, currentEra] / + [pastEra, pastEra, pastEra, currentEra] / + [pastEra, pastEra, currentEra] / + [pastEra, currentEra] / + [currentEra] + +ns7 + = [6, conway] / + [5, babbage] / + [4, alonzo] / + [3, mary] / + [2, allegra] / + [1, shelley] / + [0, byron] + +;; Blockchain types +pastEra = [bound, bound] +currentEra = [bound, st] +bound = [relativeTime, slotno, epochno] +eraIdx = word8 +individualPoolStake = [stake, hash] +nonce = [0] / [1, hash] +point = [] / [ slotno, hash ] +poolDistr = map +slotno = word64 +stake = rational + +withOrigin = [] / [v] +withOriginTH = [0] / [1, v] + +;; Collections +either = [0, x] / [1, y] +map = { * x => y } +maybe = [] / [x] +seq = [*23 x] / [24* x] ; encoded with indefinite-length encoding +set = #6.258([* x]) + +;; Types from other packages +blockno = word64 +epochno = word64 +coin = word64 +rational = [int, int] +keyhash = bstr .size 28 +hash = bstr .size 32 +relativeTime = int + +;; Base word types +word8 = uint .size 1 +word32 = uint .size 4 +word64 = uint .size 8 diff --git a/ouroboros-consensus-cardano/cddl/disk/block.cddl b/ouroboros-consensus-cardano/cddl/disk/block.cddl new file mode 100644 index 0000000000..68a0f3ad46 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/disk/block.cddl @@ -0,0 +1,15 @@ +cardanoBlock = byron.block + / [2, shelley.block] + / [3, allegra.block] + / [4, mary.block] + / [5, alonzo.block] + / [6, babbage.block] + / [7, conway.block] + +;# import byron as byron +;# import shelley as shelley +;# import allegra as allegra +;# import mary as mary +;# import alonzo as alonzo +;# import babbage as babbage +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/disk/snapshot.cddl b/ouroboros-consensus-cardano/cddl/disk/snapshot.cddl new file mode 100644 index 0000000000..25c790d729 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/disk/snapshot.cddl @@ -0,0 +1,9 @@ +ledgerStateSnapshot = + [snapshotEncodingVersion1, extLedgerState] + +snapshotEncodingVersion1 = 1 + +extLedgerState = [ledgerState, headerState] + +;# import ledgerstate +;# import headerstate diff --git a/ouroboros-consensus-cardano/cddl/disk/snapshot/headerstate.cddl b/ouroboros-consensus-cardano/cddl/disk/snapshot/headerstate.cddl new file mode 100644 index 0000000000..0687f6a584 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/disk/snapshot/headerstate.cddl @@ -0,0 +1,23 @@ +headerState = + [withOrigin, headerStateChainDep] + +headerStateTip = + ns7 + +byronAnnTip = [slotno, hash, blockno, bool] +annTip = [slotno, hash, blockno] + +headerStateChainDep = + telescope7 + +versionedPbftState = [serializationFormat1, {* keyhash => [* slotno]}] + +;# import base +;# import praos +;# import tpraos diff --git a/ouroboros-consensus-cardano/cddl/disk/snapshot/ledgerstate.cddl b/ouroboros-consensus-cardano/cddl/disk/snapshot/ledgerstate.cddl new file mode 100644 index 0000000000..d941cac2c1 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/disk/snapshot/ledgerstate.cddl @@ -0,0 +1,30 @@ +ledgerState = + telescope7, + versionedShelleyLedgerState, + versionedShelleyLedgerState, + versionedShelleyLedgerState, + versionedShelleyLedgerState, + versionedShelleyLedgerState> + +versionedShelleyLedgerState = [ shelleyVersion2, shelleyLedgerState ] + +shelleyVersion2 = 2 + +shelleyLedgerState = [ withOrigin, era, shelleyTransition ] + +shelleyTip = [slotno, blockno, hash] + +shelleyTransition = word32 + +; TODO these should be imports from the ledger however they do not +; provide these definitions yet. +byron.ledgerstate = any +shelley.ledgerstate = any +allegra.ledgerstate = any +mary.ledgerstate = any +alonzo.ledgerstate = any +babbage.ledgerstate = any +conway.ledgerstate = any + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/disk/snapshot/praos.cddl b/ouroboros-consensus-cardano/cddl/disk/snapshot/praos.cddl new file mode 100644 index 0000000000..bddb7ad511 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/disk/snapshot/praos.cddl @@ -0,0 +1,13 @@ +versionedPraosState = [praosVersion, praosState] + +praosVersion = 0 + +praosState = [withOrigin, + {* keyhash => word64}, + nonce, + nonce, + nonce, + nonce, + nonce] + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/disk/snapshot/tpraos.cddl b/ouroboros-consensus-cardano/cddl/disk/snapshot/tpraos.cddl new file mode 100644 index 0000000000..aa5cf974f9 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/disk/snapshot/tpraos.cddl @@ -0,0 +1,12 @@ +versionedTPraosState = + [serializationFormat1, [withOriginTH, tpraosState]] + +tpraosState = [prtclState, ticknState, nonce] + +prtclState = [{* keyhash => word64}, nonce, nonce] + +ticknState = [nonce, nonce] + +serializationFormat1 = 1 + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/byron/getUpdateInterfaceState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/byron/getUpdateInterfaceState.cddl new file mode 100644 index 0000000000..ff28220a22 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/byron/getUpdateInterfaceState.cddl @@ -0,0 +1,4 @@ +query = 0 +result = byron.upistate + +;# import byron as byron diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getChainBlockNo.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getChainBlockNo.cddl new file mode 100644 index 0000000000..e0e6189b68 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getChainBlockNo.cddl @@ -0,0 +1,4 @@ +query = 2 +result = blockno + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getChainPoint.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getChainPoint.cddl new file mode 100644 index 0000000000..677ad90a2a --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getChainPoint.cddl @@ -0,0 +1,4 @@ +query = 3 +result = point + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getCurrentEra.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getCurrentEra.cddl new file mode 100644 index 0000000000..2527ad859a --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getCurrentEra.cddl @@ -0,0 +1,4 @@ +query = [1] +result = eraIdx + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getEraStart.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getEraStart.cddl new file mode 100644 index 0000000000..bb9a605d33 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getEraStart.cddl @@ -0,0 +1,4 @@ +query = [0] +result = maybe + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getInterpreter.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getInterpreter.cddl new file mode 100644 index 0000000000..1cb948d2a0 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getInterpreter.cddl @@ -0,0 +1,18 @@ +query = [0] +result = interpreter + +interpreter = [* eraSummary] +eraSummary = [eraStart, eraEnd, eraParams] +eraStart = bound +eraEnd = null / bound +eraParams = [epochSize, slotLength, safeZone, genesisWindow] +epochSize = word64 +slotLength = int ; millisec +safeZone = standardSafeZone / unsafeIndefiniteSafeZone +standardSafeZone = [0, safeFromTip, safeBeforeEpoch] +safeFromTip = word64 +safeBeforeEpoch = [0] +unsafeIndefiniteSafeZone = [1] +genesisWindow = word64 + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getSystemStart.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getSystemStart.cddl new file mode 100644 index 0000000000..8b5b621d0b --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/consensus/getSystemStart.cddl @@ -0,0 +1,7 @@ +query = 1 +result = utctime + +utctime = [year, dayOfYear, timeOfDayPico] +year = bigint +dayOfYear = int +timeOfDayPico = bigint diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/query.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/query.cddl new file mode 100644 index 0000000000..691f1da79a --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/query.cddl @@ -0,0 +1,105 @@ +query = [0, blockQuery] + / [getSystemStart.query] + / [getChainBlockNo.query] + / [getChainPoint.query] + +blockQuery = queryIfCurrent + / queryAnyTime + / queryHardFork + +queryAnyTime = [1, getEraStart.query, eraIdx] + +queryHardFork = [2, getInterpreter.query / getCurrentEra.query] + +queryIfCurrent = + [0, ns7 + ] + +byronQuery = getUpdateInterfaceState.query + +shelleyQuery = getLedgerTip.query + / getEpochNo.query + / getNonMyopicMemberRewards.query + / getCurrentPParams.query + / getProposedPParamsUpdates.query + / getStakeDistribution.query + / getUTxOByAddress.query + / getUTxOWhole.query + / debugEpochState.query + / getCBOR.query + / getFilteredDelegationsAndRewardAccounts.query + / getGenesisConfig.query + / debugNewEpochState.query + / debugChainDepState.query + / getRewardProvenance.query + / getUTxOByTxIn.query + / getStakePools.query + / getStakePoolParams.query + / getRewardInfoPools.query + / getPoolState.query + / getStakeSnapshots.query + / getPoolDistr.query + / getStakeDelegDeposits.query + / getConstitution.query + / getGovState.query + / getDRepState.query + / getDRepStakeDistr.query + / getCommitteeMembersState.query + / getFilteredVoteDelegatees.query + / getAccountState.query + / getSPOStakeDistr.query + / getProposals.query + / getRatifyState.query + / getFuturePParams.query + / getBigLedgerPeersSnapshot.query + +getCBOR.query = [9, shelleyQuery] + +;# include getSystemStart as getSystemStart +;# include getChainBlockNo as getChainBlockNo +;# include getChainPoint as getChainPoint +;# include getEraStart as getEraStart +;# include getInterpreter as getInterpreter +;# include getCurrentEra as getCurrentEra +;# include getUpdateInterfaceState as getUpdateInterfaceState +;# include getLedgerTip as getLedgerTip +;# include getEpochNo as getEpochNo +;# include getNonMyopicMemberRewards as getNonMyopicMemberRewards +;# include getCurrentPParams as getCurrentPParams +;# include getProposedPParamsUpdates as getProposedPParamsUpdates +;# include getStakeDistribution as getStakeDistribution +;# include getUTxOByAddress as getUTxOByAddress +;# include getUTxOWhole as getUTxOWhole +;# include debugEpochState as debugEpochState +;# include getFilteredDelegationsAndRewardAccounts as getFilteredDelegationsAndRewardAccounts +;# include getGenesisConfig as getGenesisConfig +;# include debugNewEpochState as debugNewEpochState +;# include debugChainDepState as debugChainDepState +;# include getRewardProvenance as getRewardProvenance +;# include getUTxOByTxIn as getUTxOByTxIn +;# include getStakePools as getStakePools +;# include getStakePoolParams as getStakePoolParams +;# include getRewardInfoPools as getRewardInfoPools +;# include getPoolState as getPoolState +;# include getStakeSnapshots as getStakeSnapshots +;# include getPoolDistr as getPoolDistr +;# include getStakeDelegDeposits as getStakeDelegDeposits +;# include getConstitution as getConstitution +;# include getGovState as getGovState +;# include getDRepState as getDRepState +;# include getDRepStakeDistr as getDRepStakeDistr +;# include getCommitteeMembersState as getCommitteeMembersState +;# include getFilteredVoteDelegatees as getFilteredVoteDelegatees +;# include getAccountState as getAccountState +;# include getSPOStakeDistr as getSPOStakeDistr +;# include getProposals as getProposals +;# include getRatifyState as getRatifyState +;# include getFuturePParams as getFuturePParams +;# include getBigLedgerPeersSnapshot as getBigLedgerPeersSnapshot +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/result.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/result.cddl new file mode 100644 index 0000000000..a09063be1a --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/result.cddl @@ -0,0 +1,98 @@ +result = blockQueryResult + / getSystemStart.result + / getChainBlockNo.result + / getChainPoint.result + +blockQueryResult = queryAnytimeResult + / queryHardForkResult + / queryIfCurrentResult + +queryAnytimeResult = getEraStart.result + +queryHardForkResult = getInterpreter.result / getCurrentEra.result + +queryIfCurrentResult = byronResult + / shelleyResult + +byronResult = getUpdateInterfaceState.result + +shelleyResult = getLedgerTip.result + / getEpochNo.result + / getNonMyopicMemberRewards.result + / getCurrentPParams.result + / getProposedPParamsUpdates.result + / getStakeDistribution.result + / getUTxOByAddress.result + / getUTxOWhole.result + / debugEpochState.result + / getCBOR.result + / getFilteredDelegationsAndRewardAccounts.result + / getGenesisConfig.result + / debugNewEpochState.result + / debugChainDepState.result + / getRewardProvenance.result + / getUTxOByTxIn.result + / getStakePools.result + / getStakePoolParams.result + / getRewardInfoPools.result + / getPoolState.result + / getStakeSnapshots.result + / getPoolDistr.result + / getStakeDelegDeposits.result + / getConstitution.result + / getGovState.result + / getDRepState.result + / getDRepStakeDistr.result + / getCommitteeMembersState.result + / getFilteredVoteDelegatees.result + / getAccountState.result + / getSPOStakeDistr.result + / getProposals.result + / getRatifyState.result + / getFuturePParams.result + / getBigLedgerPeersSnapshot.result + +getCBOR.result = #6.24(bstr .cbor shelleyResult) + +;# import getSystemStart as getSystemStart +;# import getChainBlockNo as getChainBlockNo +;# import getChainPoint as getChainPoint +;# import getEraStart as getEraStart +;# import getInterpreter as getInterpreter +;# import getCurrentEra as getCurrentEra +;# import getUpdateInterfaceState as getUpdateInterfaceState +;# import getLedgerTip as getLedgerTip +;# import getEpochNo as getEpochNo +;# import getNonMyopicMemberRewards as getNonMyopicMemberRewards +;# import getCurrentPParams as getCurrentPParams +;# import getProposedPParamsUpdates as getProposedPParamsUpdates +;# import getStakeDistribution as getStakeDistribution +;# import getUTxOByAddress as getUTxOByAddress +;# import getUTxOWhole as getUTxOWhole +;# import debugEpochState as debugEpochState +;# import getFilteredDelegationsAndRewardAccounts as getFilteredDelegationsAndRewardAccounts +;# import getGenesisConfig as getGenesisConfig +;# import debugNewEpochState as debugNewEpochState +;# import debugChainDepState as debugChainDepState +;# import getRewardProvenance as getRewardProvenance +;# import getUTxOByTxIn as getUTxOByTxIn +;# import getStakePools as getStakePools +;# import getStakePoolParams as getStakePoolParams +;# import getRewardInfoPools as getRewardInfoPools +;# import getPoolState as getPoolState +;# import getStakeSnapshots as getStakeSnapshots +;# import getPoolDistr as getPoolDistr +;# import getStakeDelegDeposits as getStakeDelegDeposits +;# import getConstitution as getConstitution +;# import getGovState as getGovState +;# import getDRepState as getDRepState +;# import getDRepStakeDistr as getDRepStakeDistr +;# import getCommitteeMembersState as getCommitteeMembersState +;# import getFilteredVoteDelegatees as getFilteredVoteDelegatees +;# import getAccountState as getAccountState +;# import getSPOStakeDistr as getSPOStakeDistr +;# import getProposals as getProposals +;# import getRatifyState as getRatifyState +;# import getFuturePParams as getFuturePParams +;# import getBigLedgerPeersSnapshot as getBigLedgerPeersSnapshot +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugChainDepState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugChainDepState.cddl new file mode 100644 index 0000000000..1126dbd1f9 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugChainDepState.cddl @@ -0,0 +1,5 @@ +query = [13] + +result = headerStateChainDep + +;# import headerstate diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugEpochState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugEpochState.cddl new file mode 100644 index 0000000000..2f660f53e1 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugEpochState.cddl @@ -0,0 +1,5 @@ +query = [8] + +result = conway.epochState + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugNewEpochState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugNewEpochState.cddl new file mode 100644 index 0000000000..f7b49c28e7 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/debugNewEpochState.cddl @@ -0,0 +1,5 @@ +query = [12] + +result = conway.newEpochState + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getAccountState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getAccountState.cddl new file mode 100644 index 0000000000..2ca02093e8 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getAccountState.cddl @@ -0,0 +1,5 @@ +query = [29] + +result = conway.accountState + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getBigLedgerPeersSnapshot.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getBigLedgerPeersSnapshot.cddl new file mode 100644 index 0000000000..1531874579 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getBigLedgerPeersSnapshot.cddl @@ -0,0 +1,3 @@ +query = [34] + +result = network.ledgerPeerSnapshot diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCBOR.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCBOR.cddl new file mode 100644 index 0000000000..e69de29bb2 diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCommitteeMembersState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCommitteeMembersState.cddl new file mode 100644 index 0000000000..386783b020 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCommitteeMembersState.cddl @@ -0,0 +1,6 @@ +query = [27, set, set, set] + +result = conway.committeeMembersState + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getConstitution.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getConstitution.cddl new file mode 100644 index 0000000000..db458e6175 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getConstitution.cddl @@ -0,0 +1,5 @@ +query = [23] + +result = conway.constitution + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCurrentPParams.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCurrentPParams.cddl new file mode 100644 index 0000000000..357bfdcda3 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getCurrentPParams.cddl @@ -0,0 +1,5 @@ +query = [3] + +result = conway.pparams + +;# import conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getDRepStakeDistr.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getDRepStakeDistr.cddl new file mode 100644 index 0000000000..f4739c06bb --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getDRepStakeDistr.cddl @@ -0,0 +1,6 @@ +query = [26, set] + +result = map + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getDRepState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getDRepState.cddl new file mode 100644 index 0000000000..390547b24f --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getDRepState.cddl @@ -0,0 +1,6 @@ +query = [25, set] + +result = map + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getEpochNo.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getEpochNo.cddl new file mode 100644 index 0000000000..25197ed410 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getEpochNo.cddl @@ -0,0 +1,5 @@ +query = [1] + +result = epochno + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFilteredDelegationsAndRewardAccounts.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFilteredDelegationsAndRewardAccounts.cddl new file mode 100644 index 0000000000..97382d42a7 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFilteredDelegationsAndRewardAccounts.cddl @@ -0,0 +1,6 @@ +query = [10, set] + +result = [conway.delegations, conway.rewardAccounts] + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFilteredVoteDelegatees.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFilteredVoteDelegatees.cddl new file mode 100644 index 0000000000..3675723e95 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFilteredVoteDelegatees.cddl @@ -0,0 +1,6 @@ +query = [28, set] + +result = conway.voteDelegatees + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFuturePParams.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFuturePParams.cddl new file mode 100644 index 0000000000..e4d3e75332 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getFuturePParams.cddl @@ -0,0 +1,6 @@ +query = [33] + +result = maybe + +;# import conway as conway +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getGenesisConfig.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getGenesisConfig.cddl new file mode 100644 index 0000000000..76dd8faecf --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getGenesisConfig.cddl @@ -0,0 +1,5 @@ +query = [11] + +result = conway.compactGenesis + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getGovState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getGovState.cddl new file mode 100644 index 0000000000..7766398646 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getGovState.cddl @@ -0,0 +1,5 @@ +query = [24] + +result = conway.govState + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getLedgerTip.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getLedgerTip.cddl new file mode 100644 index 0000000000..1f85a9bb8c --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getLedgerTip.cddl @@ -0,0 +1,4 @@ +query = [0] +result = point + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getNonMyopicMemberRewards.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getNonMyopicMemberRewards.cddl new file mode 100644 index 0000000000..894a44ab70 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getNonMyopicMemberRewards.cddl @@ -0,0 +1,6 @@ +query = [2, set>] + +result = conway.nonMyopicRewards + +;# import base +;# import conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getPoolDistr.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getPoolDistr.cddl new file mode 100644 index 0000000000..35a2d2b48e --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getPoolDistr.cddl @@ -0,0 +1,5 @@ +query = [21, maybe>] + +result = poolDistr + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getPoolState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getPoolState.cddl new file mode 100644 index 0000000000..2947899d98 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getPoolState.cddl @@ -0,0 +1,6 @@ +query = [19, maybe>] + +result = conway.pstate + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getProposals.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getProposals.cddl new file mode 100644 index 0000000000..449d0bc047 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getProposals.cddl @@ -0,0 +1,6 @@ +query = [31, set] + +result = seq + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getProposedPParamsUpdates.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getProposedPParamsUpdates.cddl new file mode 100644 index 0000000000..7126e253ed --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getProposedPParamsUpdates.cddl @@ -0,0 +1,3 @@ +query = [4] + +result = {} \ No newline at end of file diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRatifyState.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRatifyState.cddl new file mode 100644 index 0000000000..3a84026806 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRatifyState.cddl @@ -0,0 +1,5 @@ +query = [32] + +result = conway.ratifyState + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRewardInfoPools.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRewardInfoPools.cddl new file mode 100644 index 0000000000..fd58908a28 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRewardInfoPools.cddl @@ -0,0 +1,6 @@ +query = [18] + +result = [conway.rewardParams, map] + +;# import conway as conway +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRewardProvenance.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRewardProvenance.cddl new file mode 100644 index 0000000000..783272d765 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getRewardProvenance.cddl @@ -0,0 +1,5 @@ +query = [14] + +result = conway.rewardProvenance + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getSPOStakeDistr.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getSPOStakeDistr.cddl new file mode 100644 index 0000000000..96ccb5ffba --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getSPOStakeDistr.cddl @@ -0,0 +1,5 @@ +query = [30, set] + +result = map + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeDelegDeposits.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeDelegDeposits.cddl new file mode 100644 index 0000000000..42a832abbe --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeDelegDeposits.cddl @@ -0,0 +1,6 @@ +query = [22, set] + +result = map + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeDistribution.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeDistribution.cddl new file mode 100644 index 0000000000..7b83cb94ad --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeDistribution.cddl @@ -0,0 +1,5 @@ +query = [5] + +result = poolDistr + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakePoolParams.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakePoolParams.cddl new file mode 100644 index 0000000000..b4254164b8 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakePoolParams.cddl @@ -0,0 +1,6 @@ +query = [17, set] + +result = map + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakePools.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakePools.cddl new file mode 100644 index 0000000000..634be638fb --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakePools.cddl @@ -0,0 +1,5 @@ +query = [16] + +result = set + +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeSnapshots.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeSnapshots.cddl new file mode 100644 index 0000000000..48fcd4e4c8 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getStakeSnapshots.cddl @@ -0,0 +1,6 @@ +query = [20, maybe>] + +result = conway.stakeSnapshots + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOByAddress.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOByAddress.cddl new file mode 100644 index 0000000000..020bb283a8 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOByAddress.cddl @@ -0,0 +1,6 @@ +query = [6, set] + +result = conway.utxo + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOByTxIn.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOByTxIn.cddl new file mode 100644 index 0000000000..7c4aa0a260 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOByTxIn.cddl @@ -0,0 +1,6 @@ +query = [15, set] + +result = conway.utxo + +;# import base +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOWhole.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOWhole.cddl new file mode 100644 index 0000000000..166b9fd174 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/localstatequery/shelley/getUTxOWhole.cddl @@ -0,0 +1,5 @@ +query = [7] + +result = conway.utxo + +;# import conway as conway diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/slotno.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/slotno.cddl new file mode 100644 index 0000000000..9ae5243da2 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/slotno.cddl @@ -0,0 +1,3 @@ +slotno = base.slotno + +;# import base as base diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/tx.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/tx.cddl new file mode 120000 index 0000000000..0a8be97df8 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/tx.cddl @@ -0,0 +1 @@ +../../node-to-node/txsubmission2/tx.cddl \ No newline at end of file diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/txid.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/txid.cddl new file mode 120000 index 0000000000..1172366a4e --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/txmonitor/txid.cddl @@ -0,0 +1 @@ +../../node-to-node/txsubmission2/txid.cddl \ No newline at end of file diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/reject.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/reject.cddl new file mode 100644 index 0000000000..0f57b50af4 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/reject.cddl @@ -0,0 +1,5 @@ +; https://github.com/IntersectMBO/ouroboros-consensus/issues/1429 +applyTxErr = [ 6, conway.ledgerPredFailure ] + +; https://github.com/IntersectMBO/cardano-ledger/issues/5075 +conway.ledgerPredFailure = any diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/tx.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/tx.cddl new file mode 120000 index 0000000000..0a8be97df8 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/tx.cddl @@ -0,0 +1 @@ +../../node-to-node/txsubmission2/tx.cddl \ No newline at end of file diff --git a/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/txid.cddl b/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/txid.cddl new file mode 120000 index 0000000000..1172366a4e --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-client/txsubmission2/txid.cddl @@ -0,0 +1 @@ +../../node-to-node/txsubmission2/txid.cddl \ No newline at end of file diff --git a/ouroboros-consensus-cardano/cddl/node-to-node/blockfetch/block.cddl b/ouroboros-consensus-cardano/cddl/node-to-node/blockfetch/block.cddl new file mode 100644 index 0000000000..02a1c1b584 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-node/blockfetch/block.cddl @@ -0,0 +1,3 @@ +serialisedCardanoBlock = #6.24(bytes .cbor cardanoBlock) + +;# import cardanoBlock from block diff --git a/ouroboros-consensus-cardano/cddl/node-to-node/blockfetch/point.cddl b/ouroboros-consensus-cardano/cddl/node-to-node/blockfetch/point.cddl new file mode 100644 index 0000000000..f2dee00e56 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-node/blockfetch/point.cddl @@ -0,0 +1,3 @@ +point = base.point + +;# import base as base diff --git a/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/header.cddl b/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/header.cddl new file mode 100644 index 0000000000..fce611726a --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/header.cddl @@ -0,0 +1,25 @@ +header + = ns7, + serialisedShelleyHeader, + serialisedShelleyHeader, + serialisedShelleyHeader, + serialisedShelleyHeader, + serialisedShelleyHeader> + +byronHeader = [byronRegularIdx, #6.24(bytes .cbor byron.blockhead)] + / [byronBoundaryIdx, #6.24(bytes .cbor byron.ebbhead)] + +byronBoundaryIdx = [0, word32] +byronRegularIdx = [1, word32] + +serialisedShelleyHeader = #6.24(bytes .cbor era) + +;# include byron as byron +;# include shelley as shelley +;# include allegra as allegra +;# include mary as mary +;# include alonzo as alonzo +;# include babbage as babbage +;# include conway as conway +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/point.cddl b/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/point.cddl new file mode 100644 index 0000000000..f2dee00e56 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/point.cddl @@ -0,0 +1,3 @@ +point = base.point + +;# import base as base diff --git a/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/tip.cddl b/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/tip.cddl new file mode 100644 index 0000000000..037167e892 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-node/chainsync/tip.cddl @@ -0,0 +1,3 @@ +tip = [ base.point, base.blockno ] + +;# import base as base diff --git a/ouroboros-consensus-cardano/cddl/node-to-node/txsubmission2/tx.cddl b/ouroboros-consensus-cardano/cddl/node-to-node/txsubmission2/tx.cddl new file mode 100644 index 0000000000..a9691ba136 --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-node/txsubmission2/tx.cddl @@ -0,0 +1,19 @@ +tx = + ns7, + serialisedShelleyTx, + serialisedShelleyTx, + serialisedShelleyTx, + serialisedShelleyTx, + serialisedShelleyTx> + +serialisedShelleyTx = #6.24(bytes .cbor era) + +;# include byron as byron +;# include shelley as shelley +;# include allegra as allegra +;# include mary as mary +;# include alonzo as alonzo +;# include babbage as babbage +;# include conway as conway +;# import base diff --git a/ouroboros-consensus-cardano/cddl/node-to-node/txsubmission2/txid.cddl b/ouroboros-consensus-cardano/cddl/node-to-node/txsubmission2/txid.cddl new file mode 100644 index 0000000000..71ebb3f3cb --- /dev/null +++ b/ouroboros-consensus-cardano/cddl/node-to-node/txsubmission2/txid.cddl @@ -0,0 +1,22 @@ +txId = + ns7 + +byronTxId = [0, byron.txid] + / [1, byron.certificateid] + / [2, byron.updid] + / [3, byron.voteid] + +;# include byron as byron +;# include shelley as shelley +;# include allegra as allegra +;# include mary as mary +;# include alonzo as alonzo +;# include babbage as babbage +;# include conway as conway +;# import base diff --git a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal index 86fa8bfaf0..717108faaf 100644 --- a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal +++ b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal @@ -23,6 +23,9 @@ extra-doc-files: CHANGELOG.md README.md +data-files: + cddl/**/*.cddl + source-repository head type: git location: https://github.com/IntersectMBO/ouroboros-consensus @@ -316,7 +319,7 @@ library unstable-shelley-testlib cardano-ledger-shelley:{cardano-ledger-shelley, testlib}, cardano-ledger-shelley-ma-test, cardano-ledger-shelley-test, - cardano-protocol-tpraos:{cardano-protocol-tpraos, testlib}, + cardano-protocol-tpraos:{cardano-protocol-tpraos}, cardano-slotting, cardano-strict-containers, containers, @@ -436,6 +439,7 @@ test-suite cardano-test other-modules: Test.Consensus.Cardano.DiffusionPipelining Test.Consensus.Cardano.Golden + Test.Consensus.Cardano.GenCDDLs Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.ByteStringTxParser Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.Server Test.Consensus.Cardano.Serialisation @@ -448,7 +452,9 @@ test-suite cardano-test Test.ThreadNet.MaryAlonzo Test.ThreadNet.ShelleyAllegra + other-modules: Paths_ouroboros_consensus_cardano build-depends: + temporary, QuickCheck, base, base16-bytestring, @@ -488,6 +494,19 @@ test-suite cardano-test unstable-byron-testlib, unstable-cardano-testlib, unstable-shelley-testlib, + bytestring, + cardano-ledger-allegra:testlib, + cardano-ledger-alonzo:testlib, + cardano-ledger-babbage:testlib, + cardano-ledger-byron, + cardano-ledger-conway:testlib, + cardano-ledger-mary:testlib, + cardano-ledger-shelley:testlib, + directory, + filepath, + process-extras, + tasty-hunit, + tasty, library unstable-cardano-tools import: common-lib diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs index f2187a7d6d..2973a72b1a 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs @@ -55,7 +55,6 @@ import Test.Cardano.Ledger.Alonzo.Arbitrary () import Test.Cardano.Ledger.Alonzo.Serialisation.Generators () import Test.Cardano.Ledger.Conway.Arbitrary () import Test.Consensus.Byron.Generators () -import Test.Consensus.Cardano.MockCrypto import Test.Consensus.Protocol.Serialisation.Generators () import Test.Consensus.Shelley.Generators import Test.Consensus.Shelley.MockCrypto (CanMock) @@ -70,14 +69,14 @@ import Test.Util.Serialisation.Roundtrip Disk -------------------------------------------------------------------------------} -instance Arbitrary (CardanoBlock MockCryptoCompatByron) where +instance Arbitrary (CardanoBlock StandardCrypto) where arbitrary = oneof $ catMaybes $ hcollapse generators where generators :: NP - (K (Maybe (Gen (CardanoBlock MockCryptoCompatByron)))) - (CardanoEras MockCryptoCompatByron) + (K (Maybe (Gen (CardanoBlock StandardCrypto)))) + (CardanoEras StandardCrypto) generators = mk BlockByron :* mk BlockShelley @@ -91,18 +90,18 @@ instance Arbitrary (CardanoBlock MockCryptoCompatByron) where mk :: forall a x. Arbitrary a => - (a -> CardanoBlock MockCryptoCompatByron) -> - K (Maybe (Gen (CardanoBlock MockCryptoCompatByron))) x + (a -> CardanoBlock StandardCrypto) -> + K (Maybe (Gen (CardanoBlock StandardCrypto))) x mk f = K $ Just $ f <$> arbitrary -instance Arbitrary (Coherent (CardanoBlock MockCryptoCompatByron)) where +instance Arbitrary (Coherent (CardanoBlock StandardCrypto)) where arbitrary = fmap Coherent $ oneof $ catMaybes $ hcollapse generators where generators :: NP - (K (Maybe (Gen (CardanoBlock MockCryptoCompatByron)))) - (CardanoEras MockCryptoCompatByron) + (K (Maybe (Gen (CardanoBlock StandardCrypto)))) + (CardanoEras StandardCrypto) generators = mk BlockByron :* mk BlockShelley @@ -116,11 +115,11 @@ instance Arbitrary (Coherent (CardanoBlock MockCryptoCompatByron)) where mk :: forall a x. Arbitrary (Coherent a) => - (a -> CardanoBlock MockCryptoCompatByron) -> - K (Maybe (Gen (CardanoBlock MockCryptoCompatByron))) x + (a -> CardanoBlock StandardCrypto) -> + K (Maybe (Gen (CardanoBlock StandardCrypto))) x mk f = K $ Just $ f . getCoherent <$> arbitrary -instance Arbitrary (CardanoHeader MockCryptoCompatByron) where +instance Arbitrary (CardanoHeader StandardCrypto) where arbitrary = getHeader <$> arbitrary instance @@ -139,7 +138,7 @@ instance aux = K . OneEraHash . toShortRawHash (Proxy @blk) . unwrapHeaderHash instance - (c ~ MockCryptoCompatByron, ShelleyBasedEra ShelleyEra) => + (c ~ StandardCrypto, ShelleyBasedEra ShelleyEra) => Arbitrary (AnnTip (CardanoBlock c)) where arbitrary = @@ -344,7 +343,7 @@ arbitraryNodeToNode injByron injShelley injAllegra injMary injAlonzo injBabbage x instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToNodeVersion (CardanoEras c)) @@ -362,7 +361,7 @@ instance injConway = mapSomeNestedCtxt (NCS . NCS . NCS . NCS . NCS . NCS . NCZ) instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToNodeVersion (CardanoEras c)) @@ -380,7 +379,7 @@ instance BlockConway instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToNodeVersion (CardanoEras c)) @@ -398,7 +397,7 @@ instance HeaderConway instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToNodeVersion (CardanoEras c)) @@ -416,7 +415,7 @@ instance GenTxConway instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToNodeVersion (CardanoEras c)) @@ -695,7 +694,7 @@ arbitraryNodeToClient injByron injShelley injAllegra injMary injAlonzo injBabbag ] instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToClientVersion (CardanoEras c)) @@ -713,7 +712,7 @@ instance BlockConway instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToClientVersion (CardanoEras c)) @@ -731,7 +730,7 @@ instance GenTxConway instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToClientVersion (CardanoEras c)) @@ -761,8 +760,8 @@ instance shrink = traverse aux where aux :: - CardanoApplyTxErr MockCryptoCompatByron -> - [CardanoApplyTxErr MockCryptoCompatByron] + CardanoApplyTxErr StandardCrypto -> + [CardanoApplyTxErr StandardCrypto] aux (HardForkApplyTxErrFromEra (OneEraApplyTxErr x)) = HardForkApplyTxErrFromEra . OneEraApplyTxErr <$> shrink x aux (HardForkApplyTxErrWrongEra x) = @@ -796,7 +795,7 @@ instance ] instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToClientVersion (CardanoEras c)) @@ -916,7 +915,7 @@ instance Arbitrary (EraIndex (CardanoEras c)) where Just ns -> return $ eraIndexFromNS ns instance - c ~ MockCryptoCompatByron => + c ~ StandardCrypto => Arbitrary ( WithVersion (HardForkNodeToClientVersion (CardanoEras c)) diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs index 8ef78d4dd8..538723972f 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs @@ -51,7 +51,6 @@ import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ) import Test.Cardano.Ledger.Shelley.Serialisation.Generators () import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators () -import Test.Cardano.Protocol.TPraos.Arbitrary (genBlock) import Test.Consensus.Protocol.Serialisation.Generators () import Test.Consensus.Shelley.MockCrypto (CanMock) import Test.QuickCheck hiding (Result) @@ -79,7 +78,7 @@ instance allPoolKeys <- replicateM (fromIntegral $ numCoreNodes defaultConstants) $ genIssuerKeys defaultConstants - mkShelleyBlock <$> genBlock allPoolKeys + mkShelleyBlock <$> genCoherentBlock allPoolKeys instance (Praos.PraosCrypto crypto, CanMock (Praos crypto) era) => diff --git a/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Golden.hs b/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Golden.hs index c704066c59..31bb6bc1b0 100644 --- a/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Golden.hs +++ b/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Golden.hs @@ -14,7 +14,7 @@ import Test.Util.Paths import Test.Util.Serialisation.Golden tests :: TestTree -tests = goldenTest_all codecConfig ($(getGoldenDir) "byron") examples +tests = goldenTest_all codecConfig ($(getGoldenDir) "byron") Nothing examples instance ToGoldenDirectory ByronNodeToNodeVersion diff --git a/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs b/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs index ddc746b449..fd5f292237 100644 --- a/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs +++ b/ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs @@ -37,7 +37,7 @@ tests :: TestTree tests = testGroup "Byron" - [ roundtrip_all testCodecCfg dictNestedHdr + [ roundtrip_all testCodecCfg dictNestedHdr Nothing , testProperty "BinaryBlockInfo sanity check" prop_byronBinaryBlockInfo , testGroup "Integrity" diff --git a/ouroboros-consensus-cardano/test/cardano-test/Main.hs b/ouroboros-consensus-cardano/test/cardano-test/Main.hs index eefdc14769..0a78071a28 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Main.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Main.hs @@ -2,6 +2,7 @@ module Main (main) where import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) import qualified Test.Consensus.Cardano.DiffusionPipelining +import Test.Consensus.Cardano.GenCDDLs import qualified Test.Consensus.Cardano.Golden import qualified Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.Server import qualified Test.Consensus.Cardano.Serialisation (tests) @@ -29,8 +30,12 @@ tests = testGroup "cardano" [ Test.Consensus.Cardano.DiffusionPipelining.tests - , Test.Consensus.Cardano.Golden.tests - , Test.Consensus.Cardano.Serialisation.tests + , withCDDLs $ + testGroup + "Serialisation" + [ Test.Consensus.Cardano.Golden.tests + , Test.Consensus.Cardano.Serialisation.tests + ] , Test.Consensus.Cardano.SupportedNetworkProtocolVersion.tests , Test.Consensus.Cardano.SupportsSanityCheck.tests , Test.ThreadNet.AllegraMary.tests diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/GenCDDLs.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/GenCDDLs.hs new file mode 100644 index 0000000000..4729f17cbd --- /dev/null +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/GenCDDLs.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} +-- | + +module Test.Consensus.Cardano.GenCDDLs (withCDDLs) where + +import qualified Control.Monad as Monad +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Char8 as BS8 +import Data.Maybe (isNothing) +import qualified Data.List as L +import Paths_ouroboros_consensus_cardano +import qualified System.Directory as D +import qualified System.Environment as E +import System.Exit +import qualified System.FilePath as F +import qualified System.Process.ByteString.Lazy as P + +-- TODO: this is waiting to update to a newer ledger +--import qualified Test.Cardano.Chain.Binary.Cddl as Byron +import qualified Test.Cardano.Ledger.Allegra.Binary.Cddl as Allegra +import qualified Test.Cardano.Ledger.Alonzo.Binary.Cddl as Alonzo +import qualified Test.Cardano.Ledger.Babbage.Binary.Cddl as Babbage +import qualified Test.Cardano.Ledger.Conway.Binary.Cddl as Conway +import qualified Test.Cardano.Ledger.Mary.Binary.Cddl as Mary +import qualified Test.Cardano.Ledger.Shelley.Binary.Cddl as Shelley +import System.IO +import Test.Tasty +import System.IO.Temp + +newtype CDDLSpec = CDDLSpec { cddlSpec :: BS.ByteString } deriving Show + +withCDDLs :: TestTree -> TestTree +withCDDLs f = withResource + (do + probeTools + setupCDDLCEnv + BS.writeFile "ntnblock.cddl" . cddlSpec + =<< (cddlc "cddl/node-to-node/blockfetch/block.cddl" >>= fixupBlockCDDL) + BS.writeFile "ntnheader.cddl" . cddlSpec + =<< cddlc "cddl/node-to-node/chainsync/header.cddl" + ) + (\() -> do + D.removeFile "ntnblock.cddl" + D.removeFile "ntnheader.cddl" + ) + (\_ -> f) + + +fixupBlockCDDL :: CDDLSpec -> IO CDDLSpec +fixupBlockCDDL spec = + withTempFile "." "block-temp.cddl" $ \fp h -> do + hClose h + BS.writeFile fp . cddlSpec $ spec + -- This is wrong, both the metadata_hash of a pool and a transaction body + -- point to this type, but only the latter must be 32B. + sed fp ["-i", "s/\\(metadata_hash = \\)/\\1 bytes ;/g"] + -- For plutus, the type is actually `bytes`, but the distinct construct is + -- for forcing generation of different values. + sed fp ["-i", "s/\\(conway\\.distinct_VBytes = \\)/\\1 bytes ;\\//g"] + -- These 3 below are hardcoded for generation. See cardano-ledger#5054 + sed fp ["-i", "s/\\([yaoye]\\.address = \\)/\\1 bytes ;/g"] + sed fp ["-i", "s/\\(reward_account = \\)/\\1 bytes ;/g"] + sed fp ["-i", "-z", "s/unit_interval = #6\\.30(\\[\\n\\s*1,\\n\\s*2,\\n\\])/unit_interval = #6.30([uint, uint])/g"] + CDDLSpec <$> BS.readFile fp + +setupCDDLCEnv :: IO () +setupCDDLCEnv = do + -- This is not how it should be because we can't update the Ledger + -- to a newer one. On `master` there is a function + -- `Byron.readByronCddlFileNames` which we would want to use. + -- + -- Note also that cabal run will run in the root of the project and + -- cabal test will run in `ouroboros-consensus-cardano`. This path + -- is for the latter. + byron <- pure ["../../cardano-ledger/eras/byron/cddl-spec/"] + shelley <- map takePath <$> Shelley.readShelleyCddlFileNames + allegra <- map takePath <$> Allegra.readAllegraCddlFileNames + mary <- map takePath <$> Mary.readMaryCddlFileNames + alonzo <- map takePath <$> Alonzo.readAlonzoCddlFileNames + babbage <- map takePath <$> Babbage.readBabbageCddlFileNames + conway <- map takePath <$> Conway.readConwayCddlFileNames + + localDataDir <- takePath <$> getDataDir + let local_paths = map (localDataDir F.) [ + "cddl" + , "cddl/disk" + , "cddl/disk/snapshot" + , "cddl/node-to-client/localstatequery/byron" + , "cddl/node-to-client/localstatequery/consensus" + , "cddl/node-to-client/localstatequery/shelley" + , "cddl/node-to-client/txmonitor" + ] + + include_path = + mconcat + $ L.intersperse ":" + $ map (mconcat . L.intersperse ":") [byron, shelley, allegra, mary, alonzo, babbage, conway] <> local_paths + + writeFile "env" ("CDDL_INCLUDE_PATH=" <> include_path <> ":") + E.setEnv "CDDL_INCLUDE_PATH" (include_path <> ":") + +sed :: FilePath -> [String] -> IO () +sed fp args = + Monad.void $ P.readProcessWithExitCode "sed" (args ++ [fp]) mempty + +cddlc :: FilePath -> IO CDDLSpec +cddlc dataFile = do + putStrLn $ "Generating: " <> dataFile + path <- getDataFileName dataFile + (_, BSL.toStrict -> cddl, BSL.toStrict -> err) <- +#ifndef mingw32_HOST_OS + P.readProcessWithExitCode "cddlc" ["-u", "-2", "-t", "cddl", path] mempty +#else + -- we cannot call @cddlc@ directly because it is not an executable in + -- Haskell eyes, but we can call @ruby@ and pass the @cddlc@ script path as + -- an argument + do + prefix <- E.getEnv "MSYSTEM_PREFIX" + P.readProcessWithExitCode "ruby" [prefix F. "bin/cddlc", "-u", "-2", "-t", "cddl", path] mempty +#endif + Monad.unless (BS.null err) $ red $ BS8.unpack err + return $ CDDLSpec cddl + where + red s = putStrLn $ "\ESC[31m" <> s <> "\ESC[0m" + +takePath :: FilePath -> FilePath +takePath x = +#ifndef mingw32_HOST_OS + F.takeDirectory x +#else + -- @cddlc@ is not capable of using backlashes + -- + -- @cddlc@ mixes @C:@ with the separator in @CDDL_INCLUDE_PATH@, and it + -- doesn't understand @;@ as a separator. It works if we remove @C:@ and we + -- are running in the same drive as the cddl files. + let f = [ if c /= '\\' then c else '/' | c <- F.takeDirectory x ] + in if "C:" `L.isPrefixOf` f + then drop 2 f + else f +#endif + +probeTools :: IO () +probeTools = do + putStrLn "Probing tools:" +#ifndef mingw32_HOST_OS + posixProbeTool "cddlc" "install the `cddlc` ruby gem" + where + posixProbeTool :: String -> String -> IO () + posixProbeTool tool suggestion = do + putStr $ "- " <> tool <> " " + exe <- D.findExecutable tool + if isNothing exe + then do + putStrLn "not found!" + putStrLn $ "Please " <> suggestion + exitFailure + else + putStrLn "found" +#else + -- On Windows, the cddl and cddlc files are POSIX scripts and therefore not + -- recognized as executables by @findExecutable@, so we need to do some dirty + -- tricks here. We check that ruby executable exists and then that there are + -- cddl and cddlc files in the binary folder of the MSYS2 installation. + putStr "- ruby " + rubyExe <- D.findExecutable "ruby" + if (isNothing rubyExe) + then do + putStrLn "not found!\nPlease install ruby" + exitFailure + else + putStrLn "found" + + putStr "- cddlc " + cddlcExe <- D.doesFileExist . (F. "bin/cddlc") =<< E.getEnv "MSYSTEM_PREFIX" + if cddlcExe + then putStrLn "found" + else do + putStrLn "not found!\nPlease install the `cddlc` ruby gem" + exitFailure + pure () +#endif diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Golden.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Golden.hs index e749638889..6dbde6cac7 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Golden.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Golden.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -16,10 +17,16 @@ import System.FilePath (()) import Test.Consensus.Cardano.Examples import Test.Tasty import Test.Util.Paths +import Test.Util.Serialisation.CDDL import Test.Util.Serialisation.Golden tests :: TestTree -tests = goldenTest_all codecConfig ($(getGoldenDir) "cardano") examples +tests = + goldenTest_all + codecConfig + ($(getGoldenDir) "cardano") + (Just $ CDDLsForNodeToNode ("ntnblock.cddl", "serialisedCardanoBlock") ("ntnheader.cddl", "header")) + examples instance CardanoHardForkConstraints c => diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Serialisation.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Serialisation.hs index fa104caa50..6dbfee879b 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Serialisation.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Serialisation.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Consensus.Cardano.Serialisation (tests) where @@ -21,7 +22,6 @@ import Ouroboros.Network.Block (Serialised (..)) import Test.Consensus.Byron.Generators (epochSlots) import qualified Test.Consensus.Cardano.Examples as Cardano.Examples import Test.Consensus.Cardano.Generators () -import Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron) import Test.Tasty import Test.Tasty.QuickCheck (Property, testProperty, (===)) import Test.Util.Orphans.Arbitrary () @@ -33,7 +33,18 @@ tests = "Cardano" [ testGroup "Examples roundtrip" $ examplesRoundtrip Cardano.Examples.codecConfig Cardano.Examples.examples - , roundtrip_all_skipping result testCodecCfg dictNestedHdr + , roundtrip_all_skipping + result + testCodecCfg + dictNestedHdr + -- We would want to use this instead, but the generated blocks + -- do not quite validate yet or sometimes they are not + -- entirely coherent, so for now this is commented out. + -- + -- ( Just $ + -- CDDLsForNodeToNode ("ntnmockblock.cddl", "serialisedCardanoBlock") ("ntnheader.cddl", "header") + -- ) + Nothing , testProperty "BinaryBlockInfo sanity check" prop_CardanoBinaryBlockInfo ] where @@ -41,7 +52,7 @@ tests = result "roundtrip Result" = DoNotCheckCBORValidity result _ = CheckCBORValidity -testCodecCfg :: CardanoCodecConfig MockCryptoCompatByron +testCodecCfg :: CardanoCodecConfig StandardCrypto testCodecCfg = CardanoCodecConfig (ByronCodecConfig epochSlots) @@ -54,7 +65,7 @@ testCodecCfg = dictNestedHdr :: forall a. - NestedCtxt_ (CardanoBlock MockCryptoCompatByron) Header a -> + NestedCtxt_ (CardanoBlock StandardCrypto) Header a -> Dict (Eq a, Show a) dictNestedHdr = \case NCZ (CtxtByronBoundary{}) -> Dict @@ -70,7 +81,7 @@ dictNestedHdr = \case BinaryBlockInfo -------------------------------------------------------------------------------} -prop_CardanoBinaryBlockInfo :: CardanoBlock MockCryptoCompatByron -> Property +prop_CardanoBinaryBlockInfo :: CardanoBlock StandardCrypto -> Property prop_CardanoBinaryBlockInfo blk = encodedNestedHeader === extractedHeader where diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Golden.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Golden.hs index acfab846ec..f3fb94e6c3 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Golden.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Golden.hs @@ -17,7 +17,7 @@ import Test.Util.Paths import Test.Util.Serialisation.Golden tests :: TestTree -tests = goldenTest_all codecConfig ($(getGoldenDir) "shelley") examplesShelley +tests = goldenTest_all codecConfig ($(getGoldenDir) "shelley") Nothing examplesShelley instance ToGoldenDirectory ShelleyNodeToNodeVersion diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Serialisation.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Serialisation.hs index 4761357c58..b0aa8a53eb 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Serialisation.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Serialisation.hs @@ -31,7 +31,7 @@ tests :: TestTree tests = testGroup "Shelley" - [ roundtrip_all testCodecCfg dictNestedHdr + [ roundtrip_all testCodecCfg dictNestedHdr Nothing , -- Test for real crypto too testProperty "hashSize real crypto" $ prop_hashSize pReal , testProperty "ConvertRawHash real crypto" $ roundtrip_ConvertRawHash pReal diff --git a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs index 26a34a87a1..3f82ec83e3 100644 --- a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs +++ b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs @@ -55,7 +55,7 @@ instance Arbitrary TestSetup where tests :: TestTree tests = testGroup "BFT" $ - [ roundtrip_all SimpleCodecConfig dictNestedHdr + [ roundtrip_all SimpleCodecConfig dictNestedHdr Nothing , testProperty "simple convergence" $ \setup -> prop_simple_bft_convergence setup ] diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal index eea42167be..2889e1785d 100644 --- a/ouroboros-consensus/ouroboros-consensus.cabal +++ b/ouroboros-consensus/ouroboros-consensus.cabal @@ -410,6 +410,7 @@ library unstable-consensus-testlib Test.Util.Schedule Test.Util.Serialisation.Examples Test.Util.Serialisation.Golden + Test.Util.Serialisation.CDDL Test.Util.Serialisation.Roundtrip Test.Util.Serialisation.SomeResult Test.Util.Shrink @@ -426,6 +427,7 @@ library unstable-consensus-testlib build-depends: QuickCheck >=2.15, + temporary, base, base16-bytestring, binary, @@ -463,6 +465,7 @@ library unstable-consensus-testlib quickcheck-state-machine:no-vendored-treediff ^>=0.10, quiet, random, + process, resource-registry, serialise, si-timers, diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/CDDL.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/CDDL.hs new file mode 100644 index 0000000000..b79f25cbdb --- /dev/null +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/CDDL.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE LambdaCase #-} + +module Test.Util.Serialisation.CDDL (cddlTestCase, cddlTest, CDDLsForNodeToNode (..)) where + +import qualified Data.ByteString as BS +import qualified Data.Text as T +import System.Exit +import System.IO +import System.IO.Temp +import System.Process +import Test.Tasty +import Test.Tasty.HUnit + +-- | A Tasty test case running the @cuddle@ +cddlTestCase :: IO BS.ByteString -> FilePath -> T.Text -> TestTree +cddlTestCase cborM cddl rule = + testCase "CDDL compliance" $ + cddlTest cborM cddl rule >>= \case + Left err -> assertFailure err + Right _ -> pure () + +-- | Test the CDDL conformance of the given bytestring +cddlTest :: + IO BS.ByteString -> + String -> + T.Text -> + IO (Either String ()) +cddlTest cborM cddl rule = + withTempFile "." "testcase.cbor" $ \fp h -> do + bs <- cborM + BS.hPutStr h bs + hClose h + (code, _out, err) <- + readProcessWithExitCode "cuddle" ["validate-cbor", "-c", fp, "-r", T.unpack rule, cddl] mempty + case code of + ExitFailure _ -> do + BS.writeFile "failing.cbor" bs + pure (Left err) + ExitSuccess -> pure (Right ()) + +-- | A collection of CDDL spec and the relevant rule to use +data CDDLsForNodeToNode = CDDLsForNodeToNode + { blockCDDL :: (FilePath, T.Text) + , headerCDDL :: (FilePath, T.Text) + } diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Golden.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Golden.hs index 4ac613c046..f25e1dcbbc 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Golden.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Golden.hs @@ -47,6 +47,7 @@ import qualified Data.ByteString.UTF8 as BS.UTF8 import Data.List (nub) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) +import qualified Data.Text as T import Data.TreeDiff import GHC.Stack (HasCallStack) import Ouroboros.Consensus.Block (CodecConfig) @@ -78,6 +79,7 @@ import System.FilePath (takeDirectory, ()) import Test.Cardano.Binary.TreeDiff (CBORBytes (..)) import Test.Tasty import Test.Tasty.Golden.Advanced (goldenTest) +import Test.Util.Serialisation.CDDL import Test.Util.Serialisation.Examples (Examples (..), Labelled) import Test.Util.Serialisation.SomeResult (SomeResult (..)) @@ -96,14 +98,27 @@ goldenTestCBOR :: (a -> Encoding) -> -- | Path to the file containing the golden output FilePath -> + -- | Path to the CDDL file that defines this CBOR, and the rule name + Maybe (FilePath, T.Text) -> TestTree -goldenTestCBOR testName example enc goldenFile = - goldenTest - testName - (Strict.readFile goldenFile) - (either exceptionToByteString id <$> try (evaluate actualValue)) - diff - updateGoldenFile +goldenTestCBOR testName example enc goldenFile mCddlPath = + testGroup testName $ + [ goldenTest + "Golden == actual" + (Strict.readFile goldenFile) + (either exceptionToByteString id <$> try (evaluate actualValue)) + diff + updateGoldenFile + ] + ++ ( case mCddlPath of + Nothing -> [] + Just (cddlPath, rule) -> + [ cddlTestCase + (Strict.readFile goldenFile) + cddlPath + rule + ] + ) where -- Copied from tasty-golden because it isn't exported updateGoldenFile :: Strict.ByteString -> IO () @@ -185,18 +200,19 @@ goldenTests :: (a -> Encoding) -> -- | Folder containing the golden files FilePath -> + Maybe (FilePath, T.Text) -> TestTree -goldenTests testName examples enc goldenFolder +goldenTests testName examples enc goldenFolder mCDDL | nub labels /= labels = error $ "Examples with the same label for " <> testName | [(Nothing, example)] <- examples = -- If there's just a single unlabelled example, no need for grouping, -- which makes the output more verbose. - goldenTestCBOR testName example enc (goldenFolder testName) + goldenTestCBOR testName example enc (goldenFolder testName) mCDDL | otherwise = testGroup testName - [ goldenTestCBOR testName' example enc (goldenFolder testName') + [ goldenTestCBOR testName' example enc (goldenFolder testName') mCDDL | (mbLabel, example) <- examples , let testName' = case mbLabel of Nothing -> testName @@ -212,18 +228,19 @@ goldenTests' :: Labelled (a, a -> Encoding) -> -- | Folder containing the golden files FilePath -> + Maybe (FilePath, T.Text) -> TestTree -goldenTests' testName examples goldenFolder +goldenTests' testName examples goldenFolder mCDDL | nub labels /= labels = error $ "Examples with the same label for " <> testName | [(Nothing, (example, exampleEncoder))] <- examples = -- If there's just a single unlabelled example, no need for grouping, -- which makes the output more verbose. - goldenTestCBOR testName example exampleEncoder (goldenFolder testName) + goldenTestCBOR testName example exampleEncoder (goldenFolder testName) mCDDL | otherwise = testGroup testName - [ goldenTestCBOR testName' example exampleEncoder (goldenFolder testName') + [ goldenTestCBOR testName' example exampleEncoder (goldenFolder testName') mCDDL | (mbLabel, (example, exampleEncoder)) <- examples , let testName' = case mbLabel of Nothing -> testName @@ -272,13 +289,14 @@ goldenTest_all :: -- | Path relative to the root of the repository that contains the golden -- files FilePath -> + Maybe CDDLsForNodeToNode -> Examples blk -> TestTree -goldenTest_all codecConfig goldenDir examples = +goldenTest_all codecConfig goldenDir mCDDLs examples = testGroup "Golden tests" [ goldenTest_SerialiseDisk codecConfig goldenDir examples - , goldenTest_SerialiseNodeToNode codecConfig goldenDir examples + , goldenTest_SerialiseNodeToNode codecConfig goldenDir mCDDLs examples , goldenTest_SerialiseNodeToClient codecConfig goldenDir examples ] @@ -312,6 +330,7 @@ goldenTest_SerialiseDisk codecConfig goldenDir Examples{..} = exampleValues enc (goldenDir "disk") + Nothing testLedgerTables :: TestTree testLedgerTables = @@ -323,6 +342,7 @@ goldenTest_SerialiseDisk codecConfig goldenDir Examples{..} = exampleLedgerState ) (goldenDir "disk") + Nothing encodeExt = encodeDiskExtLedgerState codecConfig @@ -337,9 +357,10 @@ goldenTest_SerialiseNodeToNode :: ) => CodecConfig blk -> FilePath -> + Maybe CDDLsForNodeToNode -> Examples blk -> TestTree -goldenTest_SerialiseNodeToNode codecConfig goldenDir Examples{..} = +goldenTest_SerialiseNodeToNode codecConfig goldenDir mCDDLs Examples{..} = testGroup "SerialiseNodeToNode" [ testVersion version @@ -350,15 +371,15 @@ goldenTest_SerialiseNodeToNode codecConfig goldenDir Examples{..} = testVersion version = testGroup (toGoldenDirectory version) - [ test "Block" exampleBlock - , test "Header" exampleHeader - , test "SerialisedBlock" exampleSerialisedBlock - , test "SerialisedHeader" exampleSerialisedHeader - , test "GenTx" exampleGenTx - , test "GenTxId" exampleGenTxId + [ test "Block" exampleBlock $ fmap blockCDDL mCDDLs + , test "Header" exampleHeader $ fmap headerCDDL mCDDLs + , test "SerialisedBlock" exampleSerialisedBlock Nothing + , test "SerialisedHeader" exampleSerialisedHeader Nothing + , test "GenTx" exampleGenTx Nothing + , test "GenTxId" exampleGenTxId Nothing ] where - test :: SerialiseNodeToNode blk a => TestName -> Labelled a -> TestTree + test :: SerialiseNodeToNode blk a => TestName -> Labelled a -> Maybe (FilePath, T.Text) -> TestTree test testName exampleValues = goldenTests testName @@ -416,6 +437,7 @@ goldenTest_SerialiseNodeToClient codecConfig goldenDir Examples{..} = exampleValues enc (goldenDir toGoldenDirectory versions) + Nothing {------------------------------------------------------------------------------- FlatTerm diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Roundtrip.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Roundtrip.hs index 6130e7f9c4..64aa165f38 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Roundtrip.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Roundtrip.hs @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} @@ -48,6 +49,7 @@ import Codec.CBOR.Write (toLazyByteString) import Codec.Serialise (decode, encode) import Control.Arrow (left) import Control.Monad (unless, when) +import qualified Data.ByteString as BS import qualified Data.ByteString.Base16.Lazy as Base16 import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy.Char8 as Char8 @@ -55,7 +57,8 @@ import qualified Data.ByteString.Short as Short import Data.Constraint import Data.Function (on) import Data.Maybe (fromMaybe) -import qualified Data.Text.Lazy as T +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import Data.Typeable import GHC.Generics (Generic) import Ouroboros.Consensus.Block @@ -90,9 +93,11 @@ import Ouroboros.Network.Block , mkSerialised ) import Quiet (Quiet (..)) +import Test.QuickCheck.Monadic import Test.Tasty import Test.Tasty.QuickCheck import Test.Util.Orphans.Arbitrary () +import Test.Util.Serialisation.CDDL import Test.Util.Serialisation.Examples (Examples (..), Labelled) import Test.Util.Serialisation.SomeResult (SomeResult (..)) import Test.Util.TestEnv (adjustQuickCheckTests) @@ -103,9 +108,10 @@ import Text.Pretty.Simple (pShow) ------------------------------------------------------------------------------} roundtrip :: - (Eq a, Show a) => + (Eq a, Show a, Show e) => (a -> Encoding) -> (forall s. Decoder s a) -> + (BS.ByteString -> IO (Either e ())) -> a -> Property roundtrip enc dec = roundtrip' enc (const <$> dec) @@ -114,11 +120,12 @@ roundtrip enc dec = roundtrip' enc (const <$> dec) -- -- See 'roundtripAnd' roundtrip' :: - forall a. - (Eq a, Show a) => + forall a e. + (Eq a, Show a, Show e) => -- | @enc@ (a -> Encoding) -> (forall s. Decoder s (Lazy.ByteString -> a)) -> + (BS.ByteString -> IO (Either e ())) -> a -> Property roundtrip' = roundtripAnd CheckCBORValidity @@ -141,29 +148,38 @@ data ShouldCheckCBORValidity = CheckCBORValidity | DoNotCheckCBORValidity -- might happen is if the annotation is not canonical CBOR, but @enc@ does -- produce canonical CBOR. roundtripAnd :: - forall a. - (Eq a, Show a) => + forall a e. + (Eq a, Show a, Show e) => ShouldCheckCBORValidity -> -- | @enc@ (a -> Encoding) -> (forall s. Decoder s (Lazy.ByteString -> a)) -> + (BS.ByteString -> IO (Either e ())) -> a -> Property -roundtripAnd check enc dec a = checkRoundtripResult $ do +roundtripAnd check enc dec checkCddlValid a = let enc_a = enc a bs = toLazyByteString enc_a - - when (check == CheckCBORValidity) $ - (validFlatTerm (toFlatTerm enc_a) ?! "Encoded flat term is not valid: " <> show enc_a) - (bsRem, a') <- deserialiseFromBytes dec bs `onError` showByteString bs - Lazy.null bsRem ?! "Left-over bytes: " <> toBase16 bsRem - a == a' bs ?! pShowNeq a (a' bs) + cborValid = + throwLeft $ + when (check == CheckCBORValidity) $ + validFlatTerm (toFlatTerm enc_a) ?! "Encoded flat term is not valid: " <> show enc_a + doesRoundtrip = throwLeft $ do + (bsRem, a') <- deserialiseFromBytes dec bs `onError` showByteString bs + Lazy.null bsRem ?! "Left-over bytes: " <> toBase16 bsRem + a == a' bs ?! pShowNeq a (a' bs) + cddlValid = + monadicIO $ + run (checkCddlValid $ Lazy.toStrict bs) >>= \case + Left err -> assertWith False (show err) + Right _ -> pure () + in cborValid .&&. doesRoundtrip .&&. cddlValid where (?!) :: Bool -> String -> Either String () cond ?! msg = unless cond $ Left msg infix 1 ?! - pShowNeq x y = T.unpack (pShow x) <> "\n \t/= \n" <> T.unpack (pShow y) + pShowNeq x y = TL.unpack (pShow x) <> "\n \t/= \n" <> TL.unpack (pShow y) onError :: Either DeserialiseFailure (Char8.ByteString, Char8.ByteString -> a) -> @@ -182,9 +198,9 @@ roundtripAnd check enc dec a = checkRoundtripResult $ do toBase16 :: Lazy.ByteString -> String toBase16 = Char8.unpack . Base16.encode - checkRoundtripResult :: Either String () -> Property - checkRoundtripResult (Left str) = counterexample str False - checkRoundtripResult (Right ()) = property () + throwLeft :: Either String () -> Property + throwLeft (Left str) = counterexample str False + throwLeft (Right ()) = property () roundtripComparingEncoding :: (a -> Encoding) -> @@ -259,6 +275,7 @@ roundtrip_all :: ) => CodecConfig blk -> (forall a. NestedCtxt_ blk Header a -> Dict (Eq a, Show a)) -> + Maybe CDDLsForNodeToNode -> TestTree roundtrip_all = roundtrip_all_skipping (const CheckCBORValidity) @@ -304,12 +321,13 @@ roundtrip_all_skipping :: (TestName -> ShouldCheckCBORValidity) -> CodecConfig blk -> (forall a. NestedCtxt_ blk Header a -> Dict (Eq a, Show a)) -> + Maybe CDDLsForNodeToNode -> TestTree -roundtrip_all_skipping shouldCheckCBORvalidity ccfg dictNestedHdr = +roundtrip_all_skipping shouldCheckCBORvalidity ccfg dictNestedHdr mCDDLs = testGroup "Roundtrip" [ testGroup "SerialiseDisk" $ roundtrip_SerialiseDisk ccfg dictNestedHdr - , testGroup "SerialiseNodeToNode" $ roundtrip_SerialiseNodeToNode ccfg + , testGroup "SerialiseNodeToNode" $ roundtrip_SerialiseNodeToNode ccfg mCDDLs , testGroup "SerialiseNodeToClient" $ roundtrip_SerialiseNodeToClient shouldCheckCBORvalidity @@ -336,7 +354,7 @@ roundtrip_SerialiseDisk :: [TestTree] roundtrip_SerialiseDisk ccfg dictNestedHdr = [ testProperty "roundtrip block" $ - roundtrip' @blk (encodeDisk ccfg) (decodeDisk ccfg) + roundtrip' @blk (encodeDisk ccfg) (decodeDisk ccfg) (const $ pure (Right () :: Either () ())) , testProperty "roundtrip Header" $ \hdr -> case unnest hdr of DepPair ctxt nestedHdr -> case dictNestedHdr (flipNestedCtxt ctxt) of @@ -344,6 +362,7 @@ roundtrip_SerialiseDisk ccfg dictNestedHdr = roundtrip' (encodeDiskDep ccfg ctxt) (decodeDiskDep ccfg ctxt) + (const $ pure (Right () :: Either () ())) nestedHdr , -- Since the 'LedgerState' is a large data structure, we lower the -- number of tests to avoid slowing down the testsuite too much @@ -362,6 +381,7 @@ roundtrip_SerialiseDisk ccfg dictNestedHdr = roundtrip @a (encodeDisk ccfg) (decodeDisk ccfg) + (const $ pure (Right () :: Either () ())) -- | Used to generate arbitrary values for the serialisation roundtrip tests. -- As the serialisation format can change with the version, not all arbitrary @@ -481,12 +501,13 @@ roundtrip_SerialiseNodeToNode :: , DecodeDiskDep (NestedCtxt Header) blk ) => CodecConfig blk -> + Maybe CDDLsForNodeToNode -> [TestTree] -roundtrip_SerialiseNodeToNode ccfg = - [ rt (Proxy @blk) "blk" - , rt (Proxy @(Header blk)) "Header" - , rt (Proxy @(GenTx blk)) "GenTx" - , rt (Proxy @(GenTxId blk)) "GenTxId" +roundtrip_SerialiseNodeToNode ccfg mCDDLs = + [ rt (Proxy @blk) "blk" $ fmap blockCDDL mCDDLs + , rt (Proxy @(Header blk)) "Header" $ fmap blockCDDL mCDDLs + , rt (Proxy @(GenTx blk)) "GenTx" $ Nothing + , rt (Proxy @(GenTxId blk)) "GenTxId" $ Nothing , -- Roundtrip a @'Serialised' blk@ -- -- We generate a random @blk@, convert it to 'Serialised' (using @@ -498,6 +519,17 @@ roundtrip_SerialiseNodeToNode ccfg = roundtrip @blk (encodeThroughSerialised (encodeDisk ccfg) (enc version)) (decodeThroughSerialised (decodeDisk ccfg) (dec version)) + ( case fmap blockCDDL mCDDLs of + Nothing -> (const $ pure (Right ())) + Just (cddl, rule) -> + ( \bs -> + fmap (const ()) + <$> cddlTest + (pure bs) + cddl + rule + ) + ) blk , -- Same as above but for 'Header' testProperty "roundtrip Serialised Header" $ @@ -505,6 +537,7 @@ roundtrip_SerialiseNodeToNode ccfg = roundtrip @(Header blk) (enc version . SerialisedHeaderFromDepPair . encodeDepPair ccfg . unnest) (nest <$> (decodeDepPair ccfg . serialisedHeaderToDepPair =<< dec version)) + (const $ pure (Right () :: Either () ())) hdr , -- Check the compatibility between 'encodeNodeToNode' for @'Serialised' -- blk@ and 'decodeNodeToNode' for @blk@. @@ -513,6 +546,7 @@ roundtrip_SerialiseNodeToNode ccfg = roundtrip @blk (encodeThroughSerialised (encodeDisk ccfg) (enc version)) (dec version) + (const $ pure (Right () :: Either () ())) blk , -- Check the compatibility between 'encodeNodeToNode' for @blk@ and -- 'decodeNodeToNode' for @'Serialised' blk@. @@ -521,6 +555,7 @@ roundtrip_SerialiseNodeToNode ccfg = roundtrip @blk (enc version) (decodeThroughSerialised (decodeDisk ccfg) (dec version)) + (const $ pure (Right () :: Either () ())) blk , -- Same as above but for 'Header' testProperty "roundtrip Serialised Header compat 1" $ @@ -528,12 +563,14 @@ roundtrip_SerialiseNodeToNode ccfg = roundtrip @(Header blk) (enc version . SerialisedHeaderFromDepPair . encodeDepPair ccfg . unnest) (dec version) + (const $ pure (Right () :: Either () ())) hdr , testProperty "roundtrip Serialised Header compat 2" $ \(WithVersion version hdr) -> roundtrip @(Header blk) (enc version) (nest <$> (decodeDepPair ccfg . serialisedHeaderToDepPair =<< dec version)) + (const $ pure (Right () :: Either () ())) hdr ] where @@ -554,10 +591,22 @@ roundtrip_SerialiseNodeToNode ccfg = , Show a , SerialiseNodeToNode blk a ) => - Proxy a -> String -> TestTree - rt _ name = - testProperty ("roundtrip " <> name) $ \(WithVersion version x) -> - roundtrip @a (enc version) (dec version) x + Proxy a -> String -> Maybe (FilePath, T.Text) -> TestTree + rt _ name mCDDL = + testProperty ("roundtrip " <> name) $ \(WithVersion version x) -> do + roundtrip @a + (enc version) + (dec version) + ( case mCDDL of + Nothing -> const $ pure $ Right () + Just (cddl, rule) -> \bs -> + fmap (const ()) + <$> cddlTest + (pure bs) + cddl + rule + ) + x -- TODO how can we ensure that we have a test for each constraint listed in -- 'SerialiseNodeToClientConstraints'? @@ -616,6 +665,7 @@ roundtrip_SerialiseNodeToClient shouldCheckCBORvalidity ccfg = (shouldCheckCBORvalidity testLabel) (encodeThroughSerialised (encodeDisk ccfg) (enc version)) (const <$> decodeThroughSerialised (decodeDisk ccfg) (dec version)) + (const $ pure (Right () :: Either () ())) blk , -- See roundtrip_SerialiseNodeToNode for more info let testLabel = "roundtrip Serialised blk compat" @@ -625,6 +675,7 @@ roundtrip_SerialiseNodeToClient shouldCheckCBORvalidity ccfg = (shouldCheckCBORvalidity testLabel) (encodeThroughSerialised (encodeDisk ccfg) (enc version)) (const <$> dec version) + (const $ pure (Right () :: Either () ())) blk , let testLabel = "roundtrip Result" in testProperty testLabel $ @@ -633,6 +684,7 @@ roundtrip_SerialiseNodeToClient shouldCheckCBORvalidity ccfg = (shouldCheckCBORvalidity testLabel) (encodeBlockQueryResult ccfg version query) (const <$> decodeBlockQueryResult ccfg version query) + (const $ pure (Right () :: Either () ())) result ] where @@ -674,6 +726,7 @@ roundtrip_SerialiseNodeToClient shouldCheckCBORvalidity ccfg = (shouldCheckCBORvalidity testLabel) (enc' version) (const <$> dec' version) + (const $ pure (Right () :: Either () ())) a where testLabel = "roundtrip " <> name @@ -697,6 +750,7 @@ roundtrip_envelopes ccfg (WithVersion v (SomeSecond ctxt)) = roundtrip (encodeNodeToNode ccfg v . unBase16) (Base16 <$> decodeNodeToNode ccfg v) + (const (pure (Right () :: Either () ()))) (Base16 serialisedHeader) where serialisedHeader :: SerialisedHeader blk @@ -873,4 +927,4 @@ examplesRoundtrip codecConfig examples = mkTest exampleName example = testProperty (fromMaybe "" exampleName) $ once $ - roundtrip' enc dec example + roundtrip' enc dec (const $ pure (Right () :: Either () ())) example diff --git a/scripts/cbor/unwrap24serialised.hs b/scripts/cbor/unwrap24serialised.hs new file mode 100644 index 0000000000..b6c62ff718 --- /dev/null +++ b/scripts/cbor/unwrap24serialised.hs @@ -0,0 +1,26 @@ +{- cabal: + build-depends: cborg, bytestring, base +-} + +-- | A simple script that unwraps a CBOR term serialized as +-- CBOR-in-CBOR. It gets input from stdin and emits on stdout. +-- +-- > cat pre.cbor | cabal run ./scripts/unwrap24serialised.hs > post.cbor +module Main where + +import Prelude hiding (interact) +import Data.ByteString +import Codec.CBOR.Term +import Codec.CBOR.Write +import Codec.CBOR.Read +import Data.ByteString.Lazy (fromStrict, toStrict) + +main = interact $ + toStrict + . toLazyByteString + . encodeTerm + . (\(Right (_, t)) -> t) + . deserialiseFromBytes decodeTerm + . (\(Right (_, TTagged _ (TBytes t))) -> fromStrict t) + . deserialiseFromBytes decodeTerm + . fromStrict