diff --git a/README.md b/README.md index d2544f5e42..56db1d249f 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ # Ouroboros Consensus [![consensus](https://img.shields.io/badge/ouroboros--consensus-0.22.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-0.22.0.0/) -[![diffusion](https://img.shields.io/badge/ouroboros--consensus--diffusion-0.19.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-diffusion-0.19.0.0/) +[![diffusion](https://img.shields.io/badge/ouroboros--consensus--diffusion-0.20.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-diffusion-0.20.0.0/) [![protocol](https://img.shields.io/badge/ouroboros--consensus--protocol-0.10.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-protocol-0.10.0.0/) -[![cardano](https://img.shields.io/badge/ouroboros--consensus--cardano-0.21.0.0-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-cardano-0.21.0.0/) +[![cardano](https://img.shields.io/badge/ouroboros--consensus--cardano-0.21.0.1-blue)](https://chap.intersectmbo.org/package/ouroboros-consensus-cardano-0.21.0.1/) [![sop-extras](https://img.shields.io/badge/sop--extras-0.2.1.0-blue)](https://chap.intersectmbo.org/package/sop-extras-0.2.1.0/) [![strict-sop-core](https://img.shields.io/badge/strict--sop--core-0.1.2.0-blue)](https://chap.intersectmbo.org/package/strict-sop-core-0.1.2.0/) diff --git a/cabal.project b/cabal.project index 6ecd7821eb..6b4627b5f5 100644 --- a/cabal.project +++ b/cabal.project @@ -14,9 +14,9 @@ repository cardano-haskell-packages -- update either of these. index-state: -- Bump this if you need newer packages from Hackage - , hackage.haskell.org 2024-12-10T16:20:07Z + , hackage.haskell.org 2025-01-14T00:25:08Z -- Bump this if you need newer packages from CHaP - , cardano-haskell-packages 2025-02-04T06:43:15Z + , cardano-haskell-packages 2025-02-26T16:38:34Z packages: ouroboros-consensus @@ -44,3 +44,62 @@ package ouroboros-network if(os(windows)) constraints: bitvec -simd + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-base + tag: b2cec3fbcde4bacb9c961e5510d5a1d3754c4e2b + --sha256: sha256-TDEBINZ3SkhpRNomMdt53bR3gdzgkWR9jIlAr8yrU6o= + subdir: + cardano-crypto-class + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-ledger + -- This tag is from Alexey's PR that is based on an older version + -- tag: 9d380ab7d6ae52ff66aae9a19dbb3036b1b13c94 + -- This tag is before genIssuerKeys + -- tag: 4b2721c8abdf704c6f8de042e8fb1f3f6b3f1aed + -- This tag is before parameterising KeySpace and GenEnv over some (Crypto c) + -- tag: a0d93ad3134a8c5fe04ddaacffdaf39e1af8b8cf + tag: e3fa55fccd30ff6c048764a447368f23d809487e + --sha256: sha256-qaoVERbGDGqMMuY1b90GQ31F5QxrgE1u04TEMRSMX4I= + subdir: + eras/allegra/impl + eras/alonzo/impl + eras/alonzo/test-suite + eras/babbage/impl + eras/babbage/test-suite + eras/byron/chain/executable-spec + eras/byron/crypto + eras/byron/crypto/test + eras/byron/ledger/executable-spec + eras/byron/ledger/impl + eras/byron/ledger/impl/test + eras/conway/impl + eras/conway/test-suite + eras/mary/impl + eras/shelley/impl + eras/shelley-ma/test-suite + eras/shelley/test-suite + libs/cardano-data + libs/cardano-ledger-api + libs/cardano-ledger-binary + libs/cardano-ledger-core + libs/cardano-ledger-test + libs/cardano-protocol-tpraos + libs/constrained-generators + libs/non-integral + libs/set-algebra + libs/small-steps + libs/vector-map + +source-repository-package + type: git + location: https://github.com/IntersectMBO/plutus + tag: be9ccfc7f8ecc6ebc577dcf3374a30530ecdb168 + --sha256: sha256-R7t5Luc1d9l2tXKg5Jgqye+vQAEONwCrQ9/JDkFCu9M= + subdir: + plutus-core + plutus-ledger-api + plutus-tx diff --git a/flake.lock b/flake.lock index cdc8fcf909..586077f79a 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1738671556, - "narHash": "sha256-RoJdQz2PjJsla4zQVKiYvFCdVX8MiuQHCF2/CkZ/7nM=", + "lastModified": 1740978676, + "narHash": "sha256-ElN3//HzDCZRe1R0zP9X4DKU3HT9P8+Pl+DsUdsQjL0=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "c3ed80d7784059fbe3c4c2b8a6810a566dd3678e", + "rev": "34a2c2217476cec0ac57d28f7759be57e2bf6b24", "type": "github" }, "original": { @@ -237,15 +237,16 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1733877006, - "narHash": "sha256-rNpSFS/ziUQBPgo6iAbKgU00yRpeCngv215TW0D+kCo=", + "lastModified": 1741047855, + "narHash": "sha256-maKGmHkR0jztEQcy1Ya6T66v9ZzmtqCDyANy3pWuIko=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "583f569545854160b6bc5606374bf5006a9f6929", + "rev": "c486dfef773c7ed0d983b2b9fbd54c2233317963", "type": "github" }, "original": { "owner": "input-output-hk", + "ref": "for-stackage", "repo": "hackage.nix", "type": "github" } diff --git a/flake.nix b/flake.nix index 4ee86740f6..948778cda4 100644 --- a/flake.nix +++ b/flake.nix @@ -16,7 +16,7 @@ inputs.hackage.follows = "hackageNix"; }; hackageNix = { - url = "github:input-output-hk/hackage.nix"; + url = "github:input-output-hk/hackage.nix?ref=for-stackage"; flake = false; }; CHaP = { diff --git a/ouroboros-consensus-cardano/CHANGELOG.md b/ouroboros-consensus-cardano/CHANGELOG.md index ef897d1754..486c141adf 100644 --- a/ouroboros-consensus-cardano/CHANGELOG.md +++ b/ouroboros-consensus-cardano/CHANGELOG.md @@ -2,6 +2,13 @@ # Changelog entries + +## 0.21.0.1 — 2025-02-10 + +### Patch + +- Bump to ouroboros-network-framework 0.16. + ## 0.21.0.0 — 2025-01-08 diff --git a/ouroboros-consensus-cardano/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md b/ouroboros-consensus-cardano/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md new file mode 100644 index 0000000000..bf4f4c4dfe --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md @@ -0,0 +1,4 @@ +### Non-Breaking + +- Add instances for `TxMeasureMetrics` to Cardano block types + diff --git a/ouroboros-consensus-cardano/changelog.d/20250214_122220_jasataco_sts.md b/ouroboros-consensus-cardano/changelog.d/20250214_122220_jasataco_sts.md new file mode 100644 index 0000000000..cb23392a7e --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20250214_122220_jasataco_sts.md @@ -0,0 +1,25 @@ + + + + + +### Breaking + +- Adapt to the change in block application and ticking interface in + Byron and Shelley. Block application and ticking now can choose + validation policy and enable or disable ledger events. +- Delete `GetProposedPParamsUpdates` query which is deprecated starting in Conway. diff --git a/ouroboros-consensus-cardano/changelog.d/20250304_140316_jasataco_release_10_3.md b/ouroboros-consensus-cardano/changelog.d/20250304_140316_jasataco_release_10_3.md new file mode 100644 index 0000000000..a893e03590 --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20250304_140316_jasataco_release_10_3.md @@ -0,0 +1,23 @@ + + + + + +### Breaking + +- Adapt to Ledger's Crypto monomorphization. Many types and fields have lost their `c/crypto` type variable as now `StandardCrypto` is used by the Ledger everywhere. +- Deprecate the `StandardX` type aliases. diff --git a/ouroboros-consensus-cardano/changelog.d/js-network-bump.md b/ouroboros-consensus-cardano/changelog.d/js-network-bump.md deleted file mode 100644 index 4e87265afd..0000000000 --- a/ouroboros-consensus-cardano/changelog.d/js-network-bump.md +++ /dev/null @@ -1,3 +0,0 @@ -### Patch - -- Bump to ouroboros-network-framework 0.16. diff --git a/ouroboros-consensus-cardano/changelog.d/js-ntc20.md b/ouroboros-consensus-cardano/changelog.d/js-ntc20.md new file mode 100644 index 0000000000..db1064d1ae --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/js-ntc20.md @@ -0,0 +1,4 @@ +### Breaking + +* Use new `NodeToClientV_20`. +* Expose new query `QueryStakePoolDefaultVote` in new `ShelleyNodeToClientVersion12`. diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion2/ByronNodeToClientVersion1/LedgerConfig b/ouroboros-consensus-cardano/golden/byron/QueryVersion2/ByronNodeToClientVersion1/LedgerConfig new file mode 100644 index 0000000000..8279e0491b Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion2/ByronNodeToClientVersion1/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/ApplyTxErr b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/ApplyTxErr new file mode 100644 index 0000000000..1dc2b409ca Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/ApplyTxErr differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Block_EBB b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Block_EBB new file mode 100644 index 0000000000..d2bc47fdf7 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Block_EBB differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Block_regular b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Block_regular new file mode 100644 index 0000000000..ce89fa545b Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Block_regular differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/GenTx b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/GenTx new file mode 100644 index 0000000000..b5ae90f09a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/GenTx differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/GenTxId b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/GenTxId new file mode 100644 index 0000000000..9511ba87ee Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/GenTxId differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/LedgerConfig b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/LedgerConfig new file mode 100644 index 0000000000..8279e0491b Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Query b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Query new file mode 100644 index 0000000000..f76dd238ad Binary files /dev/null and b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/Query differ diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SerialisedBlock_EBB b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SerialisedBlock_EBB new file mode 100644 index 0000000000..c7fbc027a3 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SerialisedBlock_EBB @@ -0,0 +1 @@ +�E \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SerialisedBlock_regular b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SerialisedBlock_regular new file mode 100644 index 0000000000..558b48dd80 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SerialisedBlock_regular @@ -0,0 +1 @@ +�G \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SlotNo b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SlotNo new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/byron/QueryVersion3/ByronNodeToClientVersion1/SlotNo @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Allegra index 018b7bc479..df2444bf34 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Allegra and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Alonzo index d9c76ed708..4637c62e4d 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Alonzo and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Babbage index dcabd6d274..736de5a8ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Babbage and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Mary index f0ab5dd881..b22d0e75ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Mary and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Shelley index 15bf711ff0..ed31f2848b 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Shelley and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/ApplyTxErr_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/LedgerConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/LedgerConfig new file mode 100644 index 0000000000..bb0583694a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Allegra_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Allegra_GetProposedPParamsUpdates deleted file mode 100644 index e85ed2037e..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Allegra_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Alonzo_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Alonzo_GetProposedPParamsUpdates deleted file mode 100644 index 3e58e98cc2..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Alonzo_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Babbage_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Babbage_GetProposedPParamsUpdates deleted file mode 100644 index 62efc1c1ea..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Babbage_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Conway_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Conway_GetProposedPParamsUpdates deleted file mode 100644 index 38afb22354..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Conway_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Mary_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Mary_GetProposedPParamsUpdates deleted file mode 100644 index b833d91e65..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Mary_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Shelley_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Shelley_GetProposedPParamsUpdates deleted file mode 100644 index 8fe4019886..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Query_Shelley_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Allegra_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Allegra_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Allegra_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Alonzo_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Alonzo_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Alonzo_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Babbage_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Babbage_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Babbage_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Conway_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Conway_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Conway_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Mary_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Mary_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Mary_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Shelley_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Shelley_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion12/Result_Shelley_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Allegra index 018b7bc479..df2444bf34 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Allegra and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Alonzo index d9c76ed708..4637c62e4d 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Alonzo and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Babbage index dcabd6d274..736de5a8ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Babbage and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Mary index f0ab5dd881..b22d0e75ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Mary and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Shelley index 15bf711ff0..ed31f2848b 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Shelley and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/ApplyTxErr_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/LedgerConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/LedgerConfig new file mode 100644 index 0000000000..bb0583694a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Allegra_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Allegra_GetProposedPParamsUpdates deleted file mode 100644 index e85ed2037e..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Allegra_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Alonzo_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Alonzo_GetProposedPParamsUpdates deleted file mode 100644 index 3e58e98cc2..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Alonzo_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Babbage_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Babbage_GetProposedPParamsUpdates deleted file mode 100644 index 62efc1c1ea..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Babbage_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Conway_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Conway_GetProposedPParamsUpdates deleted file mode 100644 index 38afb22354..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Conway_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Mary_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Mary_GetProposedPParamsUpdates deleted file mode 100644 index b833d91e65..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Mary_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Shelley_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Shelley_GetProposedPParamsUpdates deleted file mode 100644 index 8fe4019886..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Query_Shelley_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Allegra_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Allegra_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Allegra_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Alonzo_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Alonzo_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Alonzo_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Babbage_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Babbage_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Babbage_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Conway_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Conway_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Conway_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Mary_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Mary_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Mary_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Shelley_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Shelley_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion13/Result_Shelley_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Allegra index 018b7bc479..df2444bf34 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Allegra and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Alonzo index d9c76ed708..4637c62e4d 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Alonzo and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Babbage index dcabd6d274..736de5a8ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Babbage and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Mary index f0ab5dd881..b22d0e75ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Mary and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Shelley index 15bf711ff0..ed31f2848b 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Shelley and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/ApplyTxErr_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/LedgerConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/LedgerConfig new file mode 100644 index 0000000000..bb0583694a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Allegra_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Allegra_GetProposedPParamsUpdates deleted file mode 100644 index e85ed2037e..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Allegra_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Alonzo_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Alonzo_GetProposedPParamsUpdates deleted file mode 100644 index 3e58e98cc2..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Alonzo_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Babbage_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Babbage_GetProposedPParamsUpdates deleted file mode 100644 index 62efc1c1ea..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Babbage_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Conway_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Conway_GetProposedPParamsUpdates deleted file mode 100644 index 38afb22354..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Conway_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Mary_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Mary_GetProposedPParamsUpdates deleted file mode 100644 index b833d91e65..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Mary_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Shelley_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Shelley_GetProposedPParamsUpdates deleted file mode 100644 index 8fe4019886..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Query_Shelley_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Allegra_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Allegra_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Allegra_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Alonzo_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Alonzo_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Alonzo_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Babbage_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Babbage_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Babbage_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Conway_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Conway_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Conway_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Mary_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Mary_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Mary_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Shelley_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Shelley_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion14/Result_Shelley_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Allegra index 018b7bc479..df2444bf34 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Allegra and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Alonzo index d9c76ed708..4637c62e4d 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Alonzo and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Babbage index dcabd6d274..736de5a8ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Babbage and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Mary index f0ab5dd881..b22d0e75ef 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Mary and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Shelley index 15bf711ff0..ed31f2848b 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Shelley and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/ApplyTxErr_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/LedgerConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/LedgerConfig new file mode 100644 index 0000000000..bb0583694a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Allegra_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Allegra_GetProposedPParamsUpdates deleted file mode 100644 index e85ed2037e..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Allegra_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Alonzo_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Alonzo_GetProposedPParamsUpdates deleted file mode 100644 index 3e58e98cc2..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Alonzo_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Babbage_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Babbage_GetProposedPParamsUpdates deleted file mode 100644 index 62efc1c1ea..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Babbage_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Conway_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Conway_GetProposedPParamsUpdates deleted file mode 100644 index 38afb22354..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Conway_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Mary_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Mary_GetProposedPParamsUpdates deleted file mode 100644 index b833d91e65..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Mary_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Shelley_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Shelley_GetProposedPParamsUpdates deleted file mode 100644 index 8fe4019886..0000000000 Binary files a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Query_Shelley_GetProposedPParamsUpdates and /dev/null differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Allegra_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Allegra_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Allegra_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Alonzo_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Alonzo_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Alonzo_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Babbage_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Babbage_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Babbage_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Conway_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Conway_ProposedPParamsUpdates deleted file mode 100644 index 4080e95c54..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Conway_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Mary_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Mary_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Mary_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Shelley_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Shelley_ProposedPParamsUpdates deleted file mode 100644 index 4918531195..0000000000 --- a/ouroboros-consensus-cardano/golden/cardano/QueryVersion2/CardanoNodeToClientVersion15/Result_Shelley_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -��X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Allegra new file mode 100644 index 0000000000..df2444bf34 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Alonzo new file mode 100644 index 0000000000..4637c62e4d Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Babbage new file mode 100644 index 0000000000..736de5a8ef Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Byron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Byron new file mode 100644 index 0000000000..1728309622 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Byron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Conway b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Conway new file mode 100644 index 0000000000..7e36ce4445 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Conway @@ -0,0 +1 @@ +�������X�1���s��]k?�ժ�P�[{%A \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Mary new file mode 100644 index 0000000000..b22d0e75ef Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Shelley new file mode 100644 index 0000000000..ed31f2848b Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_WrongEraByron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_WrongEraByron new file mode 100644 index 0000000000..9735c28d23 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_WrongEraByron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_WrongEraShelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_WrongEraShelley new file mode 100644 index 0000000000..43f2fa8267 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/ApplyTxErr_WrongEraShelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Allegra new file mode 100644 index 0000000000..b525fa7868 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Alonzo new file mode 100644 index 0000000000..dc3903d3a6 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Babbage new file mode 100644 index 0000000000..279d590c81 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Byron_EBB b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Byron_EBB new file mode 100644 index 0000000000..d2bc47fdf7 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Byron_EBB differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Byron_regular b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Byron_regular new file mode 100644 index 0000000000..ce89fa545b Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Byron_regular differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Conway b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Conway new file mode 100644 index 0000000000..5ae5c5065d Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Conway differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Mary new file mode 100644 index 0000000000..14d8281f93 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Shelley new file mode 100644 index 0000000000..7d900c96a8 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Block_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Allegra new file mode 100644 index 0000000000..61ec98ae96 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Allegra @@ -0,0 +1,3 @@ +�X cA:^D ��d� +�u�S�|��� ]� +q� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Alonzo new file mode 100644 index 0000000000..6e6d3158a7 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Alonzo @@ -0,0 +1 @@ +�X ��3�? �G�Ca�\�ո��1�%E�g# diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Babbage new file mode 100644 index 0000000000..3c56b72b00 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Babbage @@ -0,0 +1 @@ +�X M~@)_ur7��WH5���O�2��$�h��� h \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Byron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Byron new file mode 100644 index 0000000000..a07d334baa Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Byron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Conway b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Conway new file mode 100644 index 0000000000..8f2268ce3f --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Conway @@ -0,0 +1 @@ +�X �K�8�aL�s��,��а�^�����"��5�J \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Mary new file mode 100644 index 0000000000..1235567289 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Mary @@ -0,0 +1 @@ +�X �Ճ(x��.��x�_G��F��ߖ} Ԉh+ ޢ \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Shelley new file mode 100644 index 0000000000..667dbef8ea --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTxId_Shelley @@ -0,0 +1 @@ +�X ���np��+�t���3N��Ue�<Ҷ���=� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Allegra new file mode 100644 index 0000000000..786e482302 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Alonzo new file mode 100644 index 0000000000..558dfbcca8 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Babbage new file mode 100644 index 0000000000..0be195e3f1 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Byron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Byron new file mode 100644 index 0000000000..9c10e1bb39 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Byron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Conway b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Conway new file mode 100644 index 0000000000..9d1ce51c81 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Conway differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Mary new file mode 100644 index 0000000000..1d7d61fa77 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Shelley new file mode 100644 index 0000000000..d41c1aacc8 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/GenTx_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/LedgerConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/LedgerConfig new file mode 100644 index 0000000000..bb0583694a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..bc0aee634c Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetBigLedgerPeerSnapshot differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetCurrentPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetCurrentPParams new file mode 100644 index 0000000000..4d12a7ad6b Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetCurrentPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetEpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetEpochNo new file mode 100644 index 0000000000..1d07267558 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetEpochNo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetGenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetGenesisConfig new file mode 100644 index 0000000000..6741a401cb Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetGenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetLedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetLedgerTip new file mode 100644 index 0000000000..6706725ac7 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetLedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetNonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetNonMyopicMemberRewards new file mode 100644 index 0000000000..08c5c789e9 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetNonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetStakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetStakeDistribution new file mode 100644 index 0000000000..b5f799b270 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Allegra_GetStakeDistribution differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..7312d4e726 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetBigLedgerPeerSnapshot differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetCurrentPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetCurrentPParams new file mode 100644 index 0000000000..046b306d4d Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetCurrentPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetEpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetEpochNo new file mode 100644 index 0000000000..a6f766751b Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetEpochNo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetGenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetGenesisConfig new file mode 100644 index 0000000000..f701524d73 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetGenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetLedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetLedgerTip new file mode 100644 index 0000000000..d9a18e85a2 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetLedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetNonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetNonMyopicMemberRewards new file mode 100644 index 0000000000..58e70d849d Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetNonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetStakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetStakeDistribution new file mode 100644 index 0000000000..e5308b275a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Alonzo_GetStakeDistribution differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_AnytimeByron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_AnytimeByron new file mode 100644 index 0000000000..6fd42d6043 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_AnytimeByron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_AnytimeShelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_AnytimeShelley new file mode 100644 index 0000000000..d82b9fc7f4 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_AnytimeShelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetCurrentPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetCurrentPParams new file mode 100644 index 0000000000..cd6d53bc79 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetCurrentPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetEpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetEpochNo new file mode 100644 index 0000000000..f5ea7bd085 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetEpochNo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetGenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetGenesisConfig new file mode 100644 index 0000000000..e6ee8c45c4 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetGenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetLedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetLedgerTip new file mode 100644 index 0000000000..4d00b4e9fa Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetLedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetNonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetNonMyopicMemberRewards new file mode 100644 index 0000000000..b5217dc67a Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetNonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetStakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetStakeDistribution new file mode 100644 index 0000000000..41aeabd30d Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Babbage_GetStakeDistribution differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Byron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Byron new file mode 100644 index 0000000000..cfa4236d51 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Byron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetCurrentPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetCurrentPParams new file mode 100644 index 0000000000..05f2ba9773 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetCurrentPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetEpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetEpochNo new file mode 100644 index 0000000000..915b078647 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetEpochNo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetGenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetGenesisConfig new file mode 100644 index 0000000000..70189500e9 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetGenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetLedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetLedgerTip new file mode 100644 index 0000000000..7337b0de4e Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetLedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetNonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetNonMyopicMemberRewards new file mode 100644 index 0000000000..b47684f4c3 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetNonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetStakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetStakeDistribution new file mode 100644 index 0000000000..89ed187e31 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Conway_GetStakeDistribution differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_HardFork b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_HardFork new file mode 100644 index 0000000000..64c266fdc5 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_HardFork differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..b3f0d169c0 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetBigLedgerPeerSnapshot differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetCurrentPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetCurrentPParams new file mode 100644 index 0000000000..7338cd7416 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetCurrentPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetEpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetEpochNo new file mode 100644 index 0000000000..58e4767132 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetEpochNo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetGenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetGenesisConfig new file mode 100644 index 0000000000..2306eb025e Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetGenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetLedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetLedgerTip new file mode 100644 index 0000000000..c5b7ef0497 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetLedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetNonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetNonMyopicMemberRewards new file mode 100644 index 0000000000..72f3ff8f93 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetNonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetStakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetStakeDistribution new file mode 100644 index 0000000000..e63d41b76d Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Mary_GetStakeDistribution differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..95d62a50fd Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetBigLedgerPeerSnapshot differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetCurrentPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetCurrentPParams new file mode 100644 index 0000000000..cafc5b7290 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetCurrentPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetEpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetEpochNo new file mode 100644 index 0000000000..112bec95a3 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetEpochNo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetGenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetGenesisConfig new file mode 100644 index 0000000000..bca99cf254 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetGenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetLedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetLedgerTip new file mode 100644 index 0000000000..33dba00f05 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetLedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetNonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetNonMyopicMemberRewards new file mode 100644 index 0000000000..57e64f50fb Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetNonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetStakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetStakeDistribution new file mode 100644 index 0000000000..8d50b1f974 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Query_Shelley_GetStakeDistribution differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_EmptyPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_EmptyPParams new file mode 100644 index 0000000000..231cb35567 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_EmptyPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_EpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_EpochNo new file mode 100644 index 0000000000..b180370379 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_EpochNo @@ -0,0 +1 @@ +� diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_GenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_GenesisConfig new file mode 100644 index 0000000000..10a12c2526 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_GenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..2c6a1843ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_GetBigLedgerPeerSnapshot @@ -0,0 +1,3 @@ +����*��� +�� +��ҟ��� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_LedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_LedgerTip new file mode 100644 index 0000000000..e64ffada5d --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_LedgerTip @@ -0,0 +1 @@ +�� X �B!��)k�8� Pl��"����5����^ \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_NonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_NonMyopicMemberRewards new file mode 100644 index 0000000000..c47618c170 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_NonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_StakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_StakeDistribution new file mode 100644 index 0000000000..968f15663d --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Allegra_StakeDistribution @@ -0,0 +1 @@ +��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>Žb�{L \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_EmptyPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_EmptyPParams new file mode 100644 index 0000000000..9e750e2688 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_EmptyPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_EpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_EpochNo new file mode 100644 index 0000000000..b180370379 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_EpochNo @@ -0,0 +1 @@ +� diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_GenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_GenesisConfig new file mode 100644 index 0000000000..10a12c2526 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_GenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..2c6a1843ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_GetBigLedgerPeerSnapshot @@ -0,0 +1,3 @@ +����*��� +�� +��ҟ��� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_LedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_LedgerTip new file mode 100644 index 0000000000..a8d3ebca89 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_LedgerTip @@ -0,0 +1 @@ +�� X ����8����o�fo&&���&n�s�s$&� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_NonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_NonMyopicMemberRewards new file mode 100644 index 0000000000..c47618c170 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_NonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_StakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_StakeDistribution new file mode 100644 index 0000000000..968f15663d --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Alonzo_StakeDistribution @@ -0,0 +1 @@ +��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>Žb�{L \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_AnytimeByron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_AnytimeByron new file mode 100644 index 0000000000..070897ad04 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_AnytimeByron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_AnytimeShelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_AnytimeShelley new file mode 100644 index 0000000000..61dee1376e Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_AnytimeShelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_EmptyPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_EmptyPParams new file mode 100644 index 0000000000..edc6f11887 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_EmptyPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_EpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_EpochNo new file mode 100644 index 0000000000..b180370379 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_EpochNo @@ -0,0 +1 @@ +� diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_GenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_GenesisConfig new file mode 100644 index 0000000000..10a12c2526 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_GenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_LedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_LedgerTip new file mode 100644 index 0000000000..c36241968e Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_LedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_NonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_NonMyopicMemberRewards new file mode 100644 index 0000000000..c47618c170 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_NonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_StakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_StakeDistribution new file mode 100644 index 0000000000..968f15663d --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Babbage_StakeDistribution @@ -0,0 +1 @@ +��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>Žb�{L \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Byron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Byron new file mode 100644 index 0000000000..d66107b64e Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Byron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_EmptyPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_EmptyPParams new file mode 100644 index 0000000000..04416edc30 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_EmptyPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_EpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_EpochNo new file mode 100644 index 0000000000..b180370379 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_EpochNo @@ -0,0 +1 @@ +� diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_GenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_GenesisConfig new file mode 100644 index 0000000000..10a12c2526 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_GenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_LedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_LedgerTip new file mode 100644 index 0000000000..2eeba1fbba --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_LedgerTip @@ -0,0 +1 @@ +�� X �M����7!SY�ǭ���dG��f�p�;���� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_NonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_NonMyopicMemberRewards new file mode 100644 index 0000000000..c47618c170 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_NonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_StakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_StakeDistribution new file mode 100644 index 0000000000..967baf0b47 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Conway_StakeDistribution @@ -0,0 +1 @@ +��X�1���s��]k?�ժ�P�[{%A���X �����-�ò^46���R�>Žb�{L \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_EraMismatchByron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_EraMismatchByron new file mode 100644 index 0000000000..9735c28d23 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_EraMismatchByron differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_EraMismatchShelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_EraMismatchShelley new file mode 100644 index 0000000000..43f2fa8267 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_EraMismatchShelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_HardFork b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_HardFork new file mode 100644 index 0000000000..84885abaa8 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_HardFork differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_EmptyPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_EmptyPParams new file mode 100644 index 0000000000..0240c52f6f Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_EmptyPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_EpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_EpochNo new file mode 100644 index 0000000000..b180370379 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_EpochNo @@ -0,0 +1 @@ +� diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_GenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_GenesisConfig new file mode 100644 index 0000000000..10a12c2526 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_GenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..2c6a1843ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_GetBigLedgerPeerSnapshot @@ -0,0 +1,3 @@ +����*��� +�� +��ҟ��� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_LedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_LedgerTip new file mode 100644 index 0000000000..6ec12660a7 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_LedgerTip @@ -0,0 +1 @@ +�� X ��E<���p���2W@Y��rJt=&��v��j \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_NonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_NonMyopicMemberRewards new file mode 100644 index 0000000000..c47618c170 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_NonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_StakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_StakeDistribution new file mode 100644 index 0000000000..968f15663d --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Mary_StakeDistribution @@ -0,0 +1 @@ +��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>Žb�{L \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_EmptyPParams b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_EmptyPParams new file mode 100644 index 0000000000..b792678e2e Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_EmptyPParams differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_EpochNo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_EpochNo new file mode 100644 index 0000000000..b180370379 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_EpochNo @@ -0,0 +1 @@ +� diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_GenesisConfig b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_GenesisConfig new file mode 100644 index 0000000000..10a12c2526 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_GenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..2c6a1843ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_GetBigLedgerPeerSnapshot @@ -0,0 +1,3 @@ +����*��� +�� +��ҟ��� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_LedgerTip b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_LedgerTip new file mode 100644 index 0000000000..32d3f65a35 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_LedgerTip @@ -0,0 +1 @@ +�� X ��� u��'9Ki�(�׺y���C����)�l \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_NonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_NonMyopicMemberRewards new file mode 100644 index 0000000000..c47618c170 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_NonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_StakeDistribution b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_StakeDistribution new file mode 100644 index 0000000000..968f15663d --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/Result_Shelley_StakeDistribution @@ -0,0 +1 @@ +��X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>Žb�{L \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Allegra new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Allegra @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Alonzo new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Alonzo @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Babbage new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Babbage @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Byron_EBB b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Byron_EBB new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Byron_EBB @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Byron_regular b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Byron_regular new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Byron_regular @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Conway b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Conway new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Conway @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Mary new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Mary @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Shelley new file mode 100644 index 0000000000..6a5024d0dc --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SerialisedBlock_Shelley @@ -0,0 +1 @@ +�O \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Allegra b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Allegra new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Allegra @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Alonzo b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Alonzo new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Alonzo @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Babbage b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Babbage new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Babbage @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Byron b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Byron new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Byron @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Conway b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Conway new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Conway @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Mary b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Mary new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Mary @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Shelley b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Shelley new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/cardano/QueryVersion3/CardanoNodeToClientVersion16/SlotNo_Shelley @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Allegra b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Allegra index 5e1e93ee16..4ad881b9b3 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Allegra and b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Alonzo b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Alonzo index 9b3b8222d2..666a38e853 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Alonzo and b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Babbage b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Babbage index 6c112a7bdf..8645e32b1c 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Babbage and b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Conway b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Conway index 25ee104e81..b3c8d72ecd 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Conway and b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Conway differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Mary b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Mary index 9299407584..e203d27144 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Mary and b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Shelley b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Shelley index 11e3467145..ea839ed0df 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Shelley and b/ouroboros-consensus-cardano/golden/cardano/disk/ExtLedgerState_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Allegra b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Allegra index 144b068fcf..9e759bf391 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Allegra and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Allegra differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Alonzo b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Alonzo index 48ed5a3479..a368a7aab1 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Alonzo and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Babbage b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Babbage index 9e6ab5a053..37170e63d7 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Babbage and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Conway b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Conway index 5960577b8c..65026a404d 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Conway and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Conway differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Mary b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Mary index a1a8d8fe2b..2ee0a1f194 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Mary and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Mary differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Shelley b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Shelley index f313d047f6..39ebba7d15 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Shelley and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerState_Shelley differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/ApplyTxErr b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/ApplyTxErr index 7fcb1ef707..44847dcf07 100644 Binary files a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/ApplyTxErr and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/ApplyTxErr differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/LedgerConfig b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/LedgerConfig new file mode 100644 index 0000000000..df7a5f07b1 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/Query_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/Query_GetProposedPParamsUpdates deleted file mode 100644 index e8a0edfbbb..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/Query_GetProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/Result_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/Result_ProposedPParamsUpdates deleted file mode 100644 index ff22aff4e6..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion10/Result_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -�X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/ApplyTxErr b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/ApplyTxErr index 7fcb1ef707..44847dcf07 100644 Binary files a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/ApplyTxErr and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/ApplyTxErr differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/LedgerConfig b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/LedgerConfig new file mode 100644 index 0000000000..df7a5f07b1 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/Query_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/Query_GetProposedPParamsUpdates deleted file mode 100644 index e8a0edfbbb..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/Query_GetProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/Result_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/Result_ProposedPParamsUpdates deleted file mode 100644 index ff22aff4e6..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion11/Result_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -�X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/ApplyTxErr b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/ApplyTxErr index 7fcb1ef707..44847dcf07 100644 Binary files a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/ApplyTxErr and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/ApplyTxErr differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/LedgerConfig b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/LedgerConfig new file mode 100644 index 0000000000..df7a5f07b1 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/Query_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/Query_GetProposedPParamsUpdates deleted file mode 100644 index e8a0edfbbb..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/Query_GetProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/Result_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/Result_ProposedPParamsUpdates deleted file mode 100644 index ff22aff4e6..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion8/Result_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -�X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/ApplyTxErr b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/ApplyTxErr index 7fcb1ef707..44847dcf07 100644 Binary files a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/ApplyTxErr and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/ApplyTxErr differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/LedgerConfig b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/LedgerConfig new file mode 100644 index 0000000000..df7a5f07b1 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/Query_GetProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/Query_GetProposedPParamsUpdates deleted file mode 100644 index e8a0edfbbb..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/Query_GetProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/Result_ProposedPParamsUpdates b/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/Result_ProposedPParamsUpdates deleted file mode 100644 index ff22aff4e6..0000000000 --- a/ouroboros-consensus-cardano/golden/shelley/QueryVersion2/ShelleyNodeToClientVersion9/Result_ProposedPParamsUpdates +++ /dev/null @@ -1 +0,0 @@ -�X ��ts.���?9Z�E����P#�� 2�d \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/ApplyTxErr b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/ApplyTxErr new file mode 100644 index 0000000000..44847dcf07 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/ApplyTxErr differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Block b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Block new file mode 100644 index 0000000000..f49d79d20f Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Block differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/GenTx b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/GenTx new file mode 100644 index 0000000000..ddad98bf82 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/GenTx differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/GenTxId b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/GenTxId new file mode 100644 index 0000000000..b26e394526 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/GenTxId @@ -0,0 +1 @@ +X ���np��+�t���3N��Ue�<Ҷ���=� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/LedgerConfig b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/LedgerConfig new file mode 100644 index 0000000000..df7a5f07b1 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/LedgerConfig differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..1799efd138 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetBigLedgerPeerSnapshot @@ -0,0 +1 @@ +�" \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetCurrentPParams b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetCurrentPParams new file mode 100644 index 0000000000..f05c5a13e1 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetCurrentPParams @@ -0,0 +1 @@ +� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetEpochNo b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetEpochNo new file mode 100644 index 0000000000..17bb347215 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetEpochNo @@ -0,0 +1 @@ +� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetGenesisConfig b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetGenesisConfig new file mode 100644 index 0000000000..b9eb323e65 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetGenesisConfig @@ -0,0 +1 @@ +� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetLedgerTip b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetLedgerTip new file mode 100644 index 0000000000..8b040ead36 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetLedgerTip differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetNonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetNonMyopicMemberRewards new file mode 100644 index 0000000000..2963a50540 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetNonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetStakeDistribution b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetStakeDistribution new file mode 100644 index 0000000000..34008b6588 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Query_GetStakeDistribution @@ -0,0 +1 @@ +� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_EmptyPParams b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_EmptyPParams new file mode 100644 index 0000000000..e09e9163f6 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_EmptyPParams differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_EpochNo b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_EpochNo new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_EpochNo @@ -0,0 +1 @@ + diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_GenesisConfig b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_GenesisConfig new file mode 100644 index 0000000000..2b8afb63eb Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_GenesisConfig differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_GetBigLedgerPeerSnapshot b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_GetBigLedgerPeerSnapshot new file mode 100644 index 0000000000..9fdbcecb87 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_GetBigLedgerPeerSnapshot @@ -0,0 +1,3 @@ +���*��� +�� +��ҟ��� \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_LedgerTip b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_LedgerTip new file mode 100644 index 0000000000..622a58e349 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_LedgerTip @@ -0,0 +1 @@ +� X ��� u��'9Ki�(�׺y���C����)�l \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_NonMyopicMemberRewards b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_NonMyopicMemberRewards new file mode 100644 index 0000000000..0cb4c8c211 Binary files /dev/null and b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_NonMyopicMemberRewards differ diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_StakeDistribution b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_StakeDistribution new file mode 100644 index 0000000000..12f9add46f --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/Result_StakeDistribution @@ -0,0 +1 @@ +�X�1���s��]k?�ժ�P�[{%A��X �����-�ò^46���R�>Žb�{L \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/SerialisedBlock b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/SerialisedBlock new file mode 100644 index 0000000000..558b48dd80 --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/SerialisedBlock @@ -0,0 +1 @@ +�G \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/SlotNo b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/SlotNo new file mode 100644 index 0000000000..d9ba7315ac --- /dev/null +++ b/ouroboros-consensus-cardano/golden/shelley/QueryVersion3/ShelleyNodeToClientVersion12/SlotNo @@ -0,0 +1 @@ +* \ No newline at end of file diff --git a/ouroboros-consensus-cardano/golden/shelley/disk/ExtLedgerState b/ouroboros-consensus-cardano/golden/shelley/disk/ExtLedgerState index 958e4b0f9d..fa42962234 100644 Binary files a/ouroboros-consensus-cardano/golden/shelley/disk/ExtLedgerState and b/ouroboros-consensus-cardano/golden/shelley/disk/ExtLedgerState differ diff --git a/ouroboros-consensus-cardano/golden/shelley/disk/LedgerState b/ouroboros-consensus-cardano/golden/shelley/disk/LedgerState index 1f49b6d718..745073544d 100644 Binary files a/ouroboros-consensus-cardano/golden/shelley/disk/LedgerState and b/ouroboros-consensus-cardano/golden/shelley/disk/LedgerState differ diff --git a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal index 4bcdff0c4e..10423e09bb 100644 --- a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal +++ b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ouroboros-consensus-cardano -version: 0.21.0.0 +version: 0.21.0.1 synopsis: The instantation of the Ouroboros consensus layer used by Cardano @@ -129,25 +129,25 @@ library bytestring >=0.10 && <0.13, cardano-binary, cardano-crypto, - cardano-crypto-class, + cardano-crypto-class ^>=2.2, cardano-crypto-wrapper, - cardano-ledger-allegra ^>=1.6, - cardano-ledger-alonzo ^>=1.12, - cardano-ledger-api ^>=1.10, - cardano-ledger-babbage ^>=1.10, - cardano-ledger-binary ^>=1.5, - cardano-ledger-byron ^>=1.0.1, - cardano-ledger-conway ^>=1.18, - cardano-ledger-core ^>=1.16, - cardano-ledger-mary ^>=1.7, - cardano-ledger-shelley ^>=1.15, + cardano-ledger-allegra ^>=1.7, + cardano-ledger-alonzo ^>=1.13, + cardano-ledger-api ^>=1.11, + cardano-ledger-babbage ^>=1.11, + cardano-ledger-binary ^>=1.6, + cardano-ledger-byron ^>=1.1, + cardano-ledger-conway ^>=1.19, + cardano-ledger-core ^>=1.17, + cardano-ledger-mary ^>=1.8, + cardano-ledger-shelley ^>=1.16, cardano-prelude, - cardano-protocol-tpraos ^>=1.3, + cardano-protocol-tpraos ^>=1.4, cardano-slotting, cardano-strict-containers, cborg ^>=0.2.2, containers >=0.5 && <0.8, - cryptonite >=0.25 && <0.31, + crypton, deepseq, formatting >=6.3 && <7.3, measures, @@ -156,7 +156,7 @@ library nothunks, ouroboros-consensus ^>=0.22, ouroboros-consensus-protocol ^>=0.10, - ouroboros-network-api ^>=0.12, + ouroboros-network-api ^>=0.13, serialise ^>=0.2, small-steps, sop-core ^>=0.5, @@ -192,6 +192,7 @@ library unstable-byronspec bimap >=0.4 && <0.6, byron-spec-chain, byron-spec-ledger, + cardano-binary, cardano-ledger-binary, cardano-ledger-byron-test, cborg >=0.2.2 && <0.3, @@ -222,14 +223,18 @@ library unstable-byron-testlib build-depends: QuickCheck, base, + base64-bytestring, byron-spec-ledger, bytestring, + cardano-binary, + cardano-crypto, cardano-crypto-class, cardano-crypto-test, cardano-crypto-wrapper, cardano-ledger-binary:{cardano-ledger-binary, testlib}, cardano-ledger-byron, cardano-ledger-byron-test, + cardano-ledger-core, containers, hedgehog-quickcheck, mtl, @@ -238,6 +243,7 @@ library unstable-byron-testlib ouroboros-consensus-diffusion:unstable-diffusion-testlib, ouroboros-network-api, serialise, + text, unstable-byronspec, test-suite byron-test @@ -263,6 +269,7 @@ test-suite byron-test cardano-ledger-binary, cardano-ledger-byron, cardano-ledger-byron-test, + cardano-ledger-core, cardano-slotting:testlib, cborg, constraints, @@ -308,6 +315,7 @@ library unstable-shelley-testlib cardano-ledger-shelley-ma-test, cardano-ledger-shelley-test, cardano-protocol-tpraos:{cardano-protocol-tpraos, testlib}, + cardano-slotting, cardano-strict-containers, containers, generic-random, @@ -337,7 +345,6 @@ test-suite shelley-test QuickCheck, base, bytestring, - cardano-crypto-class, cardano-ledger-alonzo, cardano-ledger-alonzo-test, cardano-ledger-core, @@ -359,6 +366,7 @@ test-suite shelley-test tasty, tasty-hunit, tasty-quickcheck, + unstable-cardano-testlib, unstable-shelley-testlib, library unstable-cardano-testlib @@ -383,6 +391,7 @@ library unstable-cardano-testlib base, cardano-crypto-class, cardano-crypto-wrapper, + cardano-ledger-alonzo:testlib, cardano-ledger-alonzo-test, cardano-ledger-api, cardano-ledger-byron, @@ -430,7 +439,6 @@ test-suite cardano-test base, base16-bytestring, bytestring, - cardano-crypto-class, cardano-ledger-alonzo, cardano-ledger-alonzo-test, cardano-ledger-api, @@ -531,7 +539,7 @@ library unstable-cardano-tools cardano-ledger-mary, cardano-ledger-shelley, cardano-prelude, - cardano-protocol-tpraos ^>=1.3, + cardano-protocol-tpraos ^>=1.4, cardano-slotting, cardano-strict-containers, cborg ^>=0.2.2, @@ -549,12 +557,12 @@ library unstable-cardano-tools nothunks, ouroboros-consensus ^>=0.22, ouroboros-consensus-cardano, - ouroboros-consensus-diffusion ^>=0.19, + ouroboros-consensus-diffusion ^>=0.20, ouroboros-consensus-protocol:unstable-protocol-testlib, ouroboros-consensus-protocol ^>=0.10, ouroboros-network, ouroboros-network-api, - ouroboros-network-framework ^>=0.16, + ouroboros-network-framework ^>=0.17, ouroboros-network-protocols, resource-registry, serialise ^>=0.2, diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs index b73af04beb..a7afa6f75e 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -13,6 +14,7 @@ module Ouroboros.Consensus.Byron.ByronHFC ( , ByronPartialLedgerConfig (..) ) where +import Cardano.Binary import qualified Cardano.Chain.Common as CC import qualified Cardano.Chain.Genesis as CC.Genesis import qualified Cardano.Chain.Update as CC.Update @@ -33,6 +35,7 @@ import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common import Ouroboros.Consensus.HardFork.Simple import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Node.NetworkProtocolVersion +import Ouroboros.Consensus.Node.Serialisation import Ouroboros.Consensus.Protocol.PBFT (PBft, PBftCrypto) import Ouroboros.Consensus.Storage.Serialisation @@ -251,3 +254,16 @@ instance HasPartialLedgerConfig ByronBlock where type PartialLedgerConfig ByronBlock = ByronPartialLedgerConfig completeLedgerConfig _ _ = byronLedgerConfig + +instance SerialiseNodeToClient ByronBlock ByronPartialLedgerConfig where + encodeNodeToClient ccfg version (ByronPartialLedgerConfig lconfig triggerhf) + = mconcat [ + encodeListLen 2 + , toCBOR @(LedgerConfig ByronBlock) lconfig + , encodeNodeToClient ccfg version triggerhf + ] + decodeNodeToClient ccfg version = do + enforceSize "ByronPartialLedgerConfig" 2 + ByronPartialLedgerConfig + <$> fromCBOR @(LedgerConfig ByronBlock) + <*> decodeNodeToClient ccfg version diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Crypto/DSIGN.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Crypto/DSIGN.hs index 5fe214077a..bb8fe671dd 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Crypto/DSIGN.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Crypto/DSIGN.hs @@ -92,7 +92,7 @@ instance DSIGNAlgorithm ByronDSIGN where where seedBytes = case getBytesFromSeed 32 seed of Just (x,_) -> x - Nothing -> throw $ SeedBytesExhausted (-1) -- TODO We can't get the seed size! + Nothing -> throw $ SeedBytesExhausted (-1) (-1) -- TODO We can't get the seed size! deriveVerKeyDSIGN (SignKeyByronDSIGN sk) = VerKeyByronDSIGN $ toVerification sk diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Conversions.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Conversions.hs index 4e16aeccd9..e357968864 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Conversions.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Conversions.hs @@ -19,6 +19,7 @@ import qualified Cardano.Chain.Common as CC import qualified Cardano.Chain.Genesis as Genesis import qualified Cardano.Chain.Slotting as CC import qualified Cardano.Chain.Update as CC +import Cardano.Ledger.BaseTypes (nonZeroOr, unNonZero) import Data.Coerce import qualified Data.Set as Set import Numeric.Natural (Natural) @@ -39,7 +40,7 @@ fromByronBlockNo :: CC.ChainDifficulty -> BlockNo fromByronBlockNo = coerce fromByronBlockCount :: CC.BlockCount -> SecurityParam -fromByronBlockCount (CC.BlockCount k) = SecurityParam k +fromByronBlockCount (CC.BlockCount k) = SecurityParam $ nonZeroOr k $ error "Zero found while trying to construct a NonZero" fromByronEpochSlots :: CC.EpochSlots -> EpochSize fromByronEpochSlots (CC.EpochSlots n) = EpochSize n @@ -56,7 +57,7 @@ toByronSlotNo :: SlotNo -> CC.SlotNumber toByronSlotNo = coerce toByronBlockCount :: SecurityParam -> CC.BlockCount -toByronBlockCount (SecurityParam k) = CC.BlockCount k +toByronBlockCount (SecurityParam k) = CC.BlockCount $ unNonZero k toByronSlotLength :: SlotLength -> Natural toByronSlotLength = (fromIntegral :: Integer -> Natural) diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs index f455db7d44..9fcfabfce0 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs @@ -50,6 +50,7 @@ import qualified Cardano.Chain.Update.Validation.Endorsement as UPE import qualified Cardano.Chain.Update.Validation.Interface as UPI import qualified Cardano.Chain.UTxO as CC import qualified Cardano.Chain.ValidationMode as CC +import Cardano.Ledger.BaseTypes (unNonZero) import Cardano.Ledger.Binary (fromByronCBOR, toByronCBOR) import Cardano.Ledger.Binary.Plain (encodeListLen, enforceSize) import Codec.CBOR.Decoding (Decoder) @@ -59,6 +60,7 @@ import qualified Codec.CBOR.Encoding as CBOR import Codec.Serialise (decode, encode) import Control.Monad (replicateM) import Control.Monad.Except (Except, runExcept, throwError) +import qualified Control.State.Transition.Extended as STS import Data.ByteString (ByteString) import Data.Kind (Type) import Data.Map.Strict (Map) @@ -174,7 +176,7 @@ instance IsLedger (LedgerState ByronBlock) where type AuxLedgerEvent (LedgerState ByronBlock) = VoidLedgerEvent (LedgerState ByronBlock) - applyChainTickLedgerResult cfg slotNo ByronLedgerState{..} = pureLedgerResult $ + applyChainTickLedgerResult _ cfg slotNo ByronLedgerState{..} = pureLedgerResult $ TickedByronLedgerState { tickedByronLedgerState = CC.applyChainTick cfg (toByronSlotNo slotNo) byronLedgerState @@ -187,15 +189,10 @@ instance IsLedger (LedgerState ByronBlock) where -------------------------------------------------------------------------------} instance ApplyBlock (LedgerState ByronBlock) ByronBlock where - applyBlockLedgerResult = fmap pureLedgerResult ..: applyByronBlock validationMode - where - validationMode = CC.fromBlockValidationMode CC.BlockValidation - - reapplyBlockLedgerResult = - (pureLedgerResult . validationErrorImpossible) - ..: applyByronBlock validationMode - where - validationMode = CC.fromBlockValidationMode CC.NoBlockValidation + applyBlockLedgerResultWithValidation doValidation opts = + fmap pureLedgerResult ..: applyByronBlock doValidation opts + applyBlockLedgerResult = defaultApplyBlockLedgerResult + reapplyBlockLedgerResult = defaultReapplyBlockLedgerResult validationErrorImpossible data instance BlockQuery ByronBlock :: Type -> Type where GetUpdateInterfaceState :: BlockQuery ByronBlock UPI.State @@ -263,7 +260,7 @@ instance LedgerSupportsProtocol ByronBlock where , outsideForecastFor = for } where - SecurityParam k = genesisSecurityParam cfg + k = unNonZero $ maxRollbacks $ genesisSecurityParam cfg lastSlot = fromByronSlotNo $ CC.cvsLastSlot st at = NotOrigin lastSlot @@ -282,7 +279,7 @@ byronEraParams genesis = HardFork.EraParams { , eraGenesisWin = GenesisWindow (2 * k) } where - SecurityParam k = genesisSecurityParam genesis + k = unNonZero $ maxRollbacks $ genesisSecurityParam genesis -- | Separate variant of 'byronEraParams' to be used for a Byron-only chain. byronEraParamsNeverHardForks :: Gen.Config -> HardFork.EraParams @@ -309,12 +306,8 @@ instance HasHardForkHistory ByronBlock where -- the event it is given a 'BlockValidationMode' of 'BlockValidation', it still -- /looks/ like it can fail (since its type doesn't change based on the -- 'ValidationMode') and we must still treat it as such. -validationErrorImpossible :: forall err a. Except err a -> a -validationErrorImpossible = cantBeError . runExcept - where - cantBeError :: Either err a -> a - cantBeError (Left _) = error "validationErrorImpossible: unexpected error" - cantBeError (Right a) = a +validationErrorImpossible :: forall err a. err -> a +validationErrorImpossible _ = error "validationErrorImpossible: unexpected error" {------------------------------------------------------------------------------- Applying a block @@ -323,22 +316,30 @@ validationErrorImpossible = cantBeError . runExcept the right arguments, and maintain the snapshots. -------------------------------------------------------------------------------} -applyByronBlock :: CC.ValidationMode +applyByronBlock :: STS.ValidationPolicy + -> ComputeLedgerEvents -> LedgerConfig ByronBlock -> ByronBlock -> TickedLedgerState ByronBlock -> Except (LedgerError ByronBlock) (LedgerState ByronBlock) -applyByronBlock validationMode +applyByronBlock doValidation + _doEvents cfg blk@(ByronBlock raw _ (ByronHash blkHash)) ls = case raw of - CC.ABOBBlock raw' -> applyABlock validationMode cfg raw' blkHash blkNo ls - CC.ABOBBoundary raw' -> applyABoundaryBlock cfg raw' blkNo ls + CC.ABOBBlock raw' -> applyABlock byronOpts cfg raw' blkHash blkNo ls + CC.ABOBBoundary raw' -> applyABoundaryBlock cfg raw' blkNo ls where blkNo :: BlockNo blkNo = blockNo blk + byronOpts = + CC.fromBlockValidationMode $ case doValidation of + STS.ValidateAll -> CC.BlockValidation + STS.ValidateNone -> CC.NoBlockValidation + STS.ValidateSuchThat _ -> CC.BlockValidation + applyABlock :: CC.ValidationMode -> Gen.Config -> CC.ABlock ByteString diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node/Serialisation.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node/Serialisation.hs index eecb969b32..1b202ef999 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node/Serialisation.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node/Serialisation.hs @@ -12,6 +12,7 @@ module Ouroboros.Consensus.Byron.Node.Serialisation () where import qualified Cardano.Chain.Block as CC import qualified Cardano.Chain.Byron.API as CC +import Cardano.Chain.Genesis import Cardano.Ledger.Binary (fromByronCBOR, toByronCBOR) import Cardano.Ledger.Binary.Plain import qualified Codec.CBOR.Decoding as CBOR @@ -146,6 +147,10 @@ instance SerialiseNodeToNode ByronBlock (GenTxId ByronBlock) where instance SerialiseNodeToClientConstraints ByronBlock +instance SerialiseNodeToClient ByronBlock Config where + encodeNodeToClient _ _ = toCBOR + decodeNodeToClient _ _ = fromCBOR + -- | CBOR-in-CBOR for the annotation. This also makes it compatible with the -- wrapped ('Serialised') variant. instance SerialiseNodeToClient ByronBlock ByronBlock where diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Protocol.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Protocol.hs index 6c325ad77f..01d6a82bbd 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Protocol.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Protocol.hs @@ -14,6 +14,7 @@ import Control.Monad (guard) import Data.Set (Set) import qualified Data.Set as Set import Ouroboros.Consensus.Byron.Crypto.DSIGN +import Ouroboros.Consensus.Byron.Ledger.Orphans () import Ouroboros.Consensus.NodeId (CoreNodeId (..)) import Ouroboros.Consensus.Protocol.PBFT diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano.hs index f7cc3177da..70ec410d00 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano.hs @@ -35,10 +35,10 @@ import Ouroboros.Consensus.Shelley.ShelleyHFC type ProtocolByron = HardForkProtocol '[ ByronBlock ] type ProtocolCardano = HardForkProtocol '[ ByronBlock - , ShelleyBlock (TPraos StandardCrypto) StandardShelley - , ShelleyBlock (TPraos StandardCrypto) StandardAllegra - , ShelleyBlock (TPraos StandardCrypto) StandardMary - , ShelleyBlock (TPraos StandardCrypto) StandardAlonzo - , ShelleyBlock (Praos StandardCrypto) StandardBabbage - , ShelleyBlock (Praos StandardCrypto) StandardConway + , ShelleyBlock (TPraos StandardCrypto) ShelleyEra + , ShelleyBlock (TPraos StandardCrypto) AllegraEra + , ShelleyBlock (TPraos StandardCrypto) MaryEra + , ShelleyBlock (TPraos StandardCrypto) AlonzoEra + , ShelleyBlock (Praos StandardCrypto) BabbageEra + , ShelleyBlock (Praos StandardCrypto) ConwayEra ] diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs index ac41aafe2f..ac34704ceb 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs @@ -103,22 +103,22 @@ type CardanoEras c = ByronBlock ': CardanoShelleyEras c type CardanoShelleyEras :: Type -> [Type] type CardanoShelleyEras c = - '[ ShelleyBlock (TPraos c) (ShelleyEra c) - , ShelleyBlock (TPraos c) (AllegraEra c) - , ShelleyBlock (TPraos c) (MaryEra c) - , ShelleyBlock (TPraos c) (AlonzoEra c) - , ShelleyBlock (Praos c) (BabbageEra c) - , ShelleyBlock (Praos c) (ConwayEra c) + '[ ShelleyBlock (TPraos c) ShelleyEra + , ShelleyBlock (TPraos c) AllegraEra + , ShelleyBlock (TPraos c) MaryEra + , ShelleyBlock (TPraos c) AlonzoEra + , ShelleyBlock (Praos c) BabbageEra + , ShelleyBlock (Praos c) ConwayEra ] type ShelleyBasedLedgerEras :: Type -> [Type] type ShelleyBasedLedgerEras c = - '[ ShelleyEra c - , AllegraEra c - , MaryEra c - , AlonzoEra c - , BabbageEra c - , ConwayEra c + '[ ShelleyEra + , AllegraEra + , MaryEra + , AlonzoEra + , BabbageEra + , ConwayEra ] {------------------------------------------------------------------------------- @@ -129,12 +129,12 @@ type ShelleyBasedLedgerEras c = -- miscounted. pattern TagByron :: f ByronBlock -> NS f (CardanoEras c) -pattern TagShelley :: f (ShelleyBlock (TPraos c) (ShelleyEra c)) -> NS f (CardanoEras c) -pattern TagAllegra :: f (ShelleyBlock (TPraos c) (AllegraEra c)) -> NS f (CardanoEras c) -pattern TagMary :: f (ShelleyBlock (TPraos c) (MaryEra c)) -> NS f (CardanoEras c) -pattern TagAlonzo :: f (ShelleyBlock (TPraos c) (AlonzoEra c)) -> NS f (CardanoEras c) -pattern TagBabbage :: f (ShelleyBlock (Praos c) (BabbageEra c)) -> NS f (CardanoEras c) -pattern TagConway :: f (ShelleyBlock (Praos c) (ConwayEra c)) -> NS f (CardanoEras c) +pattern TagShelley :: f (ShelleyBlock (TPraos c) ShelleyEra) -> NS f (CardanoEras c) +pattern TagAllegra :: f (ShelleyBlock (TPraos c) AllegraEra) -> NS f (CardanoEras c) +pattern TagMary :: f (ShelleyBlock (TPraos c) MaryEra) -> NS f (CardanoEras c) +pattern TagAlonzo :: f (ShelleyBlock (TPraos c) AlonzoEra) -> NS f (CardanoEras c) +pattern TagBabbage :: f (ShelleyBlock (Praos c) BabbageEra) -> NS f (CardanoEras c) +pattern TagConway :: f (ShelleyBlock (Praos c) ConwayEra) -> NS f (CardanoEras c) pattern TagByron x = Z x pattern TagShelley x = S (Z x) @@ -155,47 +155,47 @@ pattern TeleByron :: pattern TeleShelley :: g ByronBlock - -> f (ShelleyBlock (TPraos c) (ShelleyEra c)) + -> f (ShelleyBlock (TPraos c) ShelleyEra) -> Telescope g f (CardanoEras c) pattern TeleAllegra :: g ByronBlock - -> g (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> f (ShelleyBlock (TPraos c) (AllegraEra c)) + -> g (ShelleyBlock (TPraos c) ShelleyEra) + -> f (ShelleyBlock (TPraos c) AllegraEra) -> Telescope g f (CardanoEras c) pattern TeleMary :: g ByronBlock - -> g (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> g (ShelleyBlock (TPraos c) (AllegraEra c)) - -> f (ShelleyBlock (TPraos c) (MaryEra c)) + -> g (ShelleyBlock (TPraos c) ShelleyEra) + -> g (ShelleyBlock (TPraos c) AllegraEra) + -> f (ShelleyBlock (TPraos c) MaryEra) -> Telescope g f (CardanoEras c) pattern TeleAlonzo :: g ByronBlock - -> g (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> g (ShelleyBlock (TPraos c) (AllegraEra c)) - -> g (ShelleyBlock (TPraos c) (MaryEra c)) - -> f (ShelleyBlock (TPraos c) (AlonzoEra c)) + -> g (ShelleyBlock (TPraos c) ShelleyEra) + -> g (ShelleyBlock (TPraos c) AllegraEra) + -> g (ShelleyBlock (TPraos c) MaryEra) + -> f (ShelleyBlock (TPraos c) AlonzoEra) -> Telescope g f (CardanoEras c) pattern TeleBabbage :: g ByronBlock - -> g (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> g (ShelleyBlock (TPraos c) (AllegraEra c)) - -> g (ShelleyBlock (TPraos c) (MaryEra c)) - -> g (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> f (ShelleyBlock (Praos c) (BabbageEra c)) + -> g (ShelleyBlock (TPraos c) ShelleyEra) + -> g (ShelleyBlock (TPraos c) AllegraEra) + -> g (ShelleyBlock (TPraos c) MaryEra) + -> g (ShelleyBlock (TPraos c) AlonzoEra) + -> f (ShelleyBlock (Praos c) BabbageEra) -> Telescope g f (CardanoEras c) pattern TeleConway :: g ByronBlock - -> g (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> g (ShelleyBlock (TPraos c) (AllegraEra c)) - -> g (ShelleyBlock (TPraos c) (MaryEra c)) - -> g (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> g (ShelleyBlock (Praos c) (BabbageEra c)) - -> f (ShelleyBlock (Praos c) (ConwayEra c)) + -> g (ShelleyBlock (TPraos c) ShelleyEra) + -> g (ShelleyBlock (TPraos c) AllegraEra) + -> g (ShelleyBlock (TPraos c) MaryEra) + -> g (ShelleyBlock (TPraos c) AlonzoEra) + -> g (ShelleyBlock (Praos c) BabbageEra) + -> f (ShelleyBlock (Praos c) ConwayEra) -> Telescope g f (CardanoEras c) -- Here we use layout and adjacency to make it obvious that we haven't @@ -230,22 +230,22 @@ type CardanoBlock c = HardForkBlock (CardanoEras c) pattern BlockByron :: ByronBlock -> CardanoBlock c pattern BlockByron b = HardForkBlock (OneEraBlock (TagByron (I b))) -pattern BlockShelley :: ShelleyBlock (TPraos c) (ShelleyEra c) -> CardanoBlock c +pattern BlockShelley :: ShelleyBlock (TPraos c) ShelleyEra -> CardanoBlock c pattern BlockShelley b = HardForkBlock (OneEraBlock (TagShelley (I b))) -pattern BlockAllegra :: ShelleyBlock (TPraos c) (AllegraEra c) -> CardanoBlock c +pattern BlockAllegra :: ShelleyBlock (TPraos c) AllegraEra -> CardanoBlock c pattern BlockAllegra b = HardForkBlock (OneEraBlock (TagAllegra (I b))) -pattern BlockMary :: ShelleyBlock (TPraos c) (MaryEra c) -> CardanoBlock c +pattern BlockMary :: ShelleyBlock (TPraos c) MaryEra -> CardanoBlock c pattern BlockMary b = HardForkBlock (OneEraBlock (TagMary (I b))) -pattern BlockAlonzo :: ShelleyBlock (TPraos c) (AlonzoEra c) -> CardanoBlock c +pattern BlockAlonzo :: ShelleyBlock (TPraos c) AlonzoEra -> CardanoBlock c pattern BlockAlonzo b = HardForkBlock (OneEraBlock (TagAlonzo (I b))) -pattern BlockBabbage :: ShelleyBlock (Praos c) (BabbageEra c) -> CardanoBlock c +pattern BlockBabbage :: ShelleyBlock (Praos c) BabbageEra -> CardanoBlock c pattern BlockBabbage b = HardForkBlock (OneEraBlock (TagBabbage (I b))) -pattern BlockConway :: ShelleyBlock (Praos c) (ConwayEra c) -> CardanoBlock c +pattern BlockConway :: ShelleyBlock (Praos c) ConwayEra -> CardanoBlock c pattern BlockConway b = HardForkBlock (OneEraBlock (TagConway (I b))) {-# COMPLETE @@ -270,32 +270,32 @@ pattern HeaderByron :: Header ByronBlock -> CardanoHeader c pattern HeaderByron h = HardForkHeader (OneEraHeader (TagByron h)) pattern HeaderShelley :: - Header (ShelleyBlock (TPraos c) (ShelleyEra c)) + Header (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoHeader c pattern HeaderShelley h = HardForkHeader (OneEraHeader (TagShelley h)) pattern HeaderAllegra :: - Header (ShelleyBlock (TPraos c) (AllegraEra c)) + Header (ShelleyBlock (TPraos c) AllegraEra) -> CardanoHeader c pattern HeaderAllegra h = HardForkHeader (OneEraHeader (TagAllegra h)) pattern HeaderMary :: - Header (ShelleyBlock (TPraos c) (MaryEra c)) + Header (ShelleyBlock (TPraos c) MaryEra) -> CardanoHeader c pattern HeaderMary h = HardForkHeader (OneEraHeader (TagMary h)) pattern HeaderAlonzo :: - Header (ShelleyBlock (TPraos c) (AlonzoEra c)) + Header (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoHeader c pattern HeaderAlonzo h = HardForkHeader (OneEraHeader (TagAlonzo h)) pattern HeaderBabbage :: - Header (ShelleyBlock (Praos c) (BabbageEra c)) + Header (ShelleyBlock (Praos c) BabbageEra) -> CardanoHeader c pattern HeaderBabbage h = HardForkHeader (OneEraHeader (TagBabbage h)) pattern HeaderConway :: - Header (ShelleyBlock (Praos c) (ConwayEra c)) + Header (ShelleyBlock (Praos c) ConwayEra) -> CardanoHeader c pattern HeaderConway h = HardForkHeader (OneEraHeader (TagConway h)) @@ -318,22 +318,22 @@ type CardanoGenTx c = GenTx (CardanoBlock c) pattern GenTxByron :: GenTx ByronBlock -> CardanoGenTx c pattern GenTxByron tx = HardForkGenTx (OneEraGenTx (TagByron tx)) -pattern GenTxShelley :: GenTx (ShelleyBlock (TPraos c) (ShelleyEra c)) -> CardanoGenTx c +pattern GenTxShelley :: GenTx (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoGenTx c pattern GenTxShelley tx = HardForkGenTx (OneEraGenTx (TagShelley tx)) -pattern GenTxAllegra :: GenTx (ShelleyBlock (TPraos c) (AllegraEra c)) -> CardanoGenTx c +pattern GenTxAllegra :: GenTx (ShelleyBlock (TPraos c) AllegraEra) -> CardanoGenTx c pattern GenTxAllegra tx = HardForkGenTx (OneEraGenTx (TagAllegra tx)) -pattern GenTxMary :: GenTx (ShelleyBlock (TPraos c) (MaryEra c)) -> CardanoGenTx c +pattern GenTxMary :: GenTx (ShelleyBlock (TPraos c) MaryEra) -> CardanoGenTx c pattern GenTxMary tx = HardForkGenTx (OneEraGenTx (TagMary tx)) -pattern GenTxAlonzo :: GenTx (ShelleyBlock (TPraos c) (AlonzoEra c)) -> CardanoGenTx c +pattern GenTxAlonzo :: GenTx (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoGenTx c pattern GenTxAlonzo tx = HardForkGenTx (OneEraGenTx (TagAlonzo tx)) -pattern GenTxBabbage :: GenTx (ShelleyBlock (Praos c) (BabbageEra c)) -> CardanoGenTx c +pattern GenTxBabbage :: GenTx (ShelleyBlock (Praos c) BabbageEra) -> CardanoGenTx c pattern GenTxBabbage tx = HardForkGenTx (OneEraGenTx (TagBabbage tx)) -pattern GenTxConway :: GenTx (ShelleyBlock (Praos c) (ConwayEra c)) -> CardanoGenTx c +pattern GenTxConway :: GenTx (ShelleyBlock (Praos c) ConwayEra) -> CardanoGenTx c pattern GenTxConway tx = HardForkGenTx (OneEraGenTx (TagConway tx)) {-# COMPLETE @@ -354,37 +354,37 @@ pattern GenTxIdByron txid = HardForkGenTxId (OneEraGenTxId (TagByron (WrapGenTxId txid))) pattern GenTxIdShelley :: - GenTxId (ShelleyBlock (TPraos c) (ShelleyEra c)) + GenTxId (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoGenTxId c pattern GenTxIdShelley txid = HardForkGenTxId (OneEraGenTxId (TagShelley (WrapGenTxId txid))) pattern GenTxIdAllegra :: - GenTxId (ShelleyBlock (TPraos c) (AllegraEra c)) + GenTxId (ShelleyBlock (TPraos c) AllegraEra) -> CardanoGenTxId c pattern GenTxIdAllegra txid = HardForkGenTxId (OneEraGenTxId (TagAllegra (WrapGenTxId txid))) pattern GenTxIdMary :: - GenTxId (ShelleyBlock (TPraos c) (MaryEra c)) + GenTxId (ShelleyBlock (TPraos c) MaryEra) -> CardanoGenTxId c pattern GenTxIdMary txid = HardForkGenTxId (OneEraGenTxId (TagMary (WrapGenTxId txid))) pattern GenTxIdAlonzo :: - GenTxId (ShelleyBlock (TPraos c) (AlonzoEra c)) + GenTxId (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoGenTxId c pattern GenTxIdAlonzo txid = HardForkGenTxId (OneEraGenTxId (TagAlonzo (WrapGenTxId txid))) pattern GenTxIdBabbage :: - GenTxId (ShelleyBlock (Praos c) (BabbageEra c)) + GenTxId (ShelleyBlock (Praos c) BabbageEra) -> CardanoGenTxId c pattern GenTxIdBabbage txid = HardForkGenTxId (OneEraGenTxId (TagBabbage (WrapGenTxId txid))) pattern GenTxIdConway :: - GenTxId (ShelleyBlock (Praos c) (ConwayEra c)) + GenTxId (ShelleyBlock (Praos c) ConwayEra) -> CardanoGenTxId c pattern GenTxIdConway txid = HardForkGenTxId (OneEraGenTxId (TagConway (WrapGenTxId txid))) @@ -421,37 +421,37 @@ pattern ApplyTxErrByron err = HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagByron (WrapApplyTxErr err))) pattern ApplyTxErrShelley :: - ApplyTxErr (ShelleyBlock (TPraos c) (ShelleyEra c)) + ApplyTxErr (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoApplyTxErr c pattern ApplyTxErrShelley err = HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagShelley (WrapApplyTxErr err))) pattern ApplyTxErrAllegra :: - ApplyTxErr (ShelleyBlock (TPraos c) (AllegraEra c)) + ApplyTxErr (ShelleyBlock (TPraos c) AllegraEra) -> CardanoApplyTxErr c pattern ApplyTxErrAllegra err = HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagAllegra (WrapApplyTxErr err))) pattern ApplyTxErrMary :: - ApplyTxErr (ShelleyBlock (TPraos c) (MaryEra c)) + ApplyTxErr (ShelleyBlock (TPraos c) MaryEra) -> CardanoApplyTxErr c pattern ApplyTxErrMary err = HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagMary (WrapApplyTxErr err))) pattern ApplyTxErrAlonzo :: - ApplyTxErr (ShelleyBlock (TPraos c) (AlonzoEra c)) + ApplyTxErr (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoApplyTxErr c pattern ApplyTxErrAlonzo err = HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagAlonzo (WrapApplyTxErr err))) pattern ApplyTxErrBabbage :: - ApplyTxErr (ShelleyBlock (Praos c) (BabbageEra c)) + ApplyTxErr (ShelleyBlock (Praos c) BabbageEra) -> CardanoApplyTxErr c pattern ApplyTxErrBabbage err = HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagBabbage (WrapApplyTxErr err))) pattern ApplyTxErrConway :: - ApplyTxErr (ShelleyBlock (Praos c) (ConwayEra c)) + ApplyTxErr (ShelleyBlock (Praos c) ConwayEra) -> CardanoApplyTxErr c pattern ApplyTxErrConway err = HardForkApplyTxErrFromEra (OneEraApplyTxErr (TagConway (WrapApplyTxErr err))) @@ -497,42 +497,42 @@ pattern LedgerErrorByron err = HardForkLedgerErrorFromEra (OneEraLedgerError (TagByron (WrapLedgerErr err))) pattern LedgerErrorShelley :: - LedgerError (ShelleyBlock (TPraos c) (ShelleyEra c)) + LedgerError (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoLedgerError c pattern LedgerErrorShelley err = HardForkLedgerErrorFromEra (OneEraLedgerError (TagShelley (WrapLedgerErr err))) pattern LedgerErrorAllegra :: - LedgerError (ShelleyBlock (TPraos c) (AllegraEra c)) + LedgerError (ShelleyBlock (TPraos c) AllegraEra) -> CardanoLedgerError c pattern LedgerErrorAllegra err = HardForkLedgerErrorFromEra (OneEraLedgerError (TagAllegra (WrapLedgerErr err))) pattern LedgerErrorMary :: - LedgerError (ShelleyBlock (TPraos c) (MaryEra c)) + LedgerError (ShelleyBlock (TPraos c) MaryEra) -> CardanoLedgerError c pattern LedgerErrorMary err = HardForkLedgerErrorFromEra (OneEraLedgerError (TagMary (WrapLedgerErr err))) pattern LedgerErrorAlonzo :: - LedgerError (ShelleyBlock (TPraos c) (AlonzoEra c)) + LedgerError (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoLedgerError c pattern LedgerErrorAlonzo err = HardForkLedgerErrorFromEra (OneEraLedgerError (TagAlonzo (WrapLedgerErr err))) pattern LedgerErrorBabbage :: - LedgerError (ShelleyBlock (Praos c) (BabbageEra c)) + LedgerError (ShelleyBlock (Praos c) BabbageEra) -> CardanoLedgerError c pattern LedgerErrorBabbage err = HardForkLedgerErrorFromEra (OneEraLedgerError (TagBabbage (WrapLedgerErr err))) pattern LedgerErrorConway :: - LedgerError (ShelleyBlock (Praos c) (ConwayEra c)) + LedgerError (ShelleyBlock (Praos c) ConwayEra) -> CardanoLedgerError c pattern LedgerErrorConway err = HardForkLedgerErrorFromEra @@ -567,37 +567,37 @@ pattern OtherHeaderEnvelopeErrorByron err = (OneEraEnvelopeErr (TagByron (WrapEnvelopeErr err))) pattern OtherHeaderEnvelopeErrorShelley - :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (ShelleyEra c)) + :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoOtherHeaderEnvelopeError c pattern OtherHeaderEnvelopeErrorShelley err = HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagShelley (WrapEnvelopeErr err))) pattern OtherHeaderEnvelopeErrorAllegra - :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (AllegraEra c)) + :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) AllegraEra) -> CardanoOtherHeaderEnvelopeError c pattern OtherHeaderEnvelopeErrorAllegra err = HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagAllegra (WrapEnvelopeErr err))) pattern OtherHeaderEnvelopeErrorMary - :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (MaryEra c)) + :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) MaryEra) -> CardanoOtherHeaderEnvelopeError c pattern OtherHeaderEnvelopeErrorMary err = HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagMary (WrapEnvelopeErr err))) pattern OtherHeaderEnvelopeErrorAlonzo - :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) (AlonzoEra c)) + :: OtherHeaderEnvelopeError (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoOtherHeaderEnvelopeError c pattern OtherHeaderEnvelopeErrorAlonzo err = HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagAlonzo (WrapEnvelopeErr err))) pattern OtherHeaderEnvelopeErrorBabbage - :: OtherHeaderEnvelopeError (ShelleyBlock (Praos c) (BabbageEra c)) + :: OtherHeaderEnvelopeError (ShelleyBlock (Praos c) BabbageEra) -> CardanoOtherHeaderEnvelopeError c pattern OtherHeaderEnvelopeErrorBabbage err = HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagBabbage (WrapEnvelopeErr err))) pattern OtherHeaderEnvelopeErrorConway - :: OtherHeaderEnvelopeError (ShelleyBlock (Praos c) (ConwayEra c)) + :: OtherHeaderEnvelopeError (ShelleyBlock (Praos c) ConwayEra) -> CardanoOtherHeaderEnvelopeError c pattern OtherHeaderEnvelopeErrorConway err = HardForkEnvelopeErrFromEra (OneEraEnvelopeErr (TagConway (WrapEnvelopeErr err))) @@ -629,32 +629,32 @@ pattern TipInfoByron :: TipInfo ByronBlock -> CardanoTipInfo c pattern TipInfoByron ti = OneEraTipInfo (TagByron (WrapTipInfo ti)) pattern TipInfoShelley :: - TipInfo (ShelleyBlock (TPraos c) (ShelleyEra c)) + TipInfo (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoTipInfo c pattern TipInfoShelley ti = OneEraTipInfo (TagShelley (WrapTipInfo ti)) pattern TipInfoAllegra :: - TipInfo (ShelleyBlock (TPraos c) (AllegraEra c)) + TipInfo (ShelleyBlock (TPraos c) AllegraEra) -> CardanoTipInfo c pattern TipInfoAllegra ti = OneEraTipInfo (TagAllegra (WrapTipInfo ti)) pattern TipInfoMary :: - TipInfo (ShelleyBlock (TPraos c) (MaryEra c)) + TipInfo (ShelleyBlock (TPraos c) MaryEra) -> CardanoTipInfo c pattern TipInfoMary ti = OneEraTipInfo (TagMary (WrapTipInfo ti)) pattern TipInfoAlonzo :: - TipInfo (ShelleyBlock (TPraos c) (AlonzoEra c)) + TipInfo (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoTipInfo c pattern TipInfoAlonzo ti = OneEraTipInfo (TagAlonzo (WrapTipInfo ti)) pattern TipInfoBabbage :: - TipInfo (ShelleyBlock (Praos c) (BabbageEra c)) + TipInfo (ShelleyBlock (Praos c) BabbageEra) -> CardanoTipInfo c pattern TipInfoBabbage ti = OneEraTipInfo (TagBabbage (WrapTipInfo ti)) pattern TipInfoConway :: - TipInfo (ShelleyBlock (Praos c) (ConwayEra c)) + TipInfo (ShelleyBlock (Praos c) ConwayEra) -> CardanoTipInfo c pattern TipInfoConway ti = OneEraTipInfo (TagConway (WrapTipInfo ti)) @@ -687,7 +687,7 @@ pattern QueryIfCurrentByron pattern QueryIfCurrentShelley :: () => CardanoQueryResult c result ~ a - => BlockQuery (ShelleyBlock (TPraos c) (ShelleyEra c)) result + => BlockQuery (ShelleyBlock (TPraos c) ShelleyEra) result -> CardanoQuery c a -- | Allegra-specific query that can only be answered when the ledger is in the @@ -695,7 +695,7 @@ pattern QueryIfCurrentShelley pattern QueryIfCurrentAllegra :: () => CardanoQueryResult c result ~ a - => BlockQuery (ShelleyBlock (TPraos c) (AllegraEra c)) result + => BlockQuery (ShelleyBlock (TPraos c) AllegraEra) result -> CardanoQuery c a -- | Mary-specific query that can only be answered when the ledger is in the @@ -703,7 +703,7 @@ pattern QueryIfCurrentAllegra pattern QueryIfCurrentMary :: () => CardanoQueryResult c result ~ a - => BlockQuery (ShelleyBlock (TPraos c) (MaryEra c)) result + => BlockQuery (ShelleyBlock (TPraos c) MaryEra) result -> CardanoQuery c a -- | Alonzo-specific query that can only be answered when the ledger is in the @@ -711,7 +711,7 @@ pattern QueryIfCurrentMary pattern QueryIfCurrentAlonzo :: () => CardanoQueryResult c result ~ a - => BlockQuery (ShelleyBlock (TPraos c) (AlonzoEra c)) result + => BlockQuery (ShelleyBlock (TPraos c) AlonzoEra) result -> CardanoQuery c a -- | Babbage-specific query that can only be answered when the ledger is in the @@ -719,7 +719,7 @@ pattern QueryIfCurrentAlonzo pattern QueryIfCurrentBabbage :: () => CardanoQueryResult c result ~ a - => BlockQuery (ShelleyBlock (Praos c) (BabbageEra c)) result + => BlockQuery (ShelleyBlock (Praos c) BabbageEra) result -> CardanoQuery c a -- | Conway-specific query that can only be answered when the ledger is in the @@ -727,7 +727,7 @@ pattern QueryIfCurrentBabbage pattern QueryIfCurrentConway :: () => CardanoQueryResult c result ~ a - => BlockQuery (ShelleyBlock (Praos c) (ConwayEra c)) result + => BlockQuery (ShelleyBlock (Praos c) ConwayEra) result -> CardanoQuery c a -- Here we use layout and adjacency to make it obvious that we haven't @@ -875,12 +875,12 @@ type CardanoCodecConfig c = CodecConfig (CardanoBlock c) pattern CardanoCodecConfig :: CodecConfig ByronBlock - -> CodecConfig (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> CodecConfig (ShelleyBlock (TPraos c) (AllegraEra c)) - -> CodecConfig (ShelleyBlock (TPraos c) (MaryEra c)) - -> CodecConfig (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> CodecConfig (ShelleyBlock (Praos c) (BabbageEra c)) - -> CodecConfig (ShelleyBlock (Praos c) (ConwayEra c)) + -> CodecConfig (ShelleyBlock (TPraos c) ShelleyEra) + -> CodecConfig (ShelleyBlock (TPraos c) AllegraEra) + -> CodecConfig (ShelleyBlock (TPraos c) MaryEra) + -> CodecConfig (ShelleyBlock (TPraos c) AlonzoEra) + -> CodecConfig (ShelleyBlock (Praos c) BabbageEra) + -> CodecConfig (ShelleyBlock (Praos c) ConwayEra) -> CardanoCodecConfig c pattern CardanoCodecConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = HardForkCodecConfig { @@ -910,12 +910,12 @@ type CardanoBlockConfig c = BlockConfig (CardanoBlock c) pattern CardanoBlockConfig :: BlockConfig ByronBlock - -> BlockConfig (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> BlockConfig (ShelleyBlock (TPraos c) (AllegraEra c)) - -> BlockConfig (ShelleyBlock (TPraos c) (MaryEra c)) - -> BlockConfig (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> BlockConfig (ShelleyBlock (Praos c) (BabbageEra c)) - -> BlockConfig (ShelleyBlock (Praos c) (ConwayEra c)) + -> BlockConfig (ShelleyBlock (TPraos c) ShelleyEra) + -> BlockConfig (ShelleyBlock (TPraos c) AllegraEra) + -> BlockConfig (ShelleyBlock (TPraos c) MaryEra) + -> BlockConfig (ShelleyBlock (TPraos c) AlonzoEra) + -> BlockConfig (ShelleyBlock (Praos c) BabbageEra) + -> BlockConfig (ShelleyBlock (Praos c) ConwayEra) -> CardanoBlockConfig c pattern CardanoBlockConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = HardForkBlockConfig { @@ -945,12 +945,12 @@ type CardanoStorageConfig c = StorageConfig (CardanoBlock c) pattern CardanoStorageConfig :: StorageConfig ByronBlock - -> StorageConfig (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> StorageConfig (ShelleyBlock (TPraos c) (AllegraEra c)) - -> StorageConfig (ShelleyBlock (TPraos c) (MaryEra c)) - -> StorageConfig (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> StorageConfig (ShelleyBlock (Praos c) (BabbageEra c)) - -> StorageConfig (ShelleyBlock (Praos c) (ConwayEra c)) + -> StorageConfig (ShelleyBlock (TPraos c) ShelleyEra) + -> StorageConfig (ShelleyBlock (TPraos c) AllegraEra) + -> StorageConfig (ShelleyBlock (TPraos c) MaryEra) + -> StorageConfig (ShelleyBlock (TPraos c) AlonzoEra) + -> StorageConfig (ShelleyBlock (Praos c) BabbageEra) + -> StorageConfig (ShelleyBlock (Praos c) ConwayEra) -> CardanoStorageConfig c pattern CardanoStorageConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = HardForkStorageConfig { @@ -983,12 +983,12 @@ type CardanoConsensusConfig c = pattern CardanoConsensusConfig :: PartialConsensusConfig (BlockProtocol ByronBlock) - -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (ShelleyEra c))) - -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (AllegraEra c))) - -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (MaryEra c))) - -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (AlonzoEra c))) - -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) (BabbageEra c))) - -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) (ConwayEra c))) + -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) ShelleyEra)) + -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) AllegraEra)) + -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) MaryEra)) + -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) AlonzoEra)) + -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) BabbageEra)) + -> PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) ConwayEra)) -> CardanoConsensusConfig c pattern CardanoConsensusConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway <- HardForkConsensusConfig { @@ -1020,12 +1020,12 @@ type CardanoLedgerConfig c = HardForkLedgerConfig (CardanoEras c) pattern CardanoLedgerConfig :: PartialLedgerConfig ByronBlock - -> PartialLedgerConfig (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> PartialLedgerConfig (ShelleyBlock (TPraos c) (AllegraEra c)) - -> PartialLedgerConfig (ShelleyBlock (TPraos c) (MaryEra c)) - -> PartialLedgerConfig (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> PartialLedgerConfig (ShelleyBlock (Praos c) (BabbageEra c)) - -> PartialLedgerConfig (ShelleyBlock (Praos c) (ConwayEra c)) + -> PartialLedgerConfig (ShelleyBlock (TPraos c) ShelleyEra) + -> PartialLedgerConfig (ShelleyBlock (TPraos c) AllegraEra) + -> PartialLedgerConfig (ShelleyBlock (TPraos c) MaryEra) + -> PartialLedgerConfig (ShelleyBlock (TPraos c) AlonzoEra) + -> PartialLedgerConfig (ShelleyBlock (Praos c) BabbageEra) + -> PartialLedgerConfig (ShelleyBlock (Praos c) ConwayEra) -> CardanoLedgerConfig c pattern CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway <- HardForkLedgerConfig { @@ -1064,7 +1064,7 @@ pattern LedgerStateByron st <- (TeleByron (State.Current { currentState = st }))) pattern LedgerStateShelley - :: LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)) + :: LedgerState (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoLedgerState c pattern LedgerStateShelley st <- HardForkLedgerState @@ -1072,7 +1072,7 @@ pattern LedgerStateShelley st <- (TeleShelley _ (State.Current { currentState = st }))) pattern LedgerStateAllegra - :: LedgerState (ShelleyBlock (TPraos c) (AllegraEra c)) + :: LedgerState (ShelleyBlock (TPraos c) AllegraEra) -> CardanoLedgerState c pattern LedgerStateAllegra st <- HardForkLedgerState @@ -1080,7 +1080,7 @@ pattern LedgerStateAllegra st <- (TeleAllegra _ _ (State.Current { currentState = st }))) pattern LedgerStateMary - :: LedgerState (ShelleyBlock (TPraos c) (MaryEra c)) + :: LedgerState (ShelleyBlock (TPraos c) MaryEra) -> CardanoLedgerState c pattern LedgerStateMary st <- HardForkLedgerState @@ -1088,7 +1088,7 @@ pattern LedgerStateMary st <- (TeleMary _ _ _ (State.Current { currentState = st }))) pattern LedgerStateAlonzo - :: LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c)) + :: LedgerState (ShelleyBlock (TPraos c) AlonzoEra) -> CardanoLedgerState c pattern LedgerStateAlonzo st <- HardForkLedgerState @@ -1096,7 +1096,7 @@ pattern LedgerStateAlonzo st <- (TeleAlonzo _ _ _ _ (State.Current { currentState = st }))) pattern LedgerStateBabbage - :: LedgerState (ShelleyBlock (Praos c) (BabbageEra c)) + :: LedgerState (ShelleyBlock (Praos c) BabbageEra) -> CardanoLedgerState c pattern LedgerStateBabbage st <- HardForkLedgerState @@ -1104,7 +1104,7 @@ pattern LedgerStateBabbage st <- (TeleBabbage _ _ _ _ _ (State.Current { currentState = st }))) pattern LedgerStateConway - :: LedgerState (ShelleyBlock (Praos c) (ConwayEra c)) + :: LedgerState (ShelleyBlock (Praos c) ConwayEra) -> CardanoLedgerState c pattern LedgerStateConway st <- HardForkLedgerState @@ -1140,42 +1140,42 @@ pattern ChainDepStateByron st <- (TeleByron (State.Current { currentState = WrapChainDepState st })) pattern ChainDepStateShelley - :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (ShelleyEra c))) + :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) ShelleyEra)) -> CardanoChainDepState c pattern ChainDepStateShelley st <- State.HardForkState (TeleShelley _ (State.Current { currentState = WrapChainDepState st })) pattern ChainDepStateAllegra - :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (AllegraEra c))) + :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) AllegraEra)) -> CardanoChainDepState c pattern ChainDepStateAllegra st <- State.HardForkState (TeleAllegra _ _ (State.Current { currentState = WrapChainDepState st })) pattern ChainDepStateMary - :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (MaryEra c))) + :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) MaryEra)) -> CardanoChainDepState c pattern ChainDepStateMary st <- State.HardForkState (TeleMary _ _ _ (State.Current { currentState = WrapChainDepState st })) pattern ChainDepStateAlonzo - :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) (AlonzoEra c))) + :: ChainDepState (BlockProtocol (ShelleyBlock (TPraos c) AlonzoEra)) -> CardanoChainDepState c pattern ChainDepStateAlonzo st <- State.HardForkState (TeleAlonzo _ _ _ _ (State.Current { currentState = WrapChainDepState st })) pattern ChainDepStateBabbage - :: ChainDepState (BlockProtocol (ShelleyBlock (Praos c) (BabbageEra c))) + :: ChainDepState (BlockProtocol (ShelleyBlock (Praos c) BabbageEra)) -> CardanoChainDepState c pattern ChainDepStateBabbage st <- State.HardForkState (TeleBabbage _ _ _ _ _ (State.Current { currentState = WrapChainDepState st })) pattern ChainDepStateConway - :: ChainDepState (BlockProtocol (ShelleyBlock (Praos c) (ConwayEra c))) + :: ChainDepState (BlockProtocol (ShelleyBlock (Praos c) ConwayEra)) -> CardanoChainDepState c pattern ChainDepStateConway st <- State.HardForkState diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs index e733970d13..a2b0af83b8 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs @@ -14,6 +14,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE AllowAmbiguousTypes #-} module Ouroboros.Consensus.Cardano.CanHardFork ( CardanoHardForkConstraints @@ -24,13 +25,8 @@ module Ouroboros.Consensus.Cardano.CanHardFork ( , translateChainDepStateAcrossShelley ) where -import Cardano.Crypto.DSIGN (Ed25519DSIGN) -import Cardano.Crypto.Hash.Blake2b (Blake2b_224, Blake2b_256) import qualified Cardano.Ledger.Core as SL -import Cardano.Ledger.Crypto (ADDRHASH, Crypto, DSIGN, HASH) import qualified Cardano.Ledger.Genesis as SL -import Cardano.Ledger.Hashes (EraIndependentTxBody) -import Cardano.Ledger.Keys (DSignable, Hash) import qualified Cardano.Ledger.Shelley.API as SL import Cardano.Ledger.Shelley.Translation (toFromByronTranslationContext) @@ -76,7 +72,6 @@ import Ouroboros.Consensus.Shelley.Protocol.Praos () import Ouroboros.Consensus.Shelley.ShelleyHFC import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util (eitherToMaybe) -import Ouroboros.Consensus.Util.RedundantConstraints {------------------------------------------------------------------------------- CanHardFork @@ -86,25 +81,18 @@ type CardanoHardForkConstraints c = ( TPraos.PraosCrypto c , Praos.PraosCrypto c , TranslateProto (TPraos c) (Praos c) - , ShelleyCompatible (TPraos c) (ShelleyEra c) - , LedgerSupportsProtocol (ShelleyBlock (TPraos c) (ShelleyEra c)) - , ShelleyCompatible (TPraos c) (AllegraEra c) - , LedgerSupportsProtocol (ShelleyBlock (TPraos c) (AllegraEra c)) - , ShelleyCompatible (TPraos c) (MaryEra c) - , LedgerSupportsProtocol (ShelleyBlock (TPraos c) (MaryEra c)) - , ShelleyCompatible (TPraos c) (AlonzoEra c) - , LedgerSupportsProtocol (ShelleyBlock (TPraos c) (AlonzoEra c)) - , ShelleyCompatible (Praos c) (BabbageEra c) - , LedgerSupportsProtocol (ShelleyBlock (Praos c) (BabbageEra c)) - , ShelleyCompatible (Praos c) (ConwayEra c) - , LedgerSupportsProtocol (ShelleyBlock (Praos c) (ConwayEra c)) - -- These equalities allow the transition from Byron to Shelley, since - -- @cardano-ledger-shelley@ requires Ed25519 for Byron bootstrap addresses and - -- the current Byron-to-Shelley translation requires a 224-bit hash for - -- address and a 256-bit hash for header hashes. - , HASH c ~ Blake2b_256 - , ADDRHASH c ~ Blake2b_224 - , DSIGN c ~ Ed25519DSIGN + , ShelleyCompatible (TPraos c) ShelleyEra + , LedgerSupportsProtocol (ShelleyBlock (TPraos c) ShelleyEra) + , ShelleyCompatible (TPraos c) AllegraEra + , LedgerSupportsProtocol (ShelleyBlock (TPraos c) AllegraEra) + , ShelleyCompatible (TPraos c) MaryEra + , LedgerSupportsProtocol (ShelleyBlock (TPraos c) MaryEra) + , ShelleyCompatible (TPraos c) AlonzoEra + , LedgerSupportsProtocol (ShelleyBlock (TPraos c) AlonzoEra) + , ShelleyCompatible (Praos c) BabbageEra + , LedgerSupportsProtocol (ShelleyBlock (Praos c) BabbageEra) + , ShelleyCompatible (Praos c) ConwayEra + , LedgerSupportsProtocol (ShelleyBlock (Praos c) ConwayEra) ) instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where @@ -213,25 +201,21 @@ instance (SelectView (BlockProtocol blk) ~ PraosChainSelectView c) => HasPraosSe translateHeaderHashByronToShelley :: forall c. - ( ShelleyCompatible (TPraos c) (ShelleyEra c) - , HASH c ~ Blake2b_256 + ( ShelleyCompatible (TPraos c) ShelleyEra ) => HeaderHash ByronBlock - -> HeaderHash (ShelleyBlock (TPraos c) (ShelleyEra c)) + -> HeaderHash (ShelleyBlock (TPraos c) ShelleyEra) translateHeaderHashByronToShelley = - fromShortRawHash (Proxy @(ShelleyBlock (TPraos c) (ShelleyEra c))) + fromShortRawHash (Proxy @(ShelleyBlock (TPraos c) ShelleyEra)) . toShortRawHash (Proxy @ByronBlock) - where - -- Byron uses 'Blake2b_256' for header hashes - _ = keepRedundantConstraint (Proxy @(HASH c ~ Blake2b_256)) translatePointByronToShelley :: - ( ShelleyCompatible (TPraos c) (ShelleyEra c) - , HASH c ~ Blake2b_256 + forall c. + ( ShelleyCompatible (TPraos c) ShelleyEra ) => Point ByronBlock -> WithOrigin BlockNo - -> WithOrigin (ShelleyTip (TPraos c) (ShelleyEra c)) + -> WithOrigin (ShelleyTip (TPraos c) ShelleyEra) translatePointByronToShelley point bNo = case (point, bNo) of (GenesisPoint, Origin) -> @@ -239,21 +223,19 @@ translatePointByronToShelley point bNo = (BlockPoint s h, NotOrigin n) -> NotOrigin ShelleyTip { shelleyTipSlotNo = s , shelleyTipBlockNo = n - , shelleyTipHash = translateHeaderHashByronToShelley h + , shelleyTipHash = translateHeaderHashByronToShelley @c h } _otherwise -> error "translatePointByronToShelley: invalid Byron state" translateLedgerStateByronToShelleyWrapper :: - ( ShelleyCompatible (TPraos c) (ShelleyEra c) - , HASH c ~ Blake2b_256 - , ADDRHASH c ~ Blake2b_224 + ( ShelleyCompatible (TPraos c) ShelleyEra ) => RequiringBoth WrapLedgerConfig (Translate LedgerState) ByronBlock - (ShelleyBlock (TPraos c) (ShelleyEra c)) + (ShelleyBlock (TPraos c) ShelleyEra) translateLedgerStateByronToShelleyWrapper = RequireBoth $ \_ (WrapLedgerConfig cfgShelley) -> Translate $ \epochNo ledgerByron -> @@ -276,7 +258,7 @@ translateChainDepStateByronToShelleyWrapper :: WrapConsensusConfig (Translate WrapChainDepState) ByronBlock - (ShelleyBlock (TPraos c) (ShelleyEra c)) + (ShelleyBlock (TPraos c) ShelleyEra) translateChainDepStateByronToShelleyWrapper = RequireBoth $ \_ (WrapConsensusConfig cfgShelley) -> Translate $ \_ (WrapChainDepState pbftState) -> @@ -287,7 +269,7 @@ translateChainDepStateByronToShelley :: forall bc c. ConsensusConfig (TPraos c) -> PBftState bc - -> TPraosState c + -> TPraosState translateChainDepStateByronToShelley TPraosConfig { tpraosParams } pbftState = -- Note that the 'PBftState' doesn't know about EBBs. So if the last slot of -- the Byron era were occupied by an EBB (and no regular block in that same @@ -315,12 +297,12 @@ translateChainDepStateByronToShelley TPraosConfig { tpraosParams } pbftState = nonce = tpraosInitialNonce tpraosParams crossEraForecastByronToShelleyWrapper :: - forall c. Crypto c => + forall c. RequiringBoth WrapLedgerConfig (CrossEraForecaster LedgerState WrapLedgerView) ByronBlock - (ShelleyBlock (TPraos c) (ShelleyEra c)) + (ShelleyBlock (TPraos c) ShelleyEra) crossEraForecastByronToShelleyWrapper = RequireBoth $ \_ (WrapLedgerConfig cfgShelley) -> CrossEraForecaster (forecast cfgShelley) @@ -333,13 +315,13 @@ crossEraForecastByronToShelleyWrapper = -- is still guaranteed to be less than the forecast range of the HFC in the -- Byron era. forecast :: - ShelleyLedgerConfig (ShelleyEra c) + ShelleyLedgerConfig ShelleyEra -> Bound -> SlotNo -> LedgerState ByronBlock -> Except OutsideForecastRange - (WrapLedgerView (ShelleyBlock (TPraos c) (ShelleyEra c))) + (WrapLedgerView (ShelleyBlock (TPraos c) ShelleyEra)) forecast cfgShelley bound forecastFor currentByronState | forecastFor < maxFor = return $ @@ -373,30 +355,27 @@ crossEraForecastByronToShelleyWrapper = -------------------------------------------------------------------------------} translateLedgerStateShelleyToAllegraWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => RequiringBoth + RequiringBoth WrapLedgerConfig (Translate LedgerState) - (ShelleyBlock (TPraos c) (ShelleyEra c)) - (ShelleyBlock (TPraos c) (AllegraEra c)) + (ShelleyBlock (TPraos c) ShelleyEra) + (ShelleyBlock (TPraos c) AllegraEra) translateLedgerStateShelleyToAllegraWrapper = ignoringBoth $ Translate $ \_epochNo -> unComp . SL.translateEra' SL.NoGenesis . Comp translateTxShelleyToAllegraWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => InjectTx - (ShelleyBlock (TPraos c) (ShelleyEra c)) - (ShelleyBlock (TPraos c) (AllegraEra c)) + InjectTx + (ShelleyBlock (TPraos c) ShelleyEra) + (ShelleyBlock (TPraos c) AllegraEra) translateTxShelleyToAllegraWrapper = InjectTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra SL.NoGenesis . Comp translateValidatedTxShelleyToAllegraWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => InjectValidatedTx - (ShelleyBlock (TPraos c) (ShelleyEra c)) - (ShelleyBlock (TPraos c) (AllegraEra c)) + InjectValidatedTx + (ShelleyBlock (TPraos c) ShelleyEra) + (ShelleyBlock (TPraos c) AllegraEra) translateValidatedTxShelleyToAllegraWrapper = InjectValidatedTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra SL.NoGenesis . Comp @@ -405,30 +384,27 @@ translateValidatedTxShelleyToAllegraWrapper = InjectValidatedTx $ -------------------------------------------------------------------------------} translateLedgerStateAllegraToMaryWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => RequiringBoth + RequiringBoth WrapLedgerConfig (Translate LedgerState) - (ShelleyBlock (TPraos c) (AllegraEra c)) - (ShelleyBlock (TPraos c) (MaryEra c)) + (ShelleyBlock (TPraos c) AllegraEra) + (ShelleyBlock (TPraos c) MaryEra) translateLedgerStateAllegraToMaryWrapper = ignoringBoth $ Translate $ \_epochNo -> unComp . SL.translateEra' SL.NoGenesis . Comp translateTxAllegraToMaryWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => InjectTx - (ShelleyBlock (TPraos c) (AllegraEra c)) - (ShelleyBlock (TPraos c) (MaryEra c)) + InjectTx + (ShelleyBlock (TPraos c) AllegraEra) + (ShelleyBlock (TPraos c) MaryEra) translateTxAllegraToMaryWrapper = InjectTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra SL.NoGenesis . Comp translateValidatedTxAllegraToMaryWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => InjectValidatedTx - (ShelleyBlock (TPraos c) (AllegraEra c)) - (ShelleyBlock (TPraos c) (MaryEra c)) + InjectValidatedTx + (ShelleyBlock (TPraos c) AllegraEra) + (ShelleyBlock (TPraos c) MaryEra) translateValidatedTxAllegraToMaryWrapper = InjectValidatedTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra SL.NoGenesis . Comp @@ -437,39 +413,36 @@ translateValidatedTxAllegraToMaryWrapper = InjectValidatedTx $ -------------------------------------------------------------------------------} translateLedgerStateMaryToAlonzoWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => RequiringBoth + RequiringBoth WrapLedgerConfig (Translate LedgerState) - (ShelleyBlock (TPraos c) (MaryEra c)) - (ShelleyBlock (TPraos c) (AlonzoEra c)) + (ShelleyBlock (TPraos c) MaryEra) + (ShelleyBlock (TPraos c) AlonzoEra) translateLedgerStateMaryToAlonzoWrapper = RequireBoth $ \_cfgMary cfgAlonzo -> Translate $ \_epochNo -> unComp . SL.translateEra' (getAlonzoTranslationContext cfgAlonzo) . Comp getAlonzoTranslationContext :: - WrapLedgerConfig (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> SL.TranslationContext (AlonzoEra c) + WrapLedgerConfig (ShelleyBlock (TPraos c) AlonzoEra) + -> SL.TranslationContext AlonzoEra getAlonzoTranslationContext = shelleyLedgerTranslationContext . unwrapLedgerConfig translateTxMaryToAlonzoWrapper :: - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => SL.TranslationContext (AlonzoEra c) + SL.TranslationContext AlonzoEra -> InjectTx - (ShelleyBlock (TPraos c) (MaryEra c)) - (ShelleyBlock (TPraos c) (AlonzoEra c)) + (ShelleyBlock (TPraos c) MaryEra) + (ShelleyBlock (TPraos c) AlonzoEra) translateTxMaryToAlonzoWrapper ctxt = InjectTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra ctxt . Comp translateValidatedTxMaryToAlonzoWrapper :: forall c. - (PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => SL.TranslationContext (AlonzoEra c) + SL.TranslationContext AlonzoEra -> InjectValidatedTx - (ShelleyBlock (TPraos c) (MaryEra c)) - (ShelleyBlock (TPraos c) (AlonzoEra c)) + (ShelleyBlock (TPraos c) MaryEra) + (ShelleyBlock (TPraos c) AlonzoEra) translateValidatedTxMaryToAlonzoWrapper ctxt = InjectValidatedTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra ctxt . Comp @@ -478,20 +451,19 @@ translateValidatedTxMaryToAlonzoWrapper ctxt = InjectValidatedTx $ -------------------------------------------------------------------------------} translateLedgerStateAlonzoToBabbageWrapper :: - (Praos.PraosCrypto c, TPraos.PraosCrypto c) - => RequiringBoth + RequiringBoth WrapLedgerConfig (Translate LedgerState) - (ShelleyBlock (TPraos c) (AlonzoEra c)) - (ShelleyBlock (Praos c) (BabbageEra c)) + (ShelleyBlock (TPraos c) AlonzoEra) + (ShelleyBlock (Praos c) BabbageEra) translateLedgerStateAlonzoToBabbageWrapper = RequireBoth $ \_cfgAlonzo _cfgBabbage -> Translate $ \_epochNo -> unComp . SL.translateEra' SL.NoGenesis . Comp . transPraosLS where transPraosLS :: - LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c)) -> - LedgerState (ShelleyBlock (Praos c) (AlonzoEra c)) + LedgerState (ShelleyBlock (TPraos c) AlonzoEra) -> + LedgerState (ShelleyBlock (Praos c) AlonzoEra) transPraosLS (ShelleyLedgerState wo nes st) = ShelleyLedgerState { shelleyLedgerTip = fmap castShelleyTip wo @@ -500,26 +472,24 @@ translateLedgerStateAlonzoToBabbageWrapper = } translateTxAlonzoToBabbageWrapper :: - (Praos.PraosCrypto c) - => SL.TranslationContext (BabbageEra c) + SL.TranslationContext BabbageEra -> InjectTx - (ShelleyBlock (TPraos c) (AlonzoEra c)) - (ShelleyBlock (Praos c) (BabbageEra c)) + (ShelleyBlock (TPraos c) AlonzoEra) + (ShelleyBlock (Praos c) BabbageEra) translateTxAlonzoToBabbageWrapper ctxt = InjectTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra ctxt . Comp . transPraosTx where transPraosTx - :: GenTx (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> GenTx (ShelleyBlock (Praos c) (AlonzoEra c)) + :: GenTx (ShelleyBlock (TPraos c) AlonzoEra) + -> GenTx (ShelleyBlock (Praos c) AlonzoEra) transPraosTx (ShelleyTx ti tx) = ShelleyTx ti (coerce tx) translateValidatedTxAlonzoToBabbageWrapper :: forall c. - (Praos.PraosCrypto c) - => SL.TranslationContext (BabbageEra c) + SL.TranslationContext BabbageEra -> InjectValidatedTx - (ShelleyBlock (TPraos c) (AlonzoEra c)) - (ShelleyBlock (Praos c) (BabbageEra c)) + (ShelleyBlock (TPraos c) AlonzoEra) + (ShelleyBlock (Praos c) BabbageEra) translateValidatedTxAlonzoToBabbageWrapper ctxt = InjectValidatedTx $ fmap unComp . eitherToMaybe @@ -529,8 +499,8 @@ translateValidatedTxAlonzoToBabbageWrapper ctxt = InjectValidatedTx $ . transPraosValidatedTx where transPraosValidatedTx - :: WrapValidatedGenTx (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> WrapValidatedGenTx (ShelleyBlock (Praos c) (AlonzoEra c)) + :: WrapValidatedGenTx (ShelleyBlock (TPraos c) AlonzoEra) + -> WrapValidatedGenTx (ShelleyBlock (Praos c) AlonzoEra) transPraosValidatedTx (WrapValidatedGenTx x) = case x of ShelleyValidatedTx txid vtx -> WrapValidatedGenTx $ ShelleyValidatedTx txid (SL.coerceValidated vtx) @@ -540,38 +510,35 @@ translateValidatedTxAlonzoToBabbageWrapper ctxt = InjectValidatedTx $ -------------------------------------------------------------------------------} translateLedgerStateBabbageToConwayWrapper :: - (Praos.PraosCrypto c) - => RequiringBoth + RequiringBoth WrapLedgerConfig (Translate LedgerState) - (ShelleyBlock (Praos c) (BabbageEra c)) - (ShelleyBlock (Praos c) (ConwayEra c)) + (ShelleyBlock (Praos c) BabbageEra) + (ShelleyBlock (Praos c) ConwayEra) translateLedgerStateBabbageToConwayWrapper = RequireBoth $ \_cfgBabbage cfgConway -> Translate $ \_epochNo -> unComp . SL.translateEra' (getConwayTranslationContext cfgConway) . Comp getConwayTranslationContext :: - WrapLedgerConfig (ShelleyBlock (Praos c) (ConwayEra c)) - -> SL.TranslationContext (ConwayEra c) + WrapLedgerConfig (ShelleyBlock (Praos c) ConwayEra) + -> SL.TranslationContext ConwayEra getConwayTranslationContext = shelleyLedgerTranslationContext . unwrapLedgerConfig translateTxBabbageToConwayWrapper :: - (Praos.PraosCrypto c) - => SL.TranslationContext (ConwayEra c) + SL.TranslationContext ConwayEra -> InjectTx - (ShelleyBlock (Praos c) (BabbageEra c)) - (ShelleyBlock (Praos c) (ConwayEra c)) + (ShelleyBlock (Praos c) BabbageEra) + (ShelleyBlock (Praos c) ConwayEra) translateTxBabbageToConwayWrapper ctxt = InjectTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra ctxt . Comp translateValidatedTxBabbageToConwayWrapper :: forall c. - (Praos.PraosCrypto c) - => SL.TranslationContext (ConwayEra c) + SL.TranslationContext ConwayEra -> InjectValidatedTx - (ShelleyBlock (Praos c) (BabbageEra c)) - (ShelleyBlock (Praos c) (ConwayEra c)) + (ShelleyBlock (Praos c) BabbageEra) + (ShelleyBlock (Praos c) ConwayEra) translateValidatedTxBabbageToConwayWrapper ctxt = InjectValidatedTx $ fmap unComp . eitherToMaybe . runExcept . SL.translateEra ctxt . Comp diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs index b05dfed499..9250d2d803 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs @@ -46,6 +46,7 @@ module Ouroboros.Consensus.Cardano.Node ( , pattern CardanoNodeToClientVersion13 , pattern CardanoNodeToClientVersion14 , pattern CardanoNodeToClientVersion15 + , pattern CardanoNodeToClientVersion16 , pattern CardanoNodeToNodeVersion1 , pattern CardanoNodeToNodeVersion2 ) where @@ -114,6 +115,7 @@ import Ouroboros.Consensus.Storage.Serialisation import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Assert import Ouroboros.Consensus.Util.IOLike + {------------------------------------------------------------------------------- SerialiseHFC -------------------------------------------------------------------------------} @@ -328,6 +330,23 @@ pattern CardanoNodeToClientVersion15 = :* Nil ) +-- | The hard fork enabled, and the Shelley, Allegra, Mary, Alonzo and Babbage +-- and Conway eras enabled, using 'ShelleyNodeToClientVersion12' for the +-- Shelley-based eras. +pattern CardanoNodeToClientVersion16 :: BlockNodeToClientVersion (CardanoBlock c) +pattern CardanoNodeToClientVersion16 = + HardForkNodeToClientEnabled + HardForkSpecificNodeToClientVersion3 + ( EraNodeToClientEnabled ByronNodeToClientVersion1 + :* EraNodeToClientEnabled ShelleyNodeToClientVersion12 + :* EraNodeToClientEnabled ShelleyNodeToClientVersion12 + :* EraNodeToClientEnabled ShelleyNodeToClientVersion12 + :* EraNodeToClientEnabled ShelleyNodeToClientVersion12 + :* EraNodeToClientEnabled ShelleyNodeToClientVersion12 + :* EraNodeToClientEnabled ShelleyNodeToClientVersion12 + :* Nil + ) + instance CardanoHardForkConstraints c => SupportedNetworkProtocolVersion (CardanoBlock c) where supportedNodeToNodeVersions _ = Map.fromList $ @@ -340,9 +359,10 @@ instance CardanoHardForkConstraints c , (NodeToClientV_17, CardanoNodeToClientVersion13) , (NodeToClientV_18, CardanoNodeToClientVersion14) , (NodeToClientV_19, CardanoNodeToClientVersion15) + , (NodeToClientV_20, CardanoNodeToClientVersion16) ] - latestReleasedNodeVersion _prx = (Just NodeToNodeV_14, Just NodeToClientV_19) + latestReleasedNodeVersion _prx = (Just NodeToNodeV_14, Just NodeToClientV_20) {------------------------------------------------------------------------------- ProtocolInfo @@ -378,12 +398,12 @@ newtype CardanoHardForkTriggers = CardanoHardForkTriggers { pattern CardanoHardForkTriggers' :: (c ~ StandardCrypto) - => CardanoHardForkTrigger (ShelleyBlock (TPraos c) (ShelleyEra c)) - -> CardanoHardForkTrigger (ShelleyBlock (TPraos c) (AllegraEra c)) - -> CardanoHardForkTrigger (ShelleyBlock (TPraos c) (MaryEra c)) - -> CardanoHardForkTrigger (ShelleyBlock (TPraos c) (AlonzoEra c)) - -> CardanoHardForkTrigger (ShelleyBlock (Praos c) (BabbageEra c)) - -> CardanoHardForkTrigger (ShelleyBlock (Praos c) (ConwayEra c)) + => CardanoHardForkTrigger (ShelleyBlock (TPraos c) ShelleyEra) + -> CardanoHardForkTrigger (ShelleyBlock (TPraos c) AllegraEra) + -> CardanoHardForkTrigger (ShelleyBlock (TPraos c) MaryEra) + -> CardanoHardForkTrigger (ShelleyBlock (TPraos c) AlonzoEra) + -> CardanoHardForkTrigger (ShelleyBlock (Praos c) BabbageEra) + -> CardanoHardForkTrigger (ShelleyBlock (Praos c) ConwayEra) -> CardanoHardForkTriggers pattern CardanoHardForkTriggers' { triggerHardForkShelley @@ -431,7 +451,7 @@ data CardanoProtocolParams c = CardanoProtocolParams { byronProtocolParams :: ProtocolParamsByron , shelleyBasedProtocolParams :: ProtocolParamsShelleyBased c , cardanoHardForkTriggers :: CardanoHardForkTriggers - , cardanoLedgerTransitionConfig :: L.TransitionConfig (L.LatestKnownEra c) + , cardanoLedgerTransitionConfig :: L.TransitionConfig L.LatestKnownEra , cardanoCheckpoints :: CheckpointsMap (CardanoBlock c) -- | The greatest protocol version that this node's software and config -- files declare to handle correctly. @@ -567,13 +587,13 @@ protocolInfoCardano paramsCardano -- This value is used for all Praos eras /except/ Babbage, see -- 'partialConsensusConfigBabbage'. SL.computeRandomnessStabilisationWindow - (SL.sgSecurityParam genesisShelley) + (SL.unNonZero $ SL.sgSecurityParam genesisShelley) (SL.mkActiveSlotCoeff $ SL.sgActiveSlotsCoeff genesisShelley) } PraosParams { praosSlotsPerKESPeriod, praosMaxKESEvo } = praosParams - blockConfigShelley :: BlockConfig (ShelleyBlock (TPraos c) (ShelleyEra c)) + blockConfigShelley :: BlockConfig (ShelleyBlock (TPraos c) ShelleyEra) blockConfigShelley = Shelley.mkShelleyBlockConfig cardanoProtocolVersion @@ -581,10 +601,10 @@ protocolInfoCardano paramsCardano (shelleyBlockIssuerVKey <$> credssShelleyBased) partialConsensusConfigShelley :: - PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (ShelleyEra c))) + PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) ShelleyEra)) partialConsensusConfigShelley = tpraosParams - partialLedgerConfigShelley :: PartialLedgerConfig (ShelleyBlock (TPraos c) (ShelleyEra c)) + partialLedgerConfigShelley :: PartialLedgerConfig (ShelleyBlock (TPraos c) ShelleyEra) partialLedgerConfigShelley = mkPartialLedgerConfigShelley transitionConfigShelley @@ -595,7 +615,7 @@ protocolInfoCardano paramsCardano -- Allegra - blockConfigAllegra :: BlockConfig (ShelleyBlock (TPraos c) (AllegraEra c)) + blockConfigAllegra :: BlockConfig (ShelleyBlock (TPraos c) AllegraEra) blockConfigAllegra = Shelley.mkShelleyBlockConfig cardanoProtocolVersion @@ -603,10 +623,10 @@ protocolInfoCardano paramsCardano (shelleyBlockIssuerVKey <$> credssShelleyBased) partialConsensusConfigAllegra :: - PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (AllegraEra c))) + PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) AllegraEra)) partialConsensusConfigAllegra = tpraosParams - partialLedgerConfigAllegra :: PartialLedgerConfig (ShelleyBlock (TPraos c) (AllegraEra c)) + partialLedgerConfigAllegra :: PartialLedgerConfig (ShelleyBlock (TPraos c) AllegraEra) partialLedgerConfigAllegra = mkPartialLedgerConfigShelley transitionConfigAllegra @@ -614,7 +634,7 @@ protocolInfoCardano paramsCardano -- Mary - blockConfigMary :: BlockConfig (ShelleyBlock (TPraos c) (MaryEra c)) + blockConfigMary :: BlockConfig (ShelleyBlock (TPraos c) MaryEra) blockConfigMary = Shelley.mkShelleyBlockConfig cardanoProtocolVersion @@ -622,10 +642,10 @@ protocolInfoCardano paramsCardano (shelleyBlockIssuerVKey <$> credssShelleyBased) partialConsensusConfigMary :: - PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (MaryEra c))) + PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) MaryEra)) partialConsensusConfigMary = tpraosParams - partialLedgerConfigMary :: PartialLedgerConfig (ShelleyBlock (TPraos c) (MaryEra c)) + partialLedgerConfigMary :: PartialLedgerConfig (ShelleyBlock (TPraos c) MaryEra) partialLedgerConfigMary = mkPartialLedgerConfigShelley transitionConfigMary @@ -633,7 +653,7 @@ protocolInfoCardano paramsCardano -- Alonzo - blockConfigAlonzo :: BlockConfig (ShelleyBlock (TPraos c) (AlonzoEra c)) + blockConfigAlonzo :: BlockConfig (ShelleyBlock (TPraos c) AlonzoEra) blockConfigAlonzo = Shelley.mkShelleyBlockConfig cardanoProtocolVersion @@ -641,10 +661,10 @@ protocolInfoCardano paramsCardano (shelleyBlockIssuerVKey <$> credssShelleyBased) partialConsensusConfigAlonzo :: - PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) (AlonzoEra c))) + PartialConsensusConfig (BlockProtocol (ShelleyBlock (TPraos c) AlonzoEra)) partialConsensusConfigAlonzo = tpraosParams - partialLedgerConfigAlonzo :: PartialLedgerConfig (ShelleyBlock (TPraos c) (AlonzoEra c)) + partialLedgerConfigAlonzo :: PartialLedgerConfig (ShelleyBlock (TPraos c) AlonzoEra) partialLedgerConfigAlonzo = mkPartialLedgerConfigShelley transitionConfigAlonzo @@ -652,7 +672,7 @@ protocolInfoCardano paramsCardano -- Babbage - blockConfigBabbage :: BlockConfig (ShelleyBlock (Praos c) (BabbageEra c)) + blockConfigBabbage :: BlockConfig (ShelleyBlock (Praos c) BabbageEra) blockConfigBabbage = Shelley.mkShelleyBlockConfig cardanoProtocolVersion @@ -660,7 +680,7 @@ protocolInfoCardano paramsCardano (shelleyBlockIssuerVKey <$> credssShelleyBased) partialConsensusConfigBabbage :: - PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) (BabbageEra c))) + PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) BabbageEra)) partialConsensusConfigBabbage = praosParams { -- For Praos in Babbage (just as in all TPraos eras) we use the -- smaller (3k/f vs 4k/f slots) stability window here for @@ -668,12 +688,12 @@ protocolInfoCardano paramsCardano -- specs for context. praosRandomnessStabilisationWindow = SL.computeStabilityWindow - (SL.sgSecurityParam genesisShelley) + (SL.unNonZero $ SL.sgSecurityParam genesisShelley) (SL.mkActiveSlotCoeff $ SL.sgActiveSlotsCoeff genesisShelley) } - partialLedgerConfigBabbage :: PartialLedgerConfig (ShelleyBlock (Praos c) (BabbageEra c)) + partialLedgerConfigBabbage :: PartialLedgerConfig (ShelleyBlock (Praos c) BabbageEra) partialLedgerConfigBabbage = mkPartialLedgerConfigShelley transitionConfigBabbage @@ -681,7 +701,7 @@ protocolInfoCardano paramsCardano -- Conway - blockConfigConway :: BlockConfig (ShelleyBlock (Praos c) (ConwayEra c)) + blockConfigConway :: BlockConfig (ShelleyBlock (Praos c) ConwayEra) blockConfigConway = Shelley.mkShelleyBlockConfig cardanoProtocolVersion @@ -689,10 +709,10 @@ protocolInfoCardano paramsCardano (shelleyBlockIssuerVKey <$> credssShelleyBased) partialConsensusConfigConway :: - PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) (ConwayEra c))) + PartialConsensusConfig (BlockProtocol (ShelleyBlock (Praos c) ConwayEra)) partialConsensusConfigConway = praosParams - partialLedgerConfigConway :: PartialLedgerConfig (ShelleyBlock (Praos c) (ConwayEra c)) + partialLedgerConfigConway :: PartialLedgerConfig (ShelleyBlock (Praos c) ConwayEra) partialLedgerConfigConway = mkPartialLedgerConfigShelley transitionConfigConway diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Crypto.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Crypto.hs index 130837f5c5..963a43b135 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Crypto.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Crypto.hs @@ -4,4 +4,4 @@ -- | Module defining the crypto primitives used throughout Shelley based eras. module Ouroboros.Consensus.Shelley.Crypto (StandardCrypto) where -import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Protocol.Crypto (StandardCrypto) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Eras.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Eras.hs index f8217118af..95fec5bbfb 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Eras.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Eras.hs @@ -12,6 +12,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} +{-# OPTIONS_GHC -Wno-orphans #-} + module Ouroboros.Consensus.Shelley.Eras ( -- * Eras based on the Shelley ledger AllegraEra @@ -31,14 +33,13 @@ module Ouroboros.Consensus.Shelley.Eras ( , ConwayEraGovDict (..) , ShelleyBasedEra (..) , WrapTx (..) - -- * Type synonyms for convenience - , EraCrypto -- * Convenience functions , isBeforeConway -- * Re-exports , StandardCrypto ) where +import Cardano.Binary import Cardano.Ledger.Allegra (AllegraEra) import Cardano.Ledger.Allegra.Translation () import Cardano.Ledger.Alonzo (AlonzoEra) @@ -58,8 +59,6 @@ import qualified Cardano.Ledger.Conway.Rules as SL (ConwayLedgerPredFailure (..)) import qualified Cardano.Ledger.Conway.Translation as Conway import Cardano.Ledger.Core as Core -import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Ledger.Keys (DSignable, Hash) import Cardano.Ledger.Mary (MaryEra) import Cardano.Ledger.Mary.Translation () import Cardano.Ledger.Shelley (ShelleyEra) @@ -76,29 +75,35 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Ledger.SupportsMempool (WhetherToIntervene (..)) -import qualified Ouroboros.Consensus.Protocol.Praos as Praos +import Ouroboros.Consensus.Protocol.TPraos (StandardCrypto) {------------------------------------------------------------------------------- Eras instantiated with standard crypto -------------------------------------------------------------------------------} -- | The Shelley era with standard crypto -type StandardShelley = ShelleyEra StandardCrypto +type StandardShelley = ShelleyEra +{-# DEPRECATED StandardShelley "In favor of `ShelleyEra`" #-} -- | The Allegra era with standard crypto -type StandardAllegra = AllegraEra StandardCrypto +type StandardAllegra = AllegraEra +{-# DEPRECATED StandardAllegra "In favor of `AllegraEra`" #-} -- | The Mary era with standard crypto -type StandardMary = MaryEra StandardCrypto +type StandardMary = MaryEra +{-# DEPRECATED StandardMary "In favor of `MaryEra`" #-} -- | The Alonzo era with standard crypto -type StandardAlonzo = AlonzoEra StandardCrypto +type StandardAlonzo = AlonzoEra +{-# DEPRECATED StandardAlonzo "In favor of `AlonzoEra`" #-} -- | The Babbage era with standard crypto -type StandardBabbage = BabbageEra StandardCrypto +type StandardBabbage = BabbageEra +{-# DEPRECATED StandardBabbage "In favor of `BabbageEra`" #-} -- | The Conway era with standard crypto -type StandardConway = ConwayEra StandardCrypto +type StandardConway = ConwayEra +{-# DEPRECATED StandardConway "In favor of `ConwayEra`" #-} {------------------------------------------------------------------------------- Era polymorphism @@ -140,11 +145,14 @@ class ( Core.EraSegWits era , EncCBOR (PredicateFailure (EraRule "LEDGER" era)) , DecCBOR (PredicateFailure (EraRule "UTXOW" era)) , EncCBOR (PredicateFailure (EraRule "UTXOW" era)) - - , DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody) - , NoThunks (PredicateFailure (Core.EraRule "BBODY" era)) + , Eq (PredicateFailure (EraRule "BBODY" era)) + , Show (PredicateFailure (EraRule "BBODY" era)) + , NoThunks (PredicateFailure (EraRule "BBODY" era)) , NoThunks (Core.TranslationContext era) + , ToCBOR (Core.TranslationContext era) + , FromCBOR (Core.TranslationContext era) + ) => ShelleyBasedEra era where applyShelleyBasedTx :: @@ -167,7 +175,7 @@ data ConwayEraGovDict era where isBeforeConway :: forall era. L.Era era => Proxy era -> Bool isBeforeConway _ = - L.eraProtVerLow @era < L.eraProtVerLow @(L.ConwayEra (L.EraCrypto era)) + L.eraProtVerLow @era < L.eraProtVerLow @L.ConwayEra -- | The default implementation of 'applyShelleyBasedTx', a thin wrapper around -- 'SL.applyTx' @@ -183,7 +191,8 @@ defaultApplyShelleyBasedTx :: ( SL.LedgerState era , SL.Validated (Core.Tx era) ) -defaultApplyShelleyBasedTx globals ledgerEnv mempoolState _wti tx = do +defaultApplyShelleyBasedTx globals ledgerEnv mempoolState _wti tx = + liftEither $ SL.applyTx globals ledgerEnv @@ -193,36 +202,32 @@ defaultApplyShelleyBasedTx globals ledgerEnv mempoolState _wti tx = do defaultGetConwayEraGovDict :: proxy era -> Maybe (ConwayEraGovDict era) defaultGetConwayEraGovDict _ = Nothing -instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => ShelleyBasedEra (ShelleyEra c) where +instance ShelleyBasedEra ShelleyEra where applyShelleyBasedTx = defaultApplyShelleyBasedTx getConwayEraGovDict = defaultGetConwayEraGovDict -instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => ShelleyBasedEra (AllegraEra c) where +instance ShelleyBasedEra AllegraEra where applyShelleyBasedTx = defaultApplyShelleyBasedTx getConwayEraGovDict = defaultGetConwayEraGovDict -instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => ShelleyBasedEra (MaryEra c) where +instance ShelleyBasedEra MaryEra where applyShelleyBasedTx = defaultApplyShelleyBasedTx getConwayEraGovDict = defaultGetConwayEraGovDict -instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody)) - => ShelleyBasedEra (AlonzoEra c) where +instance ShelleyBasedEra AlonzoEra where applyShelleyBasedTx = applyAlonzoBasedTx getConwayEraGovDict = defaultGetConwayEraGovDict -instance (Praos.PraosCrypto c) => ShelleyBasedEra (BabbageEra c) where +instance ShelleyBasedEra BabbageEra where applyShelleyBasedTx = applyAlonzoBasedTx getConwayEraGovDict = defaultGetConwayEraGovDict -instance (Praos.PraosCrypto c) => ShelleyBasedEra (ConwayEra c) where +instance ShelleyBasedEra ConwayEra where applyShelleyBasedTx = applyAlonzoBasedTx getConwayEraGovDict _ = Just ConwayEraGovDict @@ -283,7 +288,7 @@ class SupportsTwoPhaseValidation era where -- NOTE: this class won't be needed once https://github.com/IntersectMBO/cardano-ledger/issues/4167 is implemented. isIncorrectClaimedFlag :: proxy era -> SL.PredicateFailure (Core.EraRule "LEDGER" era) -> Bool -instance SupportsTwoPhaseValidation (AlonzoEra c) where +instance SupportsTwoPhaseValidation AlonzoEra where isIncorrectClaimedFlag _ = \case SL.UtxowFailure ( Alonzo.ShelleyInAlonzoUtxowPredFailure @@ -299,7 +304,7 @@ instance SupportsTwoPhaseValidation (AlonzoEra c) where True _ -> False -instance SupportsTwoPhaseValidation (BabbageEra c) where +instance SupportsTwoPhaseValidation BabbageEra where isIncorrectClaimedFlag _ = \case SL.UtxowFailure ( Babbage.AlonzoInBabbageUtxowPredFailure @@ -329,7 +334,7 @@ instance SupportsTwoPhaseValidation (BabbageEra c) where ) -> True _ -> False -instance SupportsTwoPhaseValidation (ConwayEra c) where +instance SupportsTwoPhaseValidation ConwayEra where isIncorrectClaimedFlag _ = \case SL.ConwayUtxowFailure ( Conway.UtxoFailure @@ -358,31 +363,31 @@ instance SupportsTwoPhaseValidation (ConwayEra c) where -- with this justification. newtype WrapTx era = WrapTx {unwrapTx :: Core.Tx era} -instance ShelleyBasedEra (AllegraEra c) => Core.TranslateEra (AllegraEra c) WrapTx where - type TranslationError (AllegraEra c) WrapTx = Core.TranslationError (AllegraEra c) SL.ShelleyTx +instance ShelleyBasedEra AllegraEra => Core.TranslateEra AllegraEra WrapTx where + type TranslationError AllegraEra WrapTx = Core.TranslationError AllegraEra SL.ShelleyTx translateEra ctxt = fmap WrapTx . Core.translateEra ctxt . unwrapTx -instance ShelleyBasedEra (MaryEra c) => Core.TranslateEra (MaryEra c) WrapTx where - type TranslationError (MaryEra c) WrapTx = Core.TranslationError (MaryEra c) SL.ShelleyTx +instance Core.TranslateEra MaryEra WrapTx where + type TranslationError MaryEra WrapTx = Core.TranslationError MaryEra SL.ShelleyTx translateEra ctxt = fmap WrapTx . Core.translateEra ctxt . unwrapTx -instance ShelleyBasedEra (AlonzoEra c) => Core.TranslateEra (AlonzoEra c) WrapTx where - type TranslationError (AlonzoEra c) WrapTx = Core.TranslationError (AlonzoEra c) Alonzo.Tx +instance Core.TranslateEra AlonzoEra WrapTx where + type TranslationError AlonzoEra WrapTx = Core.TranslationError AlonzoEra Alonzo.Tx translateEra ctxt = fmap (WrapTx . Alonzo.unTx) - . Core.translateEra @(AlonzoEra c) ctxt + . Core.translateEra @AlonzoEra ctxt . Alonzo.Tx . unwrapTx -instance ShelleyBasedEra (BabbageEra c) => Core.TranslateEra (BabbageEra c) WrapTx where - type TranslationError (BabbageEra c) WrapTx = Core.TranslationError (BabbageEra c) Babbage.Tx +instance Core.TranslateEra BabbageEra WrapTx where + type TranslationError BabbageEra WrapTx = Core.TranslationError BabbageEra Babbage.Tx translateEra ctxt = fmap (WrapTx . Babbage.unTx) - . Core.translateEra @(BabbageEra c) ctxt + . Core.translateEra @BabbageEra ctxt . Babbage.Tx . unwrapTx -instance ShelleyBasedEra (ConwayEra c) => Core.TranslateEra (ConwayEra c) WrapTx where - type TranslationError (ConwayEra c) WrapTx = Core.TranslationError (ConwayEra c) Conway.Tx +instance Core.TranslateEra ConwayEra WrapTx where + type TranslationError ConwayEra WrapTx = Core.TranslationError ConwayEra Conway.Tx translateEra ctxt = fmap (WrapTx . Conway.unTx) - . Core.translateEra @(ConwayEra c) ctxt + . Core.translateEra @ConwayEra ctxt . Conway.Tx . unwrapTx diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/HFEras.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/HFEras.hs index d595545884..ec7e09e1bb 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/HFEras.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/HFEras.hs @@ -18,18 +18,12 @@ module Ouroboros.Consensus.Shelley.HFEras ( , StandardShelleyBlock ) where -import Cardano.Crypto.DSIGN (Signable) -import Cardano.Crypto.Hash (Hash) -import Cardano.Ledger.Crypto (DSIGN, HASH) -import Cardano.Ledger.Hashes (EraIndependentTxBody) import Ouroboros.Consensus.Protocol.Praos (Praos) import qualified Ouroboros.Consensus.Protocol.Praos as Praos import Ouroboros.Consensus.Protocol.TPraos (StandardCrypto, TPraos) import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos import Ouroboros.Consensus.Shelley.Eras (AllegraEra, AlonzoEra, - BabbageEra, ConwayEra, MaryEra, ShelleyEra, - StandardAllegra, StandardAlonzo, StandardBabbage, - StandardConway, StandardMary, StandardShelley) + BabbageEra, ConwayEra, MaryEra, ShelleyEra) import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock, ShelleyCompatible) import Ouroboros.Consensus.Shelley.Ledger.Protocol () @@ -41,54 +35,54 @@ import Ouroboros.Consensus.Shelley.ShelleyHFC () Hard fork eras -------------------------------------------------------------------------------} -type StandardShelleyBlock = ShelleyBlock (TPraos StandardCrypto) StandardShelley +type StandardShelleyBlock = ShelleyBlock (TPraos StandardCrypto) ShelleyEra -type StandardAllegraBlock = ShelleyBlock (TPraos StandardCrypto) StandardAllegra +type StandardAllegraBlock = ShelleyBlock (TPraos StandardCrypto) AllegraEra -type StandardMaryBlock = ShelleyBlock (TPraos StandardCrypto) StandardMary +type StandardMaryBlock = ShelleyBlock (TPraos StandardCrypto) MaryEra -type StandardAlonzoBlock = ShelleyBlock (TPraos StandardCrypto) StandardAlonzo +type StandardAlonzoBlock = ShelleyBlock (TPraos StandardCrypto) AlonzoEra -type StandardBabbageBlock = ShelleyBlock (Praos StandardCrypto) StandardBabbage +type StandardBabbageBlock = ShelleyBlock (Praos StandardCrypto) BabbageEra -type StandardConwayBlock = ShelleyBlock (Praos StandardCrypto) StandardConway +type StandardConwayBlock = ShelleyBlock (Praos StandardCrypto) ConwayEra {------------------------------------------------------------------------------- ShelleyCompatible -------------------------------------------------------------------------------} instance - (TPraos.PraosCrypto c, Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)) => - ShelleyCompatible (TPraos c) (ShelleyEra c) + TPraos.PraosCrypto c => + ShelleyCompatible (TPraos c) ShelleyEra instance - (TPraos.PraosCrypto c, Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)) => - ShelleyCompatible (TPraos c) (AllegraEra c) + TPraos.PraosCrypto c => + ShelleyCompatible (TPraos c) AllegraEra instance - (TPraos.PraosCrypto c, Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)) => - ShelleyCompatible (TPraos c) (MaryEra c) + TPraos.PraosCrypto c => + ShelleyCompatible (TPraos c) MaryEra instance - (TPraos.PraosCrypto c, Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)) => - ShelleyCompatible (TPraos c) (AlonzoEra c) + TPraos.PraosCrypto c => + ShelleyCompatible (TPraos c) AlonzoEra -- This instance is required since the ledger view forecast function for -- Praos/Babbage still goes through the forecast for TPraos. Once this is -- addressed, we could remove this instance. instance (Praos.PraosCrypto c, TPraos.PraosCrypto c) => - ShelleyCompatible (TPraos c) (BabbageEra c) + ShelleyCompatible (TPraos c) BabbageEra instance - (Praos.PraosCrypto c) => ShelleyCompatible (Praos c) (BabbageEra c) + (Praos.PraosCrypto c) => ShelleyCompatible (Praos c) BabbageEra -- This instance is required since the ledger view forecast function for -- Praos/Conway still goes through the forecast for TPraos. Once this is -- addressed, we could remove this instance. instance (Praos.PraosCrypto c, TPraos.PraosCrypto c) => - ShelleyCompatible (TPraos c) (ConwayEra c) + ShelleyCompatible (TPraos c) ConwayEra instance - (Praos.PraosCrypto c) => ShelleyCompatible (Praos c) (ConwayEra c) + (Praos.PraosCrypto c) => ShelleyCompatible (Praos c) ConwayEra diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs index 955fc408cb..fba96e16ba 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs @@ -45,8 +45,9 @@ import qualified Cardano.Ledger.Binary.Plain as Plain import Cardano.Ledger.Core as SL (eraDecoder, eraProtVerLow, toEraCBOR) import qualified Cardano.Ledger.Core as SL (hashTxSeq) -import Cardano.Ledger.Crypto (HASH) +import Cardano.Ledger.Hashes (HASH) import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (Crypto) import qualified Cardano.Protocol.TPraos.BHeader as SL import qualified Data.ByteString.Lazy as Lazy import Data.Coerce (coerce) @@ -89,23 +90,23 @@ class , DecCBOR (Annotator (ShelleyProtocolHeader proto)) , Show (CannotForgeError proto) -- Currently the chain select view is identical - , SelectView proto ~ PraosChainSelectView (EraCrypto era) + -- Era and proto crypto must coincide + , SelectView proto ~ PraosChainSelectView (ProtoCrypto proto) -- Need to be able to sign the protocol header , SignedHeader (ShelleyProtocolHeader proto) -- ChainDepState needs to be serialisable , DecodeDisk (ShelleyBlock proto era) (ChainDepState proto) , EncodeDisk (ShelleyBlock proto era) (ChainDepState proto) - -- Era and proto crypto must coincide - , EraCrypto era ~ ProtoCrypto proto -- Hard-fork related constraints , HasPartialConsensusConfig proto , DecCBOR (SL.PState era) + , Crypto (ProtoCrypto proto) ) => ShelleyCompatible proto era instance ShelleyCompatible proto era => ConvertRawHash (ShelleyBlock proto era) where toShortRawHash _ = Crypto.hashToBytesShort . unShelleyHash fromShortRawHash _ = ShelleyHash . hashFromBytesShortE - hashSize _ = fromIntegral $ Crypto.sizeHash (Proxy @(HASH (EraCrypto era))) + hashSize _ = fromIntegral $ Crypto.sizeHash (Proxy @HASH) {------------------------------------------------------------------------------- Shelley blocks and headers @@ -116,7 +117,7 @@ instance ShelleyCompatible proto era => ConvertRawHash (ShelleyBlock proto era) -- This block is parametrised over both the (ledger) era and the protocol. data ShelleyBlock proto era = ShelleyBlock { shelleyBlockRaw :: !(SL.Block (ShelleyProtocolHeader proto) era) - , shelleyBlockHeaderHash :: !(ShelleyHash (ProtoCrypto proto)) + , shelleyBlockHeaderHash :: !ShelleyHash } deriving instance ShelleyCompatible proto era => Show (ShelleyBlock proto era) @@ -125,7 +126,7 @@ deriving instance ShelleyCompatible proto era => Eq (ShelleyBlock proto era) instance (Typeable era, Typeable proto) => ShowProxy (ShelleyBlock proto era) where -type instance HeaderHash (ShelleyBlock proto era) = ShelleyHash (ProtoCrypto proto) +type instance HeaderHash (ShelleyBlock proto era) = ShelleyHash mkShelleyBlock :: ShelleyCompatible proto era @@ -139,7 +140,6 @@ mkShelleyBlock raw = ShelleyBlock { class ( ShelleyCompatible (BlockProtocol blk) (ShelleyBlockLedgerEra blk) , blk ~ ShelleyBlock (BlockProtocol blk) (ShelleyBlockLedgerEra blk) - , ProtoCrypto (BlockProtocol blk) ~ EraCrypto (ShelleyBlockLedgerEra blk) ) => IsShelleyBlock blk instance ( proto ~ BlockProtocol (ShelleyBlock proto era) @@ -151,7 +151,7 @@ type family ShelleyBlockLedgerEra blk where data instance Header (ShelleyBlock proto era) = ShelleyHeader { shelleyHeaderRaw :: !(ShelleyProtocolHeader proto) - , shelleyHeaderHash :: !(ShelleyHash (ProtoCrypto proto)) + , shelleyHeaderHash :: !ShelleyHash } deriving (Generic) @@ -216,14 +216,14 @@ instance ShelleyCompatible proto era => HasAnnTip (ShelleyBlock proto era) -------------------------------------------------------------------------------} -- | From @cardano-ledger-specs@ to @ouroboros-consensus@ -fromShelleyPrevHash :: EraCrypto era ~ ProtoCrypto proto => - SL.PrevHash (EraCrypto era) -> ChainHash (ShelleyBlock proto era) +fromShelleyPrevHash :: + SL.PrevHash -> ChainHash (ShelleyBlock proto era) fromShelleyPrevHash SL.GenesisHash = GenesisHash fromShelleyPrevHash (SL.BlockHash h) = BlockHash (ShelleyHash $ SL.unHashHeader h) -- | From @ouroboros-consensus@ to @cardano-ledger-specs@ -toShelleyPrevHash :: EraCrypto era ~ ProtoCrypto proto => - ChainHash (Header (ShelleyBlock proto era)) -> SL.PrevHash (EraCrypto era) +toShelleyPrevHash :: + ChainHash (Header (ShelleyBlock proto era)) -> SL.PrevHash toShelleyPrevHash GenesisHash = SL.GenesisHash toShelleyPrevHash (BlockHash (ShelleyHash h)) = SL.BlockHash $ SL.HashHeader h diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Config.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Config.hs index e174c06926..5df1f847cf 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Config.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Config.hs @@ -24,7 +24,6 @@ module Ouroboros.Consensus.Shelley.Ledger.Config ( ) where import Cardano.Ledger.Binary (FromCBOR, ToCBOR) -import Cardano.Ledger.Crypto (Crypto) import qualified Cardano.Ledger.Shelley.API as SL import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -36,7 +35,7 @@ import Ouroboros.Consensus.BlockchainTime import Ouroboros.Consensus.Config import Ouroboros.Consensus.Protocol.Praos.Common (VRFTiebreakerFlavor (..)) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto, isBeforeConway) +import Ouroboros.Consensus.Shelley.Eras (isBeforeConway) import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Network.Magic (NetworkMagic (..)) @@ -53,8 +52,8 @@ data instance BlockConfig (ShelleyBlock proto era) = ShelleyConfig { -- | For nodes that can produce blocks, this should be set to the -- verification key(s) corresponding to the node's signing key(s). For non -- block producing nodes, this can be set to the empty map. - , shelleyBlockIssuerVKeys :: !(Map (SL.KeyHash 'SL.BlockIssuer (EraCrypto era)) - (SL.VKey 'SL.BlockIssuer (EraCrypto era))) + , shelleyBlockIssuerVKeys :: !(Map (SL.KeyHash 'SL.BlockIssuer) + (SL.VKey 'SL.BlockIssuer)) , shelleyVRFTiebreakerFlavor :: !VRFTiebreakerFlavor } deriving stock (Generic) @@ -65,8 +64,8 @@ deriving instance ShelleyBasedEra era => NoThunks (BlockConfig (ShelleyBlock pro mkShelleyBlockConfig :: forall proto era. ShelleyBasedEra era => SL.ProtVer - -> SL.ShelleyGenesis (EraCrypto era) - -> [SL.VKey 'SL.BlockIssuer (EraCrypto era)] + -> SL.ShelleyGenesis + -> [SL.VKey 'SL.BlockIssuer] -> BlockConfig (ShelleyBlock proto era) mkShelleyBlockConfig protVer genesis blockIssuerVKeys = ShelleyConfig { shelleyProtocolVersion = protVer @@ -121,16 +120,14 @@ data instance StorageConfig (ShelleyBlock proto era) = ShelleyStorageConfig { -- -- * The 'sgStaking' field is erased. It is only used to register initial stake -- pools in tests and benchmarks. -newtype CompactGenesis c = CompactGenesis { - getCompactGenesis :: SL.ShelleyGenesis c - } +newtype CompactGenesis = CompactGenesis { getCompactGenesis :: SL.ShelleyGenesis } deriving stock (Eq, Show, Generic) deriving newtype (ToCBOR, FromCBOR) -deriving anyclass instance Crypto c => NoThunks (CompactGenesis c) +deriving anyclass instance NoThunks CompactGenesis -- | Compacts the given 'SL.ShelleyGenesis'. -compactGenesis :: SL.ShelleyGenesis c -> CompactGenesis c +compactGenesis :: SL.ShelleyGenesis -> CompactGenesis compactGenesis genesis = CompactGenesis $ genesis { SL.sgInitialFunds = mempty diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs index 465ce54514..90f7d42272 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs @@ -19,7 +19,6 @@ import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Protocol.Abstract (CanBeLeader, IsLeader) import Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Config (shelleyProtocolVersion) @@ -36,7 +35,7 @@ import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto, forgeShelleyBlock :: forall m era proto. (ShelleyCompatible proto era, Monad m) - => HotKey (EraCrypto era) m + => HotKey (ProtoCrypto proto) m -> CanBeLeader proto -> TopLevelConfig (ShelleyBlock proto era) -> BlockNo -- ^ Current block number @@ -73,9 +72,9 @@ forgeShelleyBlock extractTx :: Validated (GenTx (ShelleyBlock proto era)) -> Core.Tx era extractTx (ShelleyValidatedTx _txid vtx) = SL.extractTx vtx - prevHash :: SL.PrevHash (EraCrypto era) + prevHash :: SL.PrevHash prevHash = - toShelleyPrevHash @era @proto + toShelleyPrevHash @proto . castHash . getTipHash $ tickedLedger diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs index 380f97f562..45374b3e50 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs @@ -10,11 +10,12 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -22,7 +23,6 @@ module Ouroboros.Consensus.Shelley.Ledger.Ledger ( LedgerState (..) , ShelleyBasedEra - , ShelleyLedgerError (..) , ShelleyTip (..) , ShelleyTransition (..) , Ticked (..) @@ -31,6 +31,7 @@ module Ouroboros.Consensus.Shelley.Ledger.Ledger ( , shelleyTipToPoint -- * Ledger config , ShelleyLedgerConfig (..) + , ShelleyPartialLedgerConfig (..) , mkShelleyLedgerConfig , shelleyEraParams , shelleyEraParamsNeverHardForks @@ -48,11 +49,13 @@ module Ouroboros.Consensus.Shelley.Ledger.Ledger ( ) where import qualified Cardano.Ledger.BaseTypes as SL (epochInfoPure) +import Cardano.Ledger.BaseTypes.NonZero (unNonZero) import qualified Cardano.Ledger.BHeaderView as SL (BHeaderView) import Cardano.Ledger.Binary.Plain (FromCBOR (..), ToCBOR (..), enforceSize) import Cardano.Ledger.Core (Era, ppMaxBHSizeL, ppMaxTxSizeL) import qualified Cardano.Ledger.Core as Core +import qualified Cardano.Ledger.Core as SL import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.Governance as SL import qualified Cardano.Ledger.Shelley.LedgerState as SL @@ -62,13 +65,14 @@ import qualified Codec.CBOR.Decoding as CBOR import Codec.CBOR.Encoding (Encoding) import qualified Codec.CBOR.Encoding as CBOR import Codec.Serialise (decode, encode) -import Control.Arrow (left) +import Control.Arrow (left, second) import qualified Control.Exception as Exception import Control.Monad.Except import qualified Control.State.Transition.Extended as STS import Data.Coerce (coerce) import Data.Functor ((<&>)) import Data.Functor.Identity +import qualified Data.Text as T import qualified Data.Text as Text import Data.Word import GHC.Generics (Generic) @@ -78,14 +82,15 @@ import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime.WallClock.Types import Ouroboros.Consensus.Config import Ouroboros.Consensus.HardFork.Abstract +import Ouroboros.Consensus.HardFork.Combinator.PartialConfig import qualified Ouroboros.Consensus.HardFork.History as HardFork import Ouroboros.Consensus.HardFork.History.Util +import Ouroboros.Consensus.HardFork.Simple import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.CommonProtocolParams import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Protocol.Ledger.Util (isNewEpoch) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Config import Ouroboros.Consensus.Shelley.Ledger.Protocol () @@ -96,24 +101,12 @@ import Ouroboros.Consensus.Util.CBOR (decodeWithOrigin, encodeWithOrigin) import Ouroboros.Consensus.Util.Versioned -{------------------------------------------------------------------------------- - Ledger errors --------------------------------------------------------------------------------} - -newtype ShelleyLedgerError era = BBodyError (SL.BlockTransitionError era) - deriving (Generic) - -deriving instance ShelleyBasedEra era => Eq (ShelleyLedgerError era) -deriving instance ShelleyBasedEra era => Show (ShelleyLedgerError era) - -instance ShelleyBasedEra era => NoThunks (ShelleyLedgerError era) - {------------------------------------------------------------------------------- Config -------------------------------------------------------------------------------} data ShelleyLedgerConfig era = ShelleyLedgerConfig { - shelleyLedgerCompactGenesis :: !(CompactGenesis (EraCrypto era)) + shelleyLedgerCompactGenesis :: !CompactGenesis -- | Derived from 'shelleyLedgerGenesis' but we store a cached version -- because it used very often. , shelleyLedgerGlobals :: !SL.Globals @@ -124,11 +117,11 @@ data ShelleyLedgerConfig era = ShelleyLedgerConfig { deriving instance (NoThunks (Core.TranslationContext era), Era era) => NoThunks (ShelleyLedgerConfig era) -shelleyLedgerGenesis :: ShelleyLedgerConfig era -> SL.ShelleyGenesis (EraCrypto era) +shelleyLedgerGenesis :: ShelleyLedgerConfig era -> SL.ShelleyGenesis shelleyLedgerGenesis = getCompactGenesis . shelleyLedgerCompactGenesis shelleyEraParams :: - SL.ShelleyGenesis c + SL.ShelleyGenesis -> HardFork.EraParams shelleyEraParams genesis = HardFork.EraParams { eraEpochSize = SL.sgEpochLength genesis @@ -139,11 +132,11 @@ shelleyEraParams genesis = HardFork.EraParams { where stabilityWindow = SL.computeStabilityWindow - (SL.sgSecurityParam genesis) + (unNonZero $ SL.sgSecurityParam genesis) (SL.sgActiveSlotCoeff genesis) -- | Separate variant of 'shelleyEraParams' to be used for a Shelley-only chain. -shelleyEraParamsNeverHardForks :: SL.ShelleyGenesis c -> HardFork.EraParams +shelleyEraParamsNeverHardForks :: SL.ShelleyGenesis -> HardFork.EraParams shelleyEraParamsNeverHardForks genesis = HardFork.EraParams { eraEpochSize = SL.sgEpochLength genesis , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis @@ -153,11 +146,11 @@ shelleyEraParamsNeverHardForks genesis = HardFork.EraParams { where stabilityWindow = SL.computeStabilityWindow - (SL.sgSecurityParam genesis) + (unNonZero $ SL.sgSecurityParam genesis) (SL.sgActiveSlotCoeff genesis) mkShelleyLedgerConfig :: - SL.ShelleyGenesis (EraCrypto era) + SL.ShelleyGenesis -> Core.TranslationContext era -> EpochInfo (Except HardFork.PastHorizonException) -> ShelleyLedgerConfig era @@ -173,6 +166,36 @@ mkShelleyLedgerConfig genesis transCtxt epochInfo = type instance LedgerCfg (LedgerState (ShelleyBlock proto era)) = ShelleyLedgerConfig era +data ShelleyPartialLedgerConfig era = ShelleyPartialLedgerConfig { + -- | We cache the non-partial ledger config containing a dummy + -- 'EpochInfo' that needs to be replaced with the correct one. + -- + -- We do this to avoid recomputing the ledger config each time + -- 'completeLedgerConfig' is called, as 'mkShelleyLedgerConfig' does + -- some rather expensive computations that shouldn't be repeated too + -- often (e.g., 'sgActiveSlotCoeff'). + shelleyLedgerConfig :: !(ShelleyLedgerConfig era) + , shelleyTriggerHardFork :: !TriggerHardFork + } + deriving (Generic) + +deriving instance (NoThunks (SL.TranslationContext era), SL.Era era) => + NoThunks (ShelleyPartialLedgerConfig era) + +instance ShelleyCompatible proto era => HasPartialLedgerConfig (ShelleyBlock proto era) where + type PartialLedgerConfig (ShelleyBlock proto era) = ShelleyPartialLedgerConfig era + + -- Replace the dummy 'EpochInfo' with the real one + completeLedgerConfig _ epochInfo (ShelleyPartialLedgerConfig cfg _) = + cfg { + shelleyLedgerGlobals = (shelleyLedgerGlobals cfg) { + SL.epochInfo = + hoistEpochInfo + (runExcept . withExceptT (T.pack . show)) + epochInfo + } + } + {------------------------------------------------------------------------------- LedgerState -------------------------------------------------------------------------------} @@ -189,9 +212,7 @@ shelleyTipToPoint Origin = GenesisPoint shelleyTipToPoint (NotOrigin tip) = BlockPoint (shelleyTipSlotNo tip) (shelleyTipHash tip) -castShelleyTip :: - HeaderHash (ShelleyBlock proto era) ~ HeaderHash (ShelleyBlock proto' era') - => ShelleyTip proto era -> ShelleyTip proto' era' +castShelleyTip :: ShelleyTip proto era -> ShelleyTip proto' era' castShelleyTip (ShelleyTip sn bn hh) = ShelleyTip { shelleyTipSlotNo = sn , shelleyTipBlockNo = bn @@ -275,16 +296,16 @@ untickedShelleyLedgerTipPoint :: untickedShelleyLedgerTipPoint = shelleyTipToPoint . untickedShelleyLedgerTip instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock proto era)) where - type LedgerErr (LedgerState (ShelleyBlock proto era)) = ShelleyLedgerError era + type LedgerErr (LedgerState (ShelleyBlock proto era)) = SL.BlockTransitionError era type AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) = ShelleyLedgerEvent era - applyChainTickLedgerResult cfg slotNo ShelleyLedgerState{ + applyChainTickLedgerResult evs cfg slotNo ShelleyLedgerState{ shelleyLedgerTip , shelleyLedgerState , shelleyLedgerTransition } = - swizzle appTick <&> \l' -> + appTick globals shelleyLedgerState slotNo <&> \l' -> TickedShelleyLedgerState { untickedShelleyLedgerTip = shelleyLedgerTip @@ -302,22 +323,14 @@ instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock proto era)) ei :: EpochInfo Identity ei = SL.epochInfoPure globals - swizzle (l, events) = - LedgerResult { - lrEvents = map ShelleyLedgerEventTICK events - , lrResult = l - } - appTick = - SL.applyTickOpts - STS.ApplySTSOpts { - asoAssertions = STS.globalAssertionPolicy - , asoValidation = STS.ValidateAll - , asoEvents = STS.EPReturn - } - globals - shelleyLedgerState - slotNo + uncurry (flip LedgerResult) ..: case evs of + ComputeLedgerEvents -> + second (map ShelleyLedgerEventTICK) ..: + SL.applyTick STS.EPReturn + OmitLedgerEvents -> + (,[]) ..: SL.applyTickNoEvents + -- | All events emitted by the Shelley ledger API data ShelleyLedgerEvent era = @@ -338,45 +351,24 @@ instance ShelleyCompatible proto era -- - 'updateChainDepState': executes the @PRTCL@ transition -- + 'applyBlockLedgerResult': executes the @BBODY@ transition -- - applyBlockLedgerResult = - applyHelper (swizzle ..: appBlk) + applyBlockLedgerResultWithValidation doValidate evs = + liftEither ..: applyHelper appBlk where - swizzle m = - withExcept BBodyError m <&> \(l, events) -> - LedgerResult { - lrEvents = map ShelleyLedgerEventBBODY events - , lrResult = l - } - -- Apply the BBODY transition using the ticked state appBlk = - SL.applyBlockOpts - STS.ApplySTSOpts { - asoAssertions = STS.globalAssertionPolicy - , asoValidation = STS.ValidateAll - , asoEvents = STS.EPReturn - } + fmap (uncurry (flip LedgerResult)) ..: case evs of + ComputeLedgerEvents -> + fmap (second (map ShelleyLedgerEventBBODY)) ..: + SL.applyBlockEither STS.EPReturn doValidate + OmitLedgerEvents -> + fmap (,[]) ..: + SL.applyBlockEitherNoEvents doValidate - reapplyBlockLedgerResult = - runIdentity ..: applyHelper (swizzle ..: reappBlk) - where - swizzle m = case runExcept m of - Left err -> - Exception.throw $! ShelleyReapplyException @era err - Right (l, events) -> - pure LedgerResult { - lrEvents = map ShelleyLedgerEventBBODY events - , lrResult = l - } - -- Reapply the BBODY transition using the ticked state - reappBlk = - SL.applyBlockOpts - STS.ApplySTSOpts { - asoAssertions = STS.AssertionsOff - , asoValidation = STS.ValidateNone - , asoEvents = STS.EPReturn - } + applyBlockLedgerResult = defaultApplyBlockLedgerResult + + reapplyBlockLedgerResult = + defaultReapplyBlockLedgerResult (\err -> Exception.throw $! ShelleyReapplyException @era err) data ShelleyReapplyException = forall era. Show (SL.BlockTransitionError era) @@ -388,11 +380,13 @@ instance Show ShelleyReapplyException where instance Exception.Exception ShelleyReapplyException where applyHelper :: - (ShelleyCompatible proto era, Monad m) + ShelleyCompatible proto era => ( SL.Globals -> SL.NewEpochState era - -> SL.Block (SL.BHeaderView (EraCrypto era)) era - -> m (LedgerResult + -> SL.Block SL.BHeaderView era + -> Either + (SL.BlockTransitionError era) + (LedgerResult (LedgerState (ShelleyBlock proto era)) (SL.NewEpochState era) ) @@ -400,7 +394,9 @@ applyHelper :: -> LedgerConfig (ShelleyBlock proto era) -> ShelleyBlock proto era -> Ticked (LedgerState (ShelleyBlock proto era)) - -> m (LedgerResult + -> Either + (SL.BlockTransitionError era) + (LedgerResult (LedgerState (ShelleyBlock proto era)) (LedgerState (ShelleyBlock proto era))) applyHelper f cfg blk TickedShelleyLedgerState{ @@ -417,7 +413,7 @@ applyHelper f cfg blk TickedShelleyLedgerState{ -- means the value must not be serialized. We're only passing it to -- 'STS.applyBlockOpts', which does not serialize it. So this is a -- safe use. - in SL.UnsafeUnserialisedBlock h' (SL.bbody b) + in SL.Block h' (SL.bbody b) ) return $ ledgerResult <&> \newNewEpochState -> ShelleyLedgerState { @@ -502,14 +498,10 @@ getPParams = view $ SL.newEpochStateGovStateL . SL.curPParamsGovStateL serialisationFormatVersion2 :: VersionNumber serialisationFormatVersion2 = 2 -encodeShelleyAnnTip :: - ShelleyCompatible proto era - => AnnTip (ShelleyBlock proto era) -> Encoding +encodeShelleyAnnTip :: AnnTip (ShelleyBlock proto era) -> Encoding encodeShelleyAnnTip = defaultEncodeAnnTip toCBOR -decodeShelleyAnnTip :: - ShelleyCompatible proto era - => Decoder s (AnnTip (ShelleyBlock proto era)) +decodeShelleyAnnTip :: Decoder s (AnnTip (ShelleyBlock proto era)) decodeShelleyAnnTip = defaultDecodeAnnTip fromCBOR encodeShelleyHeaderState :: @@ -520,7 +512,7 @@ encodeShelleyHeaderState = encodeHeaderState encode encodeShelleyAnnTip -encodeShelleyTip :: ShelleyCompatible proto era => ShelleyTip proto era -> Encoding +encodeShelleyTip :: ShelleyTip proto era -> Encoding encodeShelleyTip ShelleyTip { shelleyTipSlotNo , shelleyTipBlockNo @@ -532,7 +524,7 @@ encodeShelleyTip ShelleyTip { , encode shelleyTipHash ] -decodeShelleyTip :: ShelleyCompatible proto era => Decoder s (ShelleyTip proto era) +decodeShelleyTip :: Decoder s (ShelleyTip proto era) decodeShelleyTip = do enforceSize "ShelleyTip" 3 shelleyTipSlotNo <- decode diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs index b7ed4a3040..1865e2a4e6 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs @@ -41,7 +41,7 @@ import qualified Cardano.Ledger.Allegra.Rules as AllegraEra import Cardano.Ledger.Alonzo.Core (Tx, TxSeq, bodyTxL, eraDecoder, fromTxSeq, ppMaxBBSizeL, ppMaxBlockExUnitsL, sizeTxF) import qualified Cardano.Ledger.Alonzo.Rules as AlonzoEra -import Cardano.Ledger.Alonzo.Scripts (ExUnits, ExUnits', +import Cardano.Ledger.Alonzo.Scripts (ExUnits, ExUnits' (..), pointWiseExUnits, unWrapExUnits) import Cardano.Ledger.Alonzo.Tx (totExUnits) import qualified Cardano.Ledger.Api as L @@ -54,10 +54,10 @@ import qualified Cardano.Ledger.Conway.Rules as ConwayEra import qualified Cardano.Ledger.Conway.Rules as SL import qualified Cardano.Ledger.Conway.UTxO as SL import qualified Cardano.Ledger.Core as SL (txIdTxBody) -import Cardano.Ledger.Crypto (Crypto) -import qualified Cardano.Ledger.SafeHash as SL +import qualified Cardano.Ledger.Hashes as SL import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.Rules as ShelleyEra +import Cardano.Protocol.Crypto (Crypto) import Control.Arrow ((+++)) import Control.Monad (guard) import Control.Monad.Except (Except, liftEither) @@ -80,11 +80,12 @@ import Ouroboros.Consensus.Shelley.Ledger.Ledger (ShelleyLedgerConfig (shelleyLedgerGlobals), Ticked (TickedShelleyLedgerState, tickedShelleyLedgerState), getPParams) +import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Ouroboros.Consensus.Util (ShowProxy (..)) import Ouroboros.Consensus.Util.Condense import Ouroboros.Network.Block (unwrapCBORinCBOR, wrapCBORinCBOR) -data instance GenTx (ShelleyBlock proto era) = ShelleyTx !(SL.TxId (EraCrypto era)) !(Tx era) +data instance GenTx (ShelleyBlock proto era) = ShelleyTx !SL.TxId !(Tx era) deriving stock (Generic) deriving instance ShelleyBasedEra era => NoThunks (GenTx (ShelleyBlock proto era)) @@ -96,7 +97,7 @@ instance (Typeable era, Typeable proto) data instance Validated (GenTx (ShelleyBlock proto era)) = ShelleyValidatedTx - !(SL.TxId (EraCrypto era)) + !SL.TxId !(SL.Validated (Tx era)) deriving stock (Generic) @@ -160,12 +161,12 @@ mkShelleyValidatedTx vtx = ShelleyValidatedTx txid vtx where txid = SL.txIdTxBody @era (SL.extractTx vtx ^. bodyTxL) -newtype instance TxId (GenTx (ShelleyBlock proto era)) = ShelleyTxId (SL.TxId (EraCrypto era)) +newtype instance TxId (GenTx (ShelleyBlock proto era)) = ShelleyTxId SL.TxId deriving newtype (Eq, Ord, NoThunks) -deriving newtype instance (Crypto (EraCrypto era), Typeable era, Typeable proto) +deriving newtype instance (Typeable era, Typeable proto, Crypto (ProtoCrypto proto)) => EncCBOR (TxId (GenTx (ShelleyBlock proto era))) -deriving newtype instance (Crypto (EraCrypto era), Typeable era, Typeable proto) +deriving newtype instance (Typeable era, Typeable proto, Crypto (ProtoCrypto proto)) => DecCBOR (TxId (GenTx (ShelleyBlock proto era))) instance (Typeable era, Typeable proto) @@ -256,6 +257,7 @@ reapplyShelleyTx :: -> Except (ApplyTxErr (ShelleyBlock proto era)) (TickedLedgerState (ShelleyBlock proto era)) reapplyShelleyTx cfg slot vgtx st = do mempoolState' <- + liftEither $ SL.reapplyTx (shelleyLedgerGlobals cfg) (SL.mkMempoolEnv innerSt slot) @@ -343,7 +345,7 @@ class MaxTxSizeUTxO era where -- ^ Maximum transaction size -> SL.ApplyTxError era -instance MaxTxSizeUTxO (ShelleyEra c) where +instance MaxTxSizeUTxO ShelleyEra where maxTxSizeUTxO txSize txSizeLimit = SL.ApplyTxError . pure $ ShelleyEra.UtxowFailure @@ -352,7 +354,7 @@ instance MaxTxSizeUTxO (ShelleyEra c) where $ L.Mismatch { mismatchSupplied = txSize , mismatchExpected = txSizeLimit } -instance MaxTxSizeUTxO (AllegraEra c) where +instance MaxTxSizeUTxO AllegraEra where maxTxSizeUTxO txSize txSizeLimit = SL.ApplyTxError . pure $ ShelleyEra.UtxowFailure @@ -361,7 +363,7 @@ instance MaxTxSizeUTxO (AllegraEra c) where $ L.Mismatch { mismatchSupplied = txSize , mismatchExpected = txSizeLimit } -instance MaxTxSizeUTxO (MaryEra c) where +instance MaxTxSizeUTxO MaryEra where maxTxSizeUTxO txSize txSizeLimit = SL.ApplyTxError . pure $ ShelleyEra.UtxowFailure @@ -370,7 +372,7 @@ instance MaxTxSizeUTxO (MaryEra c) where $ L.Mismatch { mismatchSupplied = txSize , mismatchExpected = txSizeLimit } -instance MaxTxSizeUTxO (AlonzoEra c) where +instance MaxTxSizeUTxO AlonzoEra where maxTxSizeUTxO txSize txSizeLimit = SL.ApplyTxError . pure $ ShelleyEra.UtxowFailure @@ -380,7 +382,7 @@ instance MaxTxSizeUTxO (AlonzoEra c) where $ L.Mismatch { mismatchSupplied = txSize , mismatchExpected = txSizeLimit } -instance MaxTxSizeUTxO (BabbageEra c) where +instance MaxTxSizeUTxO BabbageEra where maxTxSizeUTxO txSize txSizeLimit = SL.ApplyTxError . pure $ ShelleyEra.UtxowFailure @@ -390,7 +392,7 @@ instance MaxTxSizeUTxO (BabbageEra c) where $ L.Mismatch { mismatchSupplied = txSize , mismatchExpected = txSizeLimit } -instance MaxTxSizeUTxO (ConwayEra c) where +instance MaxTxSizeUTxO ConwayEra where maxTxSizeUTxO txSize txSizeLimit = SL.ApplyTxError . pure $ ConwayEra.ConwayUtxowFailure @@ -401,18 +403,18 @@ instance MaxTxSizeUTxO (ConwayEra c) where ----- -instance ShelleyCompatible p (ShelleyEra c) => TxLimits (ShelleyBlock p (ShelleyEra c)) where - type TxMeasure (ShelleyBlock p (ShelleyEra c)) = IgnoringOverflow ByteSize32 +instance ShelleyCompatible p ShelleyEra => TxLimits (ShelleyBlock p ShelleyEra) where + type TxMeasure (ShelleyBlock p ShelleyEra) = IgnoringOverflow ByteSize32 txMeasure _cfg st tx = runValidation $ txInBlockSize st tx blockCapacityTxMeasure _cfg = txsMaxBytes -instance ShelleyCompatible p (AllegraEra c) => TxLimits (ShelleyBlock p (AllegraEra c)) where - type TxMeasure (ShelleyBlock p (AllegraEra c)) = IgnoringOverflow ByteSize32 +instance ShelleyCompatible p AllegraEra => TxLimits (ShelleyBlock p AllegraEra) where + type TxMeasure (ShelleyBlock p AllegraEra) = IgnoringOverflow ByteSize32 txMeasure _cfg st tx = runValidation $ txInBlockSize st tx blockCapacityTxMeasure _cfg = txsMaxBytes -instance ShelleyCompatible p (MaryEra c) => TxLimits (ShelleyBlock p (MaryEra c)) where - type TxMeasure (ShelleyBlock p (MaryEra c)) = IgnoringOverflow ByteSize32 +instance ShelleyCompatible p MaryEra => TxLimits (ShelleyBlock p MaryEra) where + type TxMeasure (ShelleyBlock p MaryEra) = IgnoringOverflow ByteSize32 txMeasure _cfg st tx = runValidation $ txInBlockSize st tx blockCapacityTxMeasure _cfg = txsMaxBytes @@ -429,6 +431,20 @@ data AlonzoMeasure = AlonzoMeasure { instance HasByteSize AlonzoMeasure where txMeasureByteSize = unIgnoringOverflow . byteSize +instance Semigroup AlonzoMeasure where + AlonzoMeasure b1 e1 <> AlonzoMeasure b2 e2 = + AlonzoMeasure (b1 <> b2) (e1 <> e2) + +instance Monoid AlonzoMeasure where + mappend = (<>) + mempty = AlonzoMeasure mempty mempty + +instance TxMeasureMetrics AlonzoMeasure where + txMeasureMetricTxSizeBytes = txMeasureMetricTxSizeBytes . byteSize + txMeasureMetricExUnitsMemory = exUnitsMem' . exUnits + txMeasureMetricExUnitsSteps = exUnitsSteps' . exUnits + txMeasureMetricRefScriptsSizeBytes _ = mempty + fromExUnits :: ExUnits -> ExUnits' Natural fromExUnits = unWrapExUnits @@ -472,7 +488,7 @@ txMeasureAlonzo st tx@(ShelleyTx _txid tx') = class ExUnitsTooBigUTxO era where exUnitsTooBigUTxO :: ExUnits -> ExUnits -> SL.ApplyTxError era -instance Crypto c => ExUnitsTooBigUTxO (AlonzoEra c) where +instance ExUnitsTooBigUTxO AlonzoEra where exUnitsTooBigUTxO txsz limit = SL.ApplyTxError . pure $ ShelleyEra.UtxowFailure @@ -482,7 +498,7 @@ instance Crypto c => ExUnitsTooBigUTxO (AlonzoEra c) where $ L.Mismatch { mismatchSupplied = txsz , mismatchExpected = limit } -instance Crypto c => ExUnitsTooBigUTxO (BabbageEra c) where +instance ExUnitsTooBigUTxO BabbageEra where exUnitsTooBigUTxO txsz limit = SL.ApplyTxError . pure $ ShelleyEra.UtxowFailure @@ -494,7 +510,7 @@ instance Crypto c => ExUnitsTooBigUTxO (BabbageEra c) where $ L.Mismatch { mismatchSupplied = txsz , mismatchExpected = limit } -instance Crypto c => ExUnitsTooBigUTxO (ConwayEra c) where +instance ExUnitsTooBigUTxO ConwayEra where exUnitsTooBigUTxO txsz limit = SL.ApplyTxError . pure $ ConwayEra.ConwayUtxowFailure @@ -505,10 +521,10 @@ instance Crypto c => ExUnitsTooBigUTxO (ConwayEra c) where ----- -instance ( ShelleyCompatible p (AlonzoEra c) - ) => TxLimits (ShelleyBlock p (AlonzoEra c)) where +instance ( ShelleyCompatible p AlonzoEra + ) => TxLimits (ShelleyBlock p AlonzoEra) where - type TxMeasure (ShelleyBlock p (AlonzoEra c)) = AlonzoMeasure + type TxMeasure (ShelleyBlock p AlonzoEra) = AlonzoMeasure txMeasure _cfg st tx = runValidation $ txMeasureAlonzo st tx blockCapacityTxMeasure _cfg = blockCapacityAlonzoMeasure @@ -522,9 +538,24 @@ data ConwayMeasure = ConwayMeasure { deriving (Measure) via (InstantiatedAt Generic ConwayMeasure) +instance Semigroup ConwayMeasure where + ConwayMeasure a1 r1 <> ConwayMeasure a2 r2 = + ConwayMeasure (a1 <> a2) (r1 <> r2) + +instance Monoid ConwayMeasure where + mappend = (<>) + mempty = ConwayMeasure mempty mempty + instance HasByteSize ConwayMeasure where txMeasureByteSize = txMeasureByteSize . alonzoMeasure +instance TxMeasureMetrics ConwayMeasure where + txMeasureMetricTxSizeBytes = txMeasureMetricTxSizeBytes . alonzoMeasure + txMeasureMetricExUnitsMemory = txMeasureMetricExUnitsMemory . alonzoMeasure + txMeasureMetricExUnitsSteps = txMeasureMetricExUnitsSteps . alonzoMeasure + txMeasureMetricRefScriptsSizeBytes = + unIgnoringOverflow . refScriptsSize + blockCapacityConwayMeasure :: forall proto era. ( ShelleyCompatible proto era @@ -569,7 +600,7 @@ txMeasureConway st tx@(ShelleyTx _txid tx') = class TxRefScriptsSizeTooBig era where txRefScriptsSizeTooBig :: Int -> Int -> SL.ApplyTxError era -instance Crypto c => TxRefScriptsSizeTooBig (ConwayEra c) where +instance TxRefScriptsSizeTooBig ConwayEra where txRefScriptsSizeTooBig txsz limit = SL.ApplyTxError . pure $ ConwayEra.ConwayTxRefScriptsSizeTooBig @@ -604,16 +635,16 @@ txMeasureBabbage st tx@(ShelleyTx _txid tx') = $ fromIntegral (SL.txNonDistinctRefScriptsSize utxo tx' :: Int) -- | We anachronistically use 'ConwayMeasure' in Babbage. -instance ( ShelleyCompatible p (BabbageEra c) - ) => TxLimits (ShelleyBlock p (BabbageEra c)) where +instance ( ShelleyCompatible p BabbageEra + ) => TxLimits (ShelleyBlock p BabbageEra) where - type TxMeasure (ShelleyBlock p (BabbageEra c)) = ConwayMeasure + type TxMeasure (ShelleyBlock p BabbageEra) = ConwayMeasure txMeasure _cfg st tx = runValidation $ txMeasureBabbage st tx blockCapacityTxMeasure _cfg = blockCapacityConwayMeasure -instance ( ShelleyCompatible p (ConwayEra c) - ) => TxLimits (ShelleyBlock p (ConwayEra c)) where +instance ( ShelleyCompatible p ConwayEra + ) => TxLimits (ShelleyBlock p ConwayEra) where - type TxMeasure (ShelleyBlock p (ConwayEra c)) = ConwayMeasure + type TxMeasure (ShelleyBlock p ConwayEra) = ConwayMeasure txMeasure _cfg st tx = runValidation $ txMeasureConway st tx blockCapacityTxMeasure _cfg = blockCapacityConwayMeasure diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs index 957bddce67..73a219fc95 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs @@ -26,6 +26,9 @@ data ShelleyNodeToClientVersion = -- | New queries introduced: GetBigLedgerPeerSnapshot | ShelleyNodeToClientVersion11 + + -- | New queries introduced: QueryStakePoolDefaultVote + | ShelleyNodeToClientVersion12 deriving (Show, Eq, Ord, Enum, Bounded) instance HasNetworkProtocolVersion (ShelleyBlock proto era) where @@ -43,6 +46,7 @@ instance SupportedNetworkProtocolVersion (ShelleyBlock proto era) where , (NodeToClientV_17, ShelleyNodeToClientVersion9) , (NodeToClientV_18, ShelleyNodeToClientVersion10) , (NodeToClientV_19, ShelleyNodeToClientVersion11) + , (NodeToClientV_20, ShelleyNodeToClientVersion12) ] latestReleasedNodeVersion = latestReleasedNodeVersionDefault diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/PeerSelection.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/PeerSelection.hs index ec8737fbf2..9ee7d48da8 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/PeerSelection.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/PeerSelection.hs @@ -3,7 +3,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -11,7 +10,6 @@ module Ouroboros.Consensus.Shelley.Ledger.PeerSelection () where import Cardano.Ledger.BaseTypes import qualified Cardano.Ledger.Keys as SL -import qualified Cardano.Ledger.PoolDistr as SL import qualified Cardano.Ledger.Shelley.API as SL import Control.DeepSeq (force) import Data.Bifunctor (second) @@ -24,25 +22,24 @@ import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, mapMaybe) import Data.Ord (Down (..)) import Data.Text.Encoding (encodeUtf8) +import Lens.Micro.Extras (view) import Ouroboros.Consensus.Ledger.SupportsPeerSelection -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Ledger -instance c ~ EraCrypto era - => LedgerSupportsPeerSelection (ShelleyBlock proto era) where +instance SL.EraCertState era => LedgerSupportsPeerSelection (ShelleyBlock proto era) where getPeers ShelleyLedgerState { shelleyLedgerState } = catMaybes [ (poolStake,) <$> Map.lookup stakePool poolRelayAccessPoints | (stakePool, poolStake) <- orderByStake poolDistr ] where - poolDistr :: SL.PoolDistr c + poolDistr :: SL.PoolDistr poolDistr = SL.nesPd shelleyLedgerState -- | Sort stake pools by descending stake orderByStake :: - SL.PoolDistr c - -> [(SL.KeyHash 'SL.StakePool c, PoolStake)] + SL.PoolDistr + -> [(SL.KeyHash 'SL.StakePool, PoolStake)] orderByStake = sortOn (Down . snd) . map (second (PoolStake . SL.individualPoolStake)) @@ -50,13 +47,13 @@ instance c ~ EraCrypto era . SL.unPoolDistr futurePoolParams, poolParams :: - Map (SL.KeyHash 'SL.StakePool c) (SL.PoolParams c) + Map (SL.KeyHash 'SL.StakePool) SL.PoolParams (futurePoolParams, poolParams) = (SL.psFutureStakePoolParams pstate, SL.psStakePoolParams pstate) where pstate :: SL.PState era pstate = - SL.certPState + view SL.certPStateL . SL.lsCertState . SL.esLState . SL.nesEs @@ -79,7 +76,7 @@ instance c ~ EraCrypto era -- | Note that a stake pool can have multiple registered relays pparamsRelayAccessPoints :: (RelayAccessPoint -> StakePoolRelay) - -> SL.PoolParams c + -> SL.PoolParams -> Maybe (NonEmpty StakePoolRelay) pparamsRelayAccessPoints injStakePoolRelay = NE.nonEmpty @@ -91,7 +88,7 @@ instance c ~ EraCrypto era -- | Combine the stake pools registered in the future and the current pool -- parameters, and remove duplicates. poolRelayAccessPoints :: - Map (SL.KeyHash 'SL.StakePool c) (NonEmpty StakePoolRelay) + Map (SL.KeyHash 'SL.StakePool) (NonEmpty StakePoolRelay) poolRelayAccessPoints = Map.unionWith (\futureRelays currentRelays -> NE.nub (futureRelays <> currentRelays)) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs index 06c4bc0ebd..9f7ddd9852 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs @@ -14,7 +14,6 @@ import qualified Cardano.Ledger.Shelley.API as SL import Ouroboros.Consensus.Block import Ouroboros.Consensus.Protocol.Signed import Ouroboros.Consensus.Protocol.TPraos -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Config (BlockConfig (..)) import Ouroboros.Consensus.Shelley.Protocol.Abstract @@ -38,7 +37,7 @@ instance ShelleyCompatible proto era => BlockSupportsProtocol (ShelleyBlock prot , csvTieBreakVRF = pTieBreakVRFValue shdr } where - hdrIssuer :: SL.VKey 'SL.BlockIssuer (EraCrypto era) + hdrIssuer :: SL.VKey 'SL.BlockIssuer hdrIssuer = pHeaderIssuer shdr projectChainOrderConfig = shelleyVRFTiebreakerFlavor diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs index e48b281ecd..9e2b2394fa 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs @@ -16,6 +16,7 @@ {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE UndecidableInstances #-} module Ouroboros.Consensus.Shelley.Ledger.Query ( BlockQuery (..) @@ -39,19 +40,16 @@ import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Compactible (Compactible (fromCompact)) import qualified Cardano.Ledger.Conway.Governance as CG import Cardano.Ledger.Credential (StakeCredential) -import Cardano.Ledger.Crypto (Crypto) -import qualified Cardano.Ledger.EpochBoundary as SL import Cardano.Ledger.Keys (KeyHash, KeyRole (..)) import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.Core as LC import Cardano.Ledger.Shelley.LedgerState (AccountState) -import qualified Cardano.Ledger.Shelley.LedgerState as SL (RewardAccounts, - newEpochStateGovStateL) -import qualified Cardano.Ledger.Shelley.PParams as SL (emptyPPPUpdates) import qualified Cardano.Ledger.Shelley.RewardProvenance as SL (RewardProvenance) +import qualified Cardano.Ledger.State as SL import Cardano.Ledger.UMap (UMap (..), rdReward, umElemDRep, umElemRDPair, umElemSPool) +import Cardano.Protocol.Crypto (Crypto) import Codec.CBOR.Decoding (Decoder) import qualified Codec.CBOR.Decoding as CBOR import Codec.CBOR.Encoding (Encoding) @@ -62,7 +60,6 @@ import Data.Bifunctor (second) import Data.Kind (Type) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe) import Data.Sequence (Seq (..)) import Data.Set (Set) import qualified Data.Set as Set @@ -79,7 +76,6 @@ import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.Query import Ouroboros.Consensus.Ledger.SupportsPeerSelection import Ouroboros.Consensus.Protocol.Abstract (ChainDepState) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import qualified Ouroboros.Consensus.Shelley.Eras as SE import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Config @@ -99,21 +95,17 @@ import Ouroboros.Network.PeerSelection.LedgerPeers.Utils QueryLedger -------------------------------------------------------------------------------} -newtype NonMyopicMemberRewards c = NonMyopicMemberRewards { +newtype NonMyopicMemberRewards = NonMyopicMemberRewards { unNonMyopicMemberRewards :: - Map (Either SL.Coin (SL.Credential 'SL.Staking c)) - (Map (SL.KeyHash 'SL.StakePool c) SL.Coin) + Map (Either SL.Coin (SL.Credential 'SL.Staking)) + (Map (SL.KeyHash 'SL.StakePool) SL.Coin) } deriving stock (Show) deriving newtype (Eq, ToCBOR, FromCBOR) -type Delegations c = - Map (SL.Credential 'SL.Staking c) - (SL.KeyHash 'SL.StakePool c) +type Delegations = Map (SL.Credential 'SL.Staking) (SL.KeyHash 'SL.StakePool) -type VoteDelegatees c = - Map (SL.Credential 'SL.Staking c) - (SL.DRep c) +type VoteDelegatees = Map (SL.Credential 'SL.Staking) SL.DRep data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where GetLedgerTip :: BlockQuery (ShelleyBlock proto era) (Point (ShelleyBlock proto era)) @@ -121,12 +113,10 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -- | Calculate the Non-Myopic Pool Member Rewards for a set of -- credentials. See 'SL.getNonMyopicMemberRewards' GetNonMyopicMemberRewards - :: Set (Either SL.Coin (SL.Credential 'SL.Staking (EraCrypto era))) - -> BlockQuery (ShelleyBlock proto era) (NonMyopicMemberRewards (EraCrypto era)) + :: Set (Either SL.Coin (SL.Credential 'SL.Staking)) + -> BlockQuery (ShelleyBlock proto era) NonMyopicMemberRewards GetCurrentPParams :: BlockQuery (ShelleyBlock proto era) (LC.PParams era) - GetProposedPParamsUpdates - :: BlockQuery (ShelleyBlock proto era) (SL.ProposedPPUpdates era) -- | This gets the stake distribution, but not in terms of _active_ stake -- (which we need for the leader schedule), but rather in terms of _total_ -- stake, which is relevant for rewards. It is used by the wallet to show @@ -134,7 +124,7 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -- an endpoint that provides all the information that the wallet wants about -- pools, in an extensible fashion. GetStakeDistribution - :: BlockQuery (ShelleyBlock proto era) (PoolDistr (EraCrypto era)) + :: BlockQuery (ShelleyBlock proto era) (PoolDistr (ProtoCrypto proto)) -- | Get a subset of the UTxO, filtered by address. Although this will -- typically return a lot less data than 'GetUTxOWhole', it requires a linear @@ -143,7 +133,7 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -- Only 'GetUTxOByTxIn' is efficient in time and space. -- GetUTxOByAddress - :: Set (SL.Addr (EraCrypto era)) + :: Set SL.Addr -> BlockQuery (ShelleyBlock proto era) (SL.UTxO era) -- | Get the /entire/ UTxO. This is only suitable for debug/testing purposes @@ -175,12 +165,12 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -> BlockQuery (ShelleyBlock proto era) (Serialised result) GetFilteredDelegationsAndRewardAccounts - :: Set (SL.Credential 'SL.Staking (EraCrypto era)) + :: Set (SL.Credential 'SL.Staking) -> BlockQuery (ShelleyBlock proto era) - (Delegations (EraCrypto era), SL.RewardAccounts (EraCrypto era)) + (Delegations, Map (SL.Credential 'Staking) Coin) GetGenesisConfig - :: BlockQuery (ShelleyBlock proto era) (CompactGenesis (EraCrypto era)) + :: BlockQuery (ShelleyBlock proto era) CompactGenesis -- | Only for debugging purposes, we make no effort to ensure binary -- compatibility (cf the comment on 'GetCBOR'). Moreover, it is huge. @@ -193,50 +183,49 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where :: BlockQuery (ShelleyBlock proto era) (ChainDepState proto) GetRewardProvenance - :: BlockQuery (ShelleyBlock proto era) (SL.RewardProvenance (EraCrypto era)) + :: BlockQuery (ShelleyBlock proto era) SL.RewardProvenance -- | Get a subset of the UTxO, filtered by transaction input. This is -- efficient and costs only O(m * log n) for m inputs and a UTxO of size n. -- GetUTxOByTxIn - :: Set (SL.TxIn (EraCrypto era)) + :: Set SL.TxIn -> BlockQuery (ShelleyBlock proto era) (SL.UTxO era) GetStakePools :: BlockQuery (ShelleyBlock proto era) - (Set (SL.KeyHash 'SL.StakePool (EraCrypto era))) + (Set (SL.KeyHash 'SL.StakePool)) GetStakePoolParams - :: Set (SL.KeyHash 'SL.StakePool (EraCrypto era)) + :: Set (SL.KeyHash 'SL.StakePool) -> BlockQuery (ShelleyBlock proto era) - (Map (SL.KeyHash 'SL.StakePool (EraCrypto era)) - (SL.PoolParams (EraCrypto era))) + (Map (SL.KeyHash 'SL.StakePool) SL.PoolParams) GetRewardInfoPools :: BlockQuery (ShelleyBlock proto era) (SL.RewardParams, - Map (SL.KeyHash 'SL.StakePool (EraCrypto era)) + Map (SL.KeyHash 'SL.StakePool) (SL.RewardInfoPool)) GetPoolState - :: Maybe (Set (SL.KeyHash 'SL.StakePool (EraCrypto era))) + :: Maybe (Set (SL.KeyHash 'SL.StakePool)) -> BlockQuery (ShelleyBlock proto era) (SL.PState era) GetStakeSnapshots - :: Maybe (Set (SL.KeyHash 'SL.StakePool (EraCrypto era))) + :: Maybe (Set (SL.KeyHash 'SL.StakePool)) -> BlockQuery (ShelleyBlock proto era) - (StakeSnapshots (EraCrypto era)) + StakeSnapshots GetPoolDistr - :: Maybe (Set (SL.KeyHash 'SL.StakePool (EraCrypto era))) + :: Maybe (Set (SL.KeyHash 'SL.StakePool)) -> BlockQuery (ShelleyBlock proto era) - (PoolDistr (EraCrypto era)) + (PoolDistr (ProtoCrypto proto)) GetStakeDelegDeposits - :: Set (StakeCredential (EraCrypto era)) + :: Set StakeCredential -> BlockQuery (ShelleyBlock proto era) - (Map (StakeCredential (EraCrypto era)) Coin) + (Map StakeCredential Coin) -- | Not supported in eras before Conway GetConstitution @@ -254,11 +243,11 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -- Not supported in eras before Conway. GetDRepState :: CG.ConwayEraGov era - => Set (SL.Credential 'DRepRole (EraCrypto era)) + => Set (SL.Credential 'DRepRole) -> BlockQuery (ShelleyBlock proto era) (Map - (SL.Credential 'DRepRole (EraCrypto era)) - (SL.DRepState (EraCrypto era)) + (SL.Credential 'DRepRole) + SL.DRepState ) -- | Query the 'DRep' stake distribution. Note that this can be an expensive @@ -271,24 +260,24 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -- Not supported in eras before Conway. GetDRepStakeDistr :: CG.ConwayEraGov era - => Set (SL.DRep (EraCrypto era)) - -> BlockQuery (ShelleyBlock proto era) (Map (SL.DRep (EraCrypto era)) Coin) + => Set SL.DRep + -> BlockQuery (ShelleyBlock proto era) (Map SL.DRep Coin) -- | Query committee members -- -- Not supported in eras before Conway. GetCommitteeMembersState :: CG.ConwayEraGov era - => Set (SL.Credential 'ColdCommitteeRole (EraCrypto era) ) - -> Set (SL.Credential 'HotCommitteeRole (EraCrypto era)) + => Set (SL.Credential 'ColdCommitteeRole) + -> Set (SL.Credential 'HotCommitteeRole) -> Set SL.MemberStatus - -> BlockQuery (ShelleyBlock proto era) (SL.CommitteeMembersState (EraCrypto era)) + -> BlockQuery (ShelleyBlock proto era) SL.CommitteeMembersState -- | Not supported in eras before Conway. GetFilteredVoteDelegatees :: CG.ConwayEraGov era - => Set (SL.Credential 'SL.Staking (EraCrypto era)) - -> BlockQuery (ShelleyBlock proto era) (VoteDelegatees (EraCrypto era)) + => Set (SL.Credential 'SL.Staking) + -> BlockQuery (ShelleyBlock proto era) VoteDelegatees GetAccountState :: BlockQuery (ShelleyBlock proto era) AccountState @@ -301,12 +290,12 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -- Not supported in eras before Conway. GetSPOStakeDistr :: CG.ConwayEraGov era - => Set (KeyHash 'StakePool (EraCrypto era)) - -> BlockQuery (ShelleyBlock proto era) (Map (KeyHash 'StakePool (EraCrypto era)) Coin) + => Set (KeyHash 'StakePool) + -> BlockQuery (ShelleyBlock proto era) (Map (KeyHash 'StakePool) Coin) GetProposals :: CG.ConwayEraGov era - => Set (CG.GovActionId (EraCrypto era)) + => Set CG.GovActionId -> BlockQuery (ShelleyBlock proto era) (Seq (CG.GovActionState era)) GetRatifyState @@ -323,6 +312,11 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where GetBigLedgerPeerSnapshot :: BlockQuery (ShelleyBlock proto era) LedgerPeerSnapshot + QueryStakePoolDefaultVote + :: CG.ConwayEraGov era + => KeyHash 'StakePool + -> BlockQuery (ShelleyBlock proto era) CG.DefaultVote + -- WARNING: please add new queries to the end of the list and stick to this -- order in all other pattern matches on queries. This helps in particular -- with the en/decoders, as we want the CBOR tags to be ordered. @@ -340,8 +334,13 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where instance (Typeable era, Typeable proto) => ShowProxy (BlockQuery (ShelleyBlock proto era)) where -instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) - => BlockSupportsLedgerQuery (ShelleyBlock proto era) where +instance + ( ShelleyCompatible proto era + , ProtoCrypto proto ~ crypto + , Crypto crypto + ) => + BlockSupportsLedgerQuery (ShelleyBlock proto era) + where answerBlockQuery cfg query ext = case query of GetLedgerTip -> @@ -353,8 +352,6 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) SL.getNonMyopicMemberRewards globals st creds GetCurrentPParams -> getPParams st - GetProposedPParamsUpdates -> - getProposedPPUpdates st GetStakeDistribution -> fromLedgerPoolDistr $ SL.poolsByTotalStakeFraction globals st GetUTxOByAddress addrs -> @@ -389,7 +386,7 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) GetRewardInfoPools -> SL.getRewardInfoPools globals st GetPoolState mPoolIds -> - let certPState = SL.certPState . SL.lsCertState . SL.esLState . SL.nesEs $ st in + let certPState = view SL.certPStateL . SL.lsCertState . SL.esLState . SL.nesEs $ st in case mPoolIds of Just poolIds -> SL.PState @@ -408,16 +405,16 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) , SL.ssStakeGo } = SL.esSnapshots . SL.nesEs $ st - totalMarkByPoolId :: Map (KeyHash 'StakePool crypto) Coin + totalMarkByPoolId :: Map (KeyHash 'StakePool) Coin totalMarkByPoolId = SL.sumStakePerPool (SL.ssDelegations ssStakeMark) (SL.ssStake ssStakeMark) - totalSetByPoolId :: Map (KeyHash 'StakePool crypto) Coin + totalSetByPoolId :: Map (KeyHash 'StakePool) Coin totalSetByPoolId = SL.sumStakePerPool (SL.ssDelegations ssStakeSet) (SL.ssStake ssStakeSet) - totalGoByPoolId :: Map (KeyHash 'StakePool crypto) Coin + totalGoByPoolId :: Map (KeyHash 'StakePool) Coin totalGoByPoolId = SL.sumStakePerPool (SL.ssDelegations ssStakeGo) (SL.ssStake ssStakeGo) - getPoolStakes :: Set (KeyHash 'StakePool crypto) -> Map (KeyHash 'StakePool crypto) (StakeSnapshot crypto) + getPoolStakes :: Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) StakeSnapshot getPoolStakes poolIds = Map.fromSet mkStakeSnapshot poolIds where mkStakeSnapshot poolId = StakeSnapshot { ssMarkPool = Map.findWithDefault mempty poolId totalMarkByPoolId @@ -425,7 +422,7 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) , ssGoPool = Map.findWithDefault mempty poolId totalGoByPoolId } - getAllStake :: SL.SnapShot crypto -> SL.Coin + getAllStake :: SL.SnapShot -> SL.Coin getAllStake (SL.SnapShot stake _ _) = VMap.foldMap fromCompact (SL.unStake stake) in @@ -457,7 +454,7 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) SL.calculatePoolDistr' (maybe (const True) (flip Set.member) mPoolIds) stakeSet GetStakeDelegDeposits stakeCreds -> let lookupDeposit = - lookupDepositDState (SL.certDState $ SL.lsCertState $ SL.esLState $ SL.nesEs st) + lookupDepositDState (view SL.certDStateL $ SL.lsCertState $ SL.esLState $ SL.nesEs st) lookupInsert acc cred = case lookupDeposit cred of Nothing -> acc @@ -490,6 +487,8 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) ledgerPeers = second (fmap stakePoolRelayAccessPoint) <$> getPeers lst bigLedgerPeers = accumulateBigLedgerStake ledgerPeers in LedgerPeerSnapshot (slot, bigLedgerPeers) + QueryStakePoolDefaultVote stakePool -> + SL.queryStakePoolDefaultVote st stakePool where lcfg = configLedger $ getExtLedgerCfg cfg globals = shelleyLedgerGlobals lcfg @@ -524,10 +523,6 @@ instance SameDepIndex (BlockQuery (ShelleyBlock proto era)) where = Just Refl sameDepIndex GetCurrentPParams _ = Nothing - sameDepIndex GetProposedPParamsUpdates GetProposedPParamsUpdates - = Just Refl - sameDepIndex GetProposedPParamsUpdates _ - = Nothing sameDepIndex GetStakeDistribution GetStakeDistribution = Just Refl sameDepIndex GetStakeDistribution _ @@ -653,6 +648,8 @@ instance SameDepIndex (BlockQuery (ShelleyBlock proto era)) where sameDepIndex GetFuturePParams{} _ = Nothing sameDepIndex GetBigLedgerPeerSnapshot GetBigLedgerPeerSnapshot = Just Refl sameDepIndex GetBigLedgerPeerSnapshot _ = Nothing + sameDepIndex QueryStakePoolDefaultVote{} QueryStakePoolDefaultVote{} = Just Refl + sameDepIndex QueryStakePoolDefaultVote{} _ = Nothing deriving instance Eq (BlockQuery (ShelleyBlock proto era) result) deriving instance Show (BlockQuery (ShelleyBlock proto era) result) @@ -663,7 +660,6 @@ instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock prot GetEpochNo -> show GetNonMyopicMemberRewards {} -> show GetCurrentPParams -> show - GetProposedPParamsUpdates -> show GetStakeDistribution -> show GetUTxOByAddress {} -> show GetUTxOWhole -> show @@ -694,6 +690,7 @@ instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock prot GetRatifyState {} -> show GetFuturePParams {} -> show GetBigLedgerPeerSnapshot -> show + QueryStakePoolDefaultVote {} -> show -- | Is the given query supported by the given 'ShelleyNodeToClientVersion'? querySupportedVersion :: BlockQuery (ShelleyBlock proto era) result -> ShelleyNodeToClientVersion -> Bool @@ -702,7 +699,6 @@ querySupportedVersion = \case GetEpochNo -> const True GetNonMyopicMemberRewards {} -> const True GetCurrentPParams -> const True - GetProposedPParamsUpdates -> const True GetStakeDistribution -> const True GetUTxOByAddress {} -> const True GetUTxOWhole -> const True @@ -733,6 +729,7 @@ querySupportedVersion = \case GetRatifyState {} -> (>= v9) GetFuturePParams {} -> (>= v10) GetBigLedgerPeerSnapshot -> (>= v11) + QueryStakePoolDefaultVote {} -> (>= v12) -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@ -- must be added. See #2830 for a template on how to do this. where @@ -740,31 +737,24 @@ querySupportedVersion = \case v9 = ShelleyNodeToClientVersion9 v10 = ShelleyNodeToClientVersion10 v11 = ShelleyNodeToClientVersion11 + v12 = ShelleyNodeToClientVersion12 {------------------------------------------------------------------------------- Auxiliary -------------------------------------------------------------------------------} --- | /Note/ - This query will be deprecated starting with Conway era -getProposedPPUpdates :: - ShelleyBasedEra era - => SL.NewEpochState era -> SL.ProposedPPUpdates era -getProposedPPUpdates = - fromMaybe SL.emptyPPPUpdates - . LC.getProposedPPUpdates - . view SL.newEpochStateGovStateL - -- Get the current 'EpochState.' This is mainly for debugging. getEpochState :: SL.NewEpochState era -> SL.EpochState era getEpochState = SL.nesEs -getDState :: SL.NewEpochState era -> SL.DState era -getDState = SL.certDState . SL.lsCertState . SL.esLState . SL.nesEs +getDState :: SL.EraCertState era => SL.NewEpochState era -> SL.DState era +getDState = view SL.certDStateL . SL.lsCertState . SL.esLState . SL.nesEs getFilteredDelegationsAndRewardAccounts :: - SL.NewEpochState era - -> Set (SL.Credential 'SL.Staking (EraCrypto era)) - -> (Delegations (EraCrypto era), SL.RewardAccounts (EraCrypto era)) + SL.EraCertState era + => SL.NewEpochState era + -> Set (SL.Credential 'SL.Staking) + -> (Delegations, Map (SL.Credential 'Staking) Coin) getFilteredDelegationsAndRewardAccounts ss creds = (filteredDelegations, filteredRwdAcnts) where @@ -776,9 +766,10 @@ getFilteredDelegationsAndRewardAccounts ss creds = Map.mapMaybe (\e -> fromCompact . rdReward <$> umElemRDPair e) umElemsRestricted getFilteredVoteDelegatees :: - SL.NewEpochState era - -> Set (SL.Credential 'SL.Staking (EraCrypto era)) - -> VoteDelegatees (EraCrypto era) + SL.EraCertState era + => SL.NewEpochState era + -> Set (SL.Credential 'SL.Staking) + -> VoteDelegatees getFilteredVoteDelegatees ss creds = Map.mapMaybe umElemDRep umElemsRestricted where UMap umElems _ = SL.dsUnified $ getDState ss @@ -800,8 +791,6 @@ encodeShelleyQuery query = case query of CBOR.encodeListLen 2 <> CBOR.encodeWord8 2 <> toCBOR creds GetCurrentPParams -> CBOR.encodeListLen 1 <> CBOR.encodeWord8 3 - GetProposedPParamsUpdates -> - CBOR.encodeListLen 1 <> CBOR.encodeWord8 4 GetStakeDistribution -> CBOR.encodeListLen 1 <> CBOR.encodeWord8 5 GetUTxOByAddress addrs -> @@ -862,6 +851,8 @@ encodeShelleyQuery query = case query of CBOR.encodeListLen 1 <> CBOR.encodeWord8 33 GetBigLedgerPeerSnapshot -> CBOR.encodeListLen 1 <> CBOR.encodeWord8 34 + QueryStakePoolDefaultVote stakePoolKey -> + CBOR.encodeListLen 2 <> CBOR.encodeWord8 35 <> LC.toEraCBOR @era stakePoolKey decodeShelleyQuery :: forall era proto. ShelleyBasedEra era @@ -888,7 +879,6 @@ decodeShelleyQuery = do (1, 1) -> return $ SomeSecond GetEpochNo (2, 2) -> SomeSecond . GetNonMyopicMemberRewards <$> fromCBOR (1, 3) -> return $ SomeSecond GetCurrentPParams - (1, 4) -> return $ SomeSecond GetProposedPParamsUpdates (1, 5) -> return $ SomeSecond GetStakeDistribution (2, 6) -> SomeSecond . GetUTxOByAddress <$> LC.fromEraCBOR @era (1, 7) -> return $ SomeSecond GetUTxOWhole @@ -924,6 +914,7 @@ decodeShelleyQuery = do (1, 32) -> requireCG $ return $ SomeSecond GetRatifyState (1, 33) -> requireCG $ return $ SomeSecond GetFuturePParams (1, 34) -> return $ SomeSecond GetBigLedgerPeerSnapshot + (2, 35) -> requireCG $ SomeSecond . QueryStakePoolDefaultVote <$> LC.fromEraCBOR @era _ -> failmsg "invalid" encodeShelleyResult :: @@ -935,7 +926,6 @@ encodeShelleyResult _v query = case query of GetEpochNo -> toCBOR GetNonMyopicMemberRewards {} -> toCBOR GetCurrentPParams -> toCBOR - GetProposedPParamsUpdates -> toCBOR GetStakeDistribution -> LC.toEraCBOR @era GetUTxOByAddress {} -> toCBOR GetUTxOWhole -> toCBOR @@ -966,6 +956,7 @@ encodeShelleyResult _v query = case query of GetRatifyState {} -> LC.toEraCBOR @era GetFuturePParams {} -> LC.toEraCBOR @era GetBigLedgerPeerSnapshot -> toCBOR + QueryStakePoolDefaultVote {} -> toCBOR decodeShelleyResult :: forall proto era result. ShelleyCompatible proto era @@ -977,7 +968,6 @@ decodeShelleyResult _v query = case query of GetEpochNo -> fromCBOR GetNonMyopicMemberRewards {} -> fromCBOR GetCurrentPParams -> fromCBOR - GetProposedPParamsUpdates -> fromCBOR GetStakeDistribution -> LC.fromEraCBOR @era GetUTxOByAddress {} -> fromCBOR GetUTxOWhole -> fromCBOR @@ -1008,6 +998,7 @@ decodeShelleyResult _v query = case query of GetRatifyState {} -> LC.fromEraCBOR @era GetFuturePParams {} -> LC.fromEraCBOR @era GetBigLedgerPeerSnapshot -> fromCBOR + QueryStakePoolDefaultVote {} -> fromCBOR -- | The stake snapshot returns information about the mark, set, go ledger snapshots for a pool, -- plus the total active stake for each snapshot that can be used in a 'sigma' calculation. @@ -1015,17 +1006,16 @@ decodeShelleyResult _v query = case query of -- Each snapshot is taken at the end of a different era. The go snapshot is the current one and -- was taken two epochs earlier, set was taken one epoch ago, and mark was taken immediately -- before the start of the current epoch. -data StakeSnapshot crypto = StakeSnapshot +data StakeSnapshot = StakeSnapshot { ssMarkPool :: !SL.Coin , ssSetPool :: !SL.Coin , ssGoPool :: !SL.Coin } deriving (Eq, Show, Generic) -instance NFData (StakeSnapshot crypto) +instance NFData StakeSnapshot instance - Crypto crypto => - ToCBOR (StakeSnapshot crypto) + ToCBOR StakeSnapshot where toCBOR StakeSnapshot @@ -1038,8 +1028,7 @@ instance <> toCBOR ssGoPool instance - Crypto crypto => - FromCBOR (StakeSnapshot crypto) + FromCBOR StakeSnapshot where fromCBOR = do enforceSize "StakeSnapshot" 3 @@ -1048,18 +1037,17 @@ instance <*> fromCBOR <*> fromCBOR -data StakeSnapshots crypto = StakeSnapshots - { ssStakeSnapshots :: !(Map (SL.KeyHash 'SL.StakePool crypto) (StakeSnapshot crypto)) - , ssMarkTotal :: !SL.Coin - , ssSetTotal :: !SL.Coin - , ssGoTotal :: !SL.Coin +data StakeSnapshots = StakeSnapshots + { ssStakeSnapshots :: !(Map (SL.KeyHash 'SL.StakePool) StakeSnapshot) + , ssMarkTotal :: !SL.Coin + , ssSetTotal :: !SL.Coin + , ssGoTotal :: !SL.Coin } deriving (Eq, Show, Generic) -instance NFData (StakeSnapshots crypto) +instance NFData StakeSnapshots instance - Crypto crypto => - ToCBOR (StakeSnapshots crypto) + ToCBOR StakeSnapshots where toCBOR StakeSnapshots @@ -1074,8 +1062,7 @@ instance <> toCBOR ssGoTotal instance - Crypto crypto => - FromCBOR (StakeSnapshots crypto) + FromCBOR StakeSnapshots where fromCBOR = do enforceSize "StakeSnapshots" 4 diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query/Types.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query/Types.hs index c996af7dc2..b790ad5c31 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query/Types.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query/Types.hs @@ -16,12 +16,14 @@ module Ouroboros.Consensus.Shelley.Ledger.Query.Types ( , fromLedgerPoolDistr ) where +import qualified Cardano.Crypto.Hash as Hash +import qualified Cardano.Crypto.VRF as VRF import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), decodeRecordNamed, encodeListLen) -import Cardano.Ledger.Crypto (Crypto) -import Cardano.Ledger.Keys (Hash) +import Cardano.Ledger.Hashes (HASH) import qualified Cardano.Ledger.Keys as SL -import qualified Cardano.Ledger.PoolDistr as SL +import qualified Cardano.Ledger.State as SL +import Cardano.Protocol.Crypto (Crypto, VRF) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import GHC.Generics (Generic) @@ -31,12 +33,12 @@ import NoThunks.Class -- . data IndividualPoolStake c = IndividualPoolStake { individualPoolStake :: !Rational - , individualPoolStakeVrf :: !(Hash c (SL.VerKeyVRF c)) + , individualPoolStakeVrf :: !(Hash.Hash HASH (VRF.VerKeyVRF (VRF c))) } deriving stock (Show, Eq, Generic) deriving anyclass (NoThunks) -fromLedgerIndividualPoolStake :: SL.IndividualPoolStake c -> IndividualPoolStake c +fromLedgerIndividualPoolStake :: SL.IndividualPoolStake -> IndividualPoolStake c fromLedgerIndividualPoolStake ips = IndividualPoolStake { individualPoolStake = SL.individualPoolStake ips , individualPoolStakeVrf = SL.fromVRFVerKeyHash $ SL.individualPoolStakeVrf ips @@ -60,12 +62,12 @@ instance Crypto c => DecCBOR (IndividualPoolStake c) where -- | Copy of 'SL.PoolDistr' before -- . newtype PoolDistr c = PoolDistr { - unPoolDistr :: Map (SL.KeyHash SL.StakePool c) (IndividualPoolStake c) + unPoolDistr :: Map (SL.KeyHash SL.StakePool) (IndividualPoolStake c) } deriving stock (Show, Eq, Generic) deriving newtype (EncCBOR, DecCBOR) -fromLedgerPoolDistr :: SL.PoolDistr c -> PoolDistr c +fromLedgerPoolDistr :: SL.PoolDistr -> PoolDistr c fromLedgerPoolDistr pd = PoolDistr { unPoolDistr = Map.map fromLedgerIndividualPoolStake $ SL.unPoolDistr pd } diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/SupportsProtocol.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/SupportsProtocol.hs index 3f8895fc22..6c4df344e4 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/SupportsProtocol.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/SupportsProtocol.hs @@ -12,7 +12,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -35,12 +34,10 @@ import Ouroboros.Consensus.HardFork.History.Util import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol (..)) -import Ouroboros.Consensus.Protocol.Abstract (TranslateProto, - translateLedgerView) +import Ouroboros.Consensus.Protocol.Abstract (translateLedgerView) import Ouroboros.Consensus.Protocol.Praos (Praos) import qualified Ouroboros.Consensus.Protocol.Praos.Views as Praos import Ouroboros.Consensus.Protocol.TPraos (TPraos) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Ledger import Ouroboros.Consensus.Shelley.Ledger.Protocol () @@ -49,7 +46,7 @@ import Ouroboros.Consensus.Shelley.Protocol.Praos () import Ouroboros.Consensus.Shelley.Protocol.TPraos () instance - (ShelleyCompatible (TPraos crypto) era, crypto ~ EraCrypto era) => + (ShelleyCompatible (TPraos crypto) era) => LedgerSupportsProtocol (ShelleyBlock (TPraos crypto) era) where protocolLedgerView _cfg = SL.currentLedgerView . tickedShelleyLedgerState @@ -75,7 +72,7 @@ instance swindow = SL.stabilityWindow globals at = ledgerTipSlot ledgerState - futureLedgerView :: SlotNo -> SL.LedgerView (EraCrypto era) + futureLedgerView :: SlotNo -> SL.LedgerView futureLedgerView = either (\e -> error ("futureLedgerView failed: " <> show e)) @@ -88,9 +85,7 @@ instance instance ( ShelleyCompatible (Praos crypto) era, - ShelleyCompatible (TPraos crypto) era, - crypto ~ EraCrypto era, - TranslateProto (TPraos crypto) (Praos crypto) + ShelleyCompatible (TPraos crypto) era ) => LedgerSupportsProtocol (ShelleyBlock (Praos crypto) era) where diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs index 2b673cf5bd..c25f98440d 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs @@ -28,6 +28,7 @@ module Ouroboros.Consensus.Shelley.Node ( ) where import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (Crypto) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Ouroboros.Consensus.Block @@ -39,14 +40,14 @@ import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Node.Run import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Protocol.TPraos -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Ledger.Inspect () import Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion () import Ouroboros.Consensus.Shelley.Node.DiffusionPipelining () import Ouroboros.Consensus.Shelley.Node.Serialisation () import Ouroboros.Consensus.Shelley.Node.TPraos -import Ouroboros.Consensus.Shelley.Protocol.Abstract (pHeaderIssuer) +import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto, + pHeaderIssuer) {------------------------------------------------------------------------------- ProtocolInfo @@ -101,16 +102,18 @@ instance ShelleyCompatible proto era => BlockSupportsMetrics (ShelleyBlock proto -> IsNotSelfIssued where - issuerVKeys :: Map (SL.KeyHash 'SL.BlockIssuer (EraCrypto era)) - (SL.VKey 'SL.BlockIssuer (EraCrypto era)) + issuerVKeys :: Map (SL.KeyHash 'SL.BlockIssuer) + (SL.VKey 'SL.BlockIssuer) issuerVKeys = shelleyBlockIssuerVKeys cfg instance ConsensusProtocol proto => BlockSupportsSanityCheck (ShelleyBlock proto era) where configAllSecurityParams = pure . protocolSecurityParam . topLevelConfigProtocol -instance ( ShelleyCompatible proto era - , LedgerSupportsProtocol (ShelleyBlock proto era) - , BlockSupportsSanityCheck (ShelleyBlock proto era) - , TxLimits (ShelleyBlock proto era) +instance ( ShelleyCompatible proto era + , LedgerSupportsProtocol (ShelleyBlock proto era) + , BlockSupportsSanityCheck (ShelleyBlock proto era) + , TxLimits (ShelleyBlock proto era) + , SerialiseNodeToClientConstraints (ShelleyBlock proto era) + , Crypto (ProtoCrypto proto) ) => RunNode (ShelleyBlock proto era) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs index 572ed23a4e..6982e3ce00 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs @@ -20,9 +20,12 @@ module Ouroboros.Consensus.Shelley.Node.Common ( , shelleyBlockIssuerVKey ) where +import Cardano.Crypto.KES (UnsoundPureSignKeyKES) +import Cardano.Ledger.BaseTypes (unNonZero) import qualified Cardano.Ledger.Keys as SL import qualified Cardano.Ledger.Shelley.API as SL import Cardano.Ledger.Slot +import Cardano.Protocol.Crypto import Data.Text (Text) import Ouroboros.Consensus.Block (CannotForge, ForgeStateInfo, ForgeStateUpdateError) @@ -33,14 +36,13 @@ import Ouroboros.Consensus.Node.InitStorage import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (praosCanBeLeaderColdVerKey)) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, ShelleyCompatible, shelleyNetworkMagic, shelleyStorageConfigSecurityParam, shelleyStorageConfigSlotsPerKESPeriod, shelleySystemStart, verifyBlockIntegrity) -import Ouroboros.Consensus.Shelley.Protocol.Abstract - (ProtocolHeaderSupportsProtocol (CannotForgeError)) +import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto, + ProtocolHeaderSupportsProtocol (CannotForgeError)) import Ouroboros.Consensus.Storage.ImmutableDB {------------------------------------------------------------------------------- @@ -52,7 +54,7 @@ data ShelleyLeaderCredentials c = ShelleyLeaderCredentials -- -- Note that this is not inside 'ShelleyCanBeLeader' since it gets evolved -- automatically, whereas 'ShelleyCanBeLeader' does not change. - shelleyLeaderCredentialsInitSignKey :: SL.SignKeyKES c, + shelleyLeaderCredentialsInitSignKey :: UnsoundPureSignKeyKES (KES c), shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader c, -- | Identifier for this set of credentials. -- @@ -61,7 +63,7 @@ data ShelleyLeaderCredentials c = ShelleyLeaderCredentials } shelleyBlockIssuerVKey :: - ShelleyLeaderCredentials c -> SL.VKey 'SL.BlockIssuer c + ShelleyLeaderCredentials c -> SL.VKey 'SL.BlockIssuer shelleyBlockIssuerVKey = praosCanBeLeaderColdVerKey . shelleyLeaderCredentialsCanBeLeader @@ -78,11 +80,11 @@ type instance ForgeStateUpdateError (ShelleyBlock proto era) = HotKey.KESEvoluti -- | Needed in '*SharedBlockForging' because we can't partially apply -- equality constraints. class - (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), EraCrypto era ~ c) => + (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), ProtoCrypto proto ~ c) => ShelleyEraWithCrypto c proto era instance - (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), EraCrypto era ~ c) => + (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), ProtoCrypto proto ~ c) => ShelleyEraWithCrypto c proto era {------------------------------------------------------------------------------- @@ -105,6 +107,7 @@ instance ShelleyCompatible proto era => NodeInitStorage (ShelleyBlock proto era) simpleChunkInfo . EpochSize . (* 10) + . unNonZero . maxRollbacks . shelleyStorageConfigSecurityParam diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/DiffusionPipelining.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/DiffusionPipelining.hs index b6f370352e..03cb4a22a8 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/DiffusionPipelining.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/DiffusionPipelining.hs @@ -33,7 +33,7 @@ import Ouroboros.Consensus.Shelley.Protocol.Abstract -- pipelining. data HotIdentity c = HotIdentity { -- | Hash of the cold key. - hiIssuer :: !(SL.KeyHash SL.BlockIssuer c) + hiIssuer :: !(SL.KeyHash SL.BlockIssuer) , -- | The issue number/opcert counter. Even if the opcert was compromised and -- hence an attacker forges blocks with a specific cold identity, the owner -- of the cold key can issue a new opcert with an incremented counter, and diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs index 35fcbaf0ba..ad549b5a0f 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs @@ -8,7 +8,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -30,7 +29,6 @@ import Ouroboros.Consensus.Protocol.Praos (Praos, PraosParams (..), praosCheckCanForge) import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (praosCanBeLeaderOpCert)) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, ShelleyCompatible, forgeShelleyBlock) import Ouroboros.Consensus.Shelley.Node.Common (ShelleyEraWithCrypto, @@ -46,12 +44,11 @@ import Ouroboros.Consensus.Util.IOLike (IOLike) praosBlockForging :: forall m era c. ( ShelleyCompatible (Praos c) era - , c ~ EraCrypto era , Mempool.TxLimits (ShelleyBlock (Praos c) era) , IOLike m ) => PraosParams - -> ShelleyLeaderCredentials (EraCrypto era) + -> ShelleyLeaderCredentials c -> m (BlockForging m (ShelleyBlock (Praos c) era)) praosBlockForging praosParams credentials = do hotKey <- HotKey.mkHotKey @m @c initSignKey startPeriod praosMaxKESEvo @@ -78,6 +75,7 @@ praosBlockForging praosParams credentials = do praosSharedBlockForging :: forall m c era. ( ShelleyEraWithCrypto c (Praos c) era + -- , Crypto c , IOLike m ) => HotKey.HotKey c m diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Serialisation.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Serialisation.hs index 29bbd5ddf2..966a5fa65d 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Serialisation.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Serialisation.hs @@ -1,29 +1,41 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.Shelley.Node.Serialisation () where -import Cardano.Ledger.Binary (fromCBOR, toCBOR) +import Cardano.Binary +import Cardano.Ledger.BaseTypes import Cardano.Ledger.Core (fromEraCBOR, toEraCBOR) +import qualified Cardano.Ledger.Core as SL import qualified Cardano.Ledger.Shelley.API as SL -import qualified Cardano.Protocol.TPraos.API as SL +import Cardano.Slotting.EpochInfo (epochInfoSize, + epochInfoSlotToRelativeTime, fixedEpochInfo, + hoistEpochInfo) +import Cardano.Slotting.Time import Codec.Serialise (decode, encode) import Control.Exception (Exception, throw) import qualified Data.ByteString.Lazy as Lazy +import Data.Functor.Identity import Data.Typeable (Typeable) +import Data.Word import Ouroboros.Consensus.Block +import Ouroboros.Consensus.HardFork.Combinator.Abstract.NoHardForks +import Ouroboros.Consensus.HardFork.Combinator.PartialConfig +import Ouroboros.Consensus.HardFork.History.EpochInfo +import Ouroboros.Consensus.HardFork.Simple import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) import Ouroboros.Consensus.Node.Run import Ouroboros.Consensus.Node.Serialisation import Ouroboros.Consensus.Protocol.Praos (PraosState) -import qualified Ouroboros.Consensus.Protocol.Praos as Praos import Ouroboros.Consensus.Protocol.TPraos import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger @@ -59,16 +71,16 @@ instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) (Led decodeDisk _ = decodeShelleyLedgerState -- | @'ChainDepState' ('BlockProtocol' ('ShelleyBlock' era))@ -instance (ShelleyCompatible proto era, EraCrypto era ~ c, SL.PraosCrypto c) => EncodeDisk (ShelleyBlock proto era) (TPraosState c) where +instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) TPraosState where encodeDisk _ = encode -- | @'ChainDepState' ('BlockProtocol' ('ShelleyBlock' era))@ -instance (ShelleyCompatible proto era, EraCrypto era ~ c, SL.PraosCrypto c) => DecodeDisk (ShelleyBlock proto era) (TPraosState c) where +instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) TPraosState where decodeDisk _ = decode -instance (ShelleyCompatible proto era, EraCrypto era ~ c, Praos.PraosCrypto c) => EncodeDisk (ShelleyBlock proto era) (PraosState c) where +instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) PraosState where encodeDisk _ = encode -- | @'ChainDepState' ('BlockProtocol' ('ShelleyBlock' era))@ -instance (ShelleyCompatible proto era, EraCrypto era ~ c, Praos.PraosCrypto c) => DecodeDisk (ShelleyBlock proto era) (PraosState c) where +instance ShelleyCompatible proto era => DecodeDisk (ShelleyBlock proto era) PraosState where decodeDisk _ = decode instance ShelleyCompatible proto era => EncodeDisk (ShelleyBlock proto era) (AnnTip (ShelleyBlock proto era)) where @@ -81,7 +93,7 @@ instance ShelleyCompatible proto era SerialiseNodeToNode -------------------------------------------------------------------------------} -instance ShelleyCompatible proto era +instance (ShelleyCompatible proto era) -- , Crypto (ProtoCrypto proto)) => SerialiseNodeToNodeConstraints (ShelleyBlock proto era) where estimateBlockSize hdr = overhead + hdrSize + bodySize where @@ -125,7 +137,7 @@ instance ShelleyCompatible proto era encodeNodeToNode _ _ = toCBOR decodeNodeToNode _ _ = fromCBOR -instance ShelleyCompatible proto era +instance (ShelleyCompatible proto era) -- , Crypto (ProtoCrypto proto)) => SerialiseNodeToNode (ShelleyBlock proto era) (GenTxId (ShelleyBlock proto era)) where encodeNodeToNode _ _ = toEraCBOR @era decodeNodeToNode _ _ = fromEraCBOR @era @@ -146,7 +158,7 @@ data ShelleyEncoderException era proto = instance (Typeable era, Typeable proto) => Exception (ShelleyEncoderException era proto) -instance ShelleyCompatible proto era +instance (NoHardForks (ShelleyBlock proto era), ShelleyCompatible proto era) => SerialiseNodeToClientConstraints (ShelleyBlock proto era) -- | CBOR-in-CBOR for the annotation. This also makes it compatible with the @@ -156,6 +168,109 @@ instance ShelleyCompatible proto era encodeNodeToClient _ _ = wrapCBORinCBOR encodeShelleyBlock decodeNodeToClient _ _ = unwrapCBORinCBOR decodeShelleyBlock +-- | This instance uses the invariant that the 'EpochInfo' in a +-- 'ShelleyLedgerConfig' is fixed i.e. has a constant 'EpochSize' and +-- 'SlotLength'. This is not true in the case of the HFC in a +-- 'ShelleyPartialLedgerConfig', but that is handled correctly in the respective +-- 'SerialiseNodeToClient' instance for 'ShelleyPartialLedgerConfig'. +instance (NoHardForks (ShelleyBlock proto era), ShelleyCompatible proto era) + => SerialiseNodeToClient (ShelleyBlock proto era) (ShelleyLedgerConfig era) where + decodeNodeToClient ccfg version = do + enforceSize "ShelleyLedgerConfig" 3 + partialConfig <- decodeNodeToClient + @_ + @(ShelleyPartialLedgerConfig era) + ccfg + version + epochSize <- fromCBOR @EpochSize + slotLength <- decode @SlotLength + return $ completeLedgerConfig + (Proxy @(ShelleyBlock proto era)) + (fixedEpochInfo epochSize slotLength) + partialConfig + + encodeNodeToClient ccfg version ledgerConfig = mconcat [ + encodeListLen 3 + , encodeNodeToClient + @_ + @(ShelleyPartialLedgerConfig era) + ccfg + version + (toPartialLedgerConfig (Proxy @(ShelleyBlock proto era)) ledgerConfig) + , toCBOR @EpochSize epochSize + , encode @SlotLength slotLength + ] + where + unwrap = either + (error "ShelleyLedgerConfig contains a non-fixed EpochInfo") + id + ei = epochInfo (shelleyLedgerGlobals ledgerConfig) + epochSize = unwrap $ epochInfoSize ei (EpochNo 0) + RelativeTime t1 = unwrap $ epochInfoSlotToRelativeTime ei 1 + slotLength = mkSlotLength t1 + +-- | This instance uses the invariant that the 'EpochInfo' in a +-- 'ShelleyPartialLedgerConfig' is always just a dummy value. +instance ShelleyBasedEra era + => SerialiseNodeToClient (ShelleyBlock proto era) (ShelleyPartialLedgerConfig era) where + decodeNodeToClient ccfg version = do + enforceSize "ShelleyPartialLedgerConfig era" 13 + ShelleyPartialLedgerConfig + <$> ( ShelleyLedgerConfig + <$> fromCBOR @CompactGenesis + <*> (SL.Globals + (hoistEpochInfo (Right . runIdentity) $ toPureEpochInfo dummyEpochInfo) + <$> fromCBOR @Word64 + <*> fromCBOR @Word64 + <*> fromCBOR @Word64 + <*> fromCBOR @(NonZero Word64) + <*> fromCBOR @Word64 + <*> fromCBOR @Word64 + <*> fromCBOR @Word64 + <*> fromCBOR @ActiveSlotCoeff + <*> fromCBOR @SL.Network + <*> fromCBOR @SystemStart + ) + <*> fromCBOR @(SL.TranslationContext era) + ) + <*> decodeNodeToClient @(ShelleyBlock proto era) @TriggerHardFork ccfg version + + encodeNodeToClient ccfg version + (ShelleyPartialLedgerConfig + (ShelleyLedgerConfig + myCompactGenesis + (SL.Globals + _epochInfo + slotsPerKESPeriod' + stabilityWindow' + randomnessStabilisationWindow' + securityParameter' + maxKESEvo' + quorum' + maxLovelaceSupply' + activeSlotCoeff' + networkId' + systemStart' + ) + translationContext + ) + triggerHardFork + ) + = encodeListLen 13 + <> toCBOR @CompactGenesis myCompactGenesis + <> toCBOR @Word64 slotsPerKESPeriod' + <> toCBOR @Word64 stabilityWindow' + <> toCBOR @Word64 randomnessStabilisationWindow' + <> toCBOR @(NonZero Word64) securityParameter' + <> toCBOR @Word64 maxKESEvo' + <> toCBOR @Word64 quorum' + <> toCBOR @Word64 maxLovelaceSupply' + <> toCBOR @ActiveSlotCoeff activeSlotCoeff' + <> toCBOR @SL.Network networkId' + <> toCBOR @SystemStart systemStart' + <> toCBOR @(SL.TranslationContext era) translationContext + <> encodeNodeToClient @(ShelleyBlock proto era) @TriggerHardFork ccfg version triggerHardFork + -- | 'Serialised' uses CBOR-in-CBOR by default. instance SerialiseNodeToClient (ShelleyBlock proto era) (Serialised (ShelleyBlock proto era)) -- Default instance @@ -166,7 +281,7 @@ instance ShelleyCompatible proto era encodeNodeToClient _ _ = toCBOR decodeNodeToClient _ _ = fromCBOR -instance ShelleyCompatible proto era +instance (ShelleyCompatible proto era) -- , Crypto (ProtoCrypto proto)) => SerialiseNodeToClient (ShelleyBlock proto era) (GenTxId (ShelleyBlock proto era)) where encodeNodeToClient _ _ = toEraCBOR @era decodeNodeToClient _ _ = fromEraCBOR @era @@ -185,7 +300,9 @@ instance ShelleyCompatible proto era = throw $ ShelleyEncoderUnsupportedQuery (SomeSecond q) version decodeNodeToClient _ _ = decodeShelleyQuery -instance ShelleyCompatible proto era => SerialiseResult (ShelleyBlock proto era) (BlockQuery (ShelleyBlock proto era)) where +instance + (ShelleyCompatible proto era{-, Crypto (ProtoCrypto proto)-}) => + SerialiseResult (ShelleyBlock proto era) (BlockQuery (ShelleyBlock proto era)) where encodeResult _ = encodeShelleyResult decodeResult _ = decodeShelleyResult diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs index 82e5698885..2a1f9a291d 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/TPraos.hs @@ -10,7 +10,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} @@ -32,10 +31,13 @@ module Ouroboros.Consensus.Shelley.Node.TPraos ( , validateGenesis ) where +import Cardano.Crypto.Hash (Hash) import qualified Cardano.Crypto.VRF as VRF import qualified Cardano.Ledger.Api.Era as L import qualified Cardano.Ledger.Api.Transition as L +import Cardano.Ledger.Hashes (HASH) import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (VRF) import qualified Cardano.Protocol.TPraos.API as SL import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..)) import qualified Cardano.Protocol.TPraos.OCert as SL @@ -82,13 +84,11 @@ import Ouroboros.Consensus.Util.IOLike shelleyBlockForging :: forall m era c. ( ShelleyCompatible (TPraos c) era - , PraosCrypto c - , c ~ EraCrypto era , TxLimits (ShelleyBlock (TPraos c) era) , IOLike m ) => TPraosParams - -> ShelleyLeaderCredentials (EraCrypto era) + -> ShelleyLeaderCredentials c -> m (BlockForging m (ShelleyBlock (TPraos c) era)) shelleyBlockForging tpraosParams credentials = do hotKey <- HotKey.mkHotKey @m @c initSignKey startPeriod tpraosMaxKESEvo @@ -114,8 +114,7 @@ shelleyBlockForging tpraosParams credentials = do -- 'forgeLabel'. shelleySharedBlockForging :: forall m c era. - ( PraosCrypto c - , ShelleyEraWithCrypto c (TPraos c) era + ( ShelleyEraWithCrypto c (TPraos c) era , IOLike m ) => HotKey c m @@ -146,7 +145,7 @@ shelleySharedBlockForging hotKey slotToPeriod credentials = , shelleyLeaderCredentialsLabel = label } = credentials - forgingVRFHash :: SL.Hash c (SL.VerKeyVRF c) + forgingVRFHash :: Hash HASH (VRF.VerKeyVRF (VRF c)) forgingVRFHash = VRF.hashVerKeyVRF . VRF.deriveVerKeyVRF @@ -159,9 +158,7 @@ shelleySharedBlockForging hotKey slotToPeriod credentials = -- | Check the validity of the genesis config. To be used in conjunction with -- 'assertWithMsg'. -validateGenesis :: - PraosCrypto c - => SL.ShelleyGenesis c -> Either String () +validateGenesis :: SL.ShelleyGenesis -> Either String () validateGenesis = first errsToString . SL.validateGenesis where errsToString :: [SL.ValidationErr] -> String @@ -172,15 +169,14 @@ validateGenesis = first errsToString . SL.validateGenesis protocolInfoShelley :: forall m c. ( IOLike m - , PraosCrypto c - , ShelleyCompatible (TPraos c) (ShelleyEra c) - , TxLimits (ShelleyBlock (TPraos c) (ShelleyEra c)) + , ShelleyCompatible (TPraos c) ShelleyEra + , TxLimits (ShelleyBlock (TPraos c) ShelleyEra) ) - => SL.ShelleyGenesis c + => SL.ShelleyGenesis -> ProtocolParamsShelleyBased c -> SL.ProtVer - -> ( ProtocolInfo (ShelleyBlock (TPraos c) (ShelleyEra c) ) - , m [BlockForging m (ShelleyBlock (TPraos c) (ShelleyEra c))] + -> ( ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra) + , m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)] ) protocolInfoShelley shelleyGenesis protocolParamsShelleyBased @@ -193,10 +189,8 @@ protocolInfoShelley shelleyGenesis protocolInfoTPraosShelleyBased :: forall m era c. ( IOLike m - , PraosCrypto c , ShelleyCompatible (TPraos c) era , TxLimits (ShelleyBlock (TPraos c) era) - , c ~ EraCrypto era ) => ProtocolParamsShelleyBased c -> L.TransitionConfig era @@ -221,7 +215,7 @@ protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased { credentialss ) where - genesis :: SL.ShelleyGenesis c + genesis :: SL.ShelleyGenesis genesis = transitionCfg ^. L.tcShelleyGenesisL maxMajorProtVer :: MaxMajorProtVer @@ -281,7 +275,7 @@ protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased { , shelleyLedgerTransition = ShelleyTransitionInfo {shelleyAfterVoting = 0} } - initChainDepState :: TPraosState c + initChainDepState :: TPraosState initChainDepState = TPraosState Origin $ SL.initialChainDepState initialNonce (SL.sgGenDelegs genesis) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/Abstract.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/Abstract.hs index 028b9d7aba..cf70fac574 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/Abstract.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/Abstract.hs @@ -28,14 +28,14 @@ module Ouroboros.Consensus.Shelley.Protocol.Abstract ( ) where import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR)) +import qualified Cardano.Crypto.Hash as Hash import Cardano.Crypto.VRF (OutputVRF) import Cardano.Ledger.BaseTypes (ProtVer) import Cardano.Ledger.BHeaderView (BHeaderView) -import Cardano.Ledger.Crypto (Crypto, VRF) import Cardano.Ledger.Hashes (EraIndependentBlockBody, - EraIndependentBlockHeader) -import Cardano.Ledger.Keys (Hash, KeyRole (BlockIssuer), VKey) -import qualified Cardano.Ledger.Keys as SL (Hash) + EraIndependentBlockHeader, HASH) +import Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey) +import Cardano.Protocol.Crypto (Crypto, VRF) import Cardano.Protocol.TPraos.BHeader (PrevHash) import Cardano.Slotting.Block (BlockNo) import Cardano.Slotting.Slot (SlotNo) @@ -64,25 +64,24 @@ type family ProtoCrypto proto :: Type Header hash -------------------------------------------------------------------------------} -newtype ShelleyHash crypto = ShelleyHash - { unShelleyHash :: SL.Hash crypto EraIndependentBlockHeader +newtype ShelleyHash = ShelleyHash + { unShelleyHash :: Hash.Hash HASH EraIndependentBlockHeader } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NoThunks) -deriving newtype instance Crypto crypto => ToCBOR (ShelleyHash crypto) +deriving newtype instance ToCBOR ShelleyHash -deriving newtype instance Crypto crypto => FromCBOR (ShelleyHash crypto) +deriving newtype instance FromCBOR ShelleyHash instance - Crypto crypto => - Serialise (ShelleyHash crypto) + Serialise ShelleyHash where encode = toCBOR decode = fromCBOR -instance Condense (ShelleyHash crypto) where +instance Condense ShelleyHash where condense = show . unShelleyHash {------------------------------------------------------------------------------- @@ -103,9 +102,9 @@ class ) => ProtocolHeaderSupportsEnvelope proto where - pHeaderHash :: ShelleyProtocolHeader proto -> ShelleyHash (ProtoCrypto proto) - pHeaderPrevHash :: ShelleyProtocolHeader proto -> PrevHash (ProtoCrypto proto) - pHeaderBodyHash :: ShelleyProtocolHeader proto -> Hash (ProtoCrypto proto) EraIndependentBlockBody + pHeaderHash :: ShelleyProtocolHeader proto -> ShelleyHash + pHeaderPrevHash :: ShelleyProtocolHeader proto -> PrevHash + pHeaderBodyHash :: ShelleyProtocolHeader proto -> Hash.Hash HASH EraIndependentBlockBody pHeaderSlot :: ShelleyProtocolHeader proto -> SlotNo pHeaderBlock :: ShelleyProtocolHeader proto -> BlockNo pHeaderSize :: ShelleyProtocolHeader proto -> Natural @@ -152,9 +151,9 @@ class ProtocolHeaderSupportsKES proto where -- | Block no BlockNo -> -- | Hash of the previous block - PrevHash crypto -> + PrevHash -> -- | Hash of the block body to include in the header - Hash crypto EraIndependentBlockBody -> + Hash.Hash HASH EraIndependentBlockBody -> -- | Size of the block body Int -> -- | Protocol version @@ -171,7 +170,7 @@ class ProtocolHeaderSupportsProtocol proto where ShelleyProtocolHeader proto -> ValidateView proto pHeaderIssuer :: - ShelleyProtocolHeader proto -> VKey 'BlockIssuer (ProtoCrypto proto) + ShelleyProtocolHeader proto -> VKey 'BlockIssuer pHeaderIssueNo :: ShelleyProtocolHeader proto -> Word64 -- | A VRF value in the header, used to choose between otherwise equally @@ -183,7 +182,7 @@ class ProtocolHeaderSupportsProtocol proto where -- to generalise this if, in the future, the ledger requires different things -- from the protocol. class ProtocolHeaderSupportsLedger proto where - mkHeaderView :: ShelleyProtocolHeader proto -> BHeaderView (ProtoCrypto proto) + mkHeaderView :: ShelleyProtocolHeader proto -> BHeaderView {------------------------------------------------------------------------------- diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/TPraos.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/TPraos.hs index 00549436a6..7711270abc 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/TPraos.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Protocol/TPraos.hs @@ -10,6 +10,7 @@ module Ouroboros.Consensus.Shelley.Protocol.TPraos () where import qualified Cardano.Crypto.KES as SL import Cardano.Crypto.VRF (certifiedOutput) import Cardano.Ledger.Chain (ChainPredicateFailure) +import qualified Cardano.Ledger.Hashes as SL import qualified Cardano.Ledger.Shelley.API as SL import Cardano.Protocol.TPraos.API (PraosCrypto) import qualified Cardano.Protocol.TPraos.API as SL @@ -44,7 +45,7 @@ instance PraosCrypto c => ProtocolHeaderSupportsEnvelope (TPraos c) where pHeaderBodyHash = SL.bhash . SL.bhbody pHeaderSlot = SL.bheaderSlotNo . SL.bhbody pHeaderBlock = SL.bheaderBlockNo . SL.bhbody - pHeaderSize = fromIntegral . SL.bHeaderSize + pHeaderSize = fromIntegral . SL.originalBytesSize pHeaderBlockSize = fromIntegral @Word32 @Natural . SL.bsize . SL.bhbody type EnvelopeCheckError _ = ChainPredicateFailure diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs index 1527dc8c6c..ce94554c1f 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -25,13 +26,13 @@ module Ouroboros.Consensus.Shelley.ShelleyHFC ( ) where import qualified Cardano.Ledger.Api.Era as L -import qualified Cardano.Ledger.BaseTypes as SL (mkVersion) +import qualified Cardano.Ledger.BaseTypes as SL (mkVersion, unNonZero) import qualified Cardano.Ledger.Core as SL import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (Crypto) import qualified Cardano.Protocol.TPraos.API as SL -import Cardano.Slotting.EpochInfo (hoistEpochInfo) import Control.Monad (guard) -import Control.Monad.Except (runExcept, throwError, withExceptT) +import Control.Monad.Except (runExcept, throwError) import Data.Coerce import qualified Data.Map.Strict as Map import Data.SOP.BasicFunctors @@ -39,9 +40,7 @@ import Data.SOP.InPairs (RequiringBoth (..), ignoringBoth) import qualified Data.Text as T (pack) import Data.Void (Void) import Data.Word -import GHC.Generics (Generic) import Lens.Micro ((^.)) -import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config import Ouroboros.Consensus.Forecast @@ -59,11 +58,12 @@ import Ouroboros.Consensus.Ledger.SupportsProtocol import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Protocol.Praos -import Ouroboros.Consensus.Protocol.TPraos hiding (PraosCrypto) +import Ouroboros.Consensus.Protocol.TPraos import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Ledger.Inspect as Shelley.Inspect import Ouroboros.Consensus.Shelley.Node () +import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Ouroboros.Consensus.TypeFamilyWrappers {------------------------------------------------------------------------------- @@ -79,7 +79,8 @@ type ShelleyBlockHFC proto era = HardForkBlock '[ShelleyBlock proto era] instance ( ShelleyCompatible proto era , LedgerSupportsProtocol (ShelleyBlock proto era) - , TxLimits (ShelleyBlock proto era) + , TxLimits (ShelleyBlock proto era) + , Crypto (ProtoCrypto proto) ) => NoHardForks (ShelleyBlock proto era) where getEraParams = shelleyEraParamsNeverHardForks @@ -100,6 +101,7 @@ instance ( ShelleyCompatible proto era instance ( ShelleyCompatible proto era , LedgerSupportsProtocol (ShelleyBlock proto era) , TxLimits (ShelleyBlock proto era) + , Crypto (ProtoCrypto proto) ) => SupportedNetworkProtocolVersion (ShelleyBlockHFC proto era) where supportedNodeToNodeVersions _ = Map.map HardForkNodeToNodeDisabled $ @@ -121,17 +123,19 @@ instance ( ShelleyCompatible proto era instance ( ShelleyCompatible proto era , LedgerSupportsProtocol (ShelleyBlock proto era) , TxLimits (ShelleyBlock proto era) + , Crypto (ProtoCrypto proto) ) => SerialiseHFC '[ShelleyBlock proto era] instance ( ShelleyCompatible proto era , LedgerSupportsProtocol (ShelleyBlock proto era) , TxLimits (ShelleyBlock proto era) + , Crypto (ProtoCrypto proto) ) => SerialiseConstraintsHFC (ShelleyBlock proto era) {------------------------------------------------------------------------------- Protocol type definition -------------------------------------------------------------------------------} -type ProtocolShelley = HardForkProtocol '[ ShelleyBlock (TPraos StandardCrypto) StandardShelley ] +type ProtocolShelley = HardForkProtocol '[ ShelleyBlock (TPraos StandardCrypto) ShelleyEra ] {------------------------------------------------------------------------------- SingleEraBlock Shelley @@ -154,11 +158,11 @@ shelleyTransition ShelleyPartialLedgerConfig{..} -- 'shelleyLedgerConfig' contains a dummy 'EpochInfo' but this does not -- matter for extracting the genesis config - genesis :: SL.ShelleyGenesis (EraCrypto era) + genesis :: SL.ShelleyGenesis genesis = shelleyLedgerGenesis shelleyLedgerConfig k :: Word64 - k = SL.sgSecurityParam genesis + k = SL.unNonZero $ SL.sgSecurityParam genesis isTransition :: ShelleyLedgerUpdate era -> Maybe EpochNo isTransition (ShelleyUpdatedPParams maybePParams newPParamsEpochNo) = do @@ -172,6 +176,7 @@ shelleyTransition ShelleyPartialLedgerConfig{..} instance ( ShelleyCompatible proto era , LedgerSupportsProtocol (ShelleyBlock proto era) , TxLimits (ShelleyBlock proto era) + , Crypto (ProtoCrypto proto) ) => SingleEraBlock (ShelleyBlock proto era) where singleEraTransition pcfg _eraParams _eraStart ledgerState = -- TODO: We might be evaluating 'singleEraTransition' more than once when @@ -194,7 +199,7 @@ instance ( ShelleyCompatible proto era singleEraName = T.pack (L.eraName @era) } -instance PraosCrypto c => HasPartialConsensusConfig (Praos c) where +instance Ouroboros.Consensus.Protocol.Praos.PraosCrypto c => HasPartialConsensusConfig (Praos c) where type PartialConsensusConfig (Praos c) = PraosParams completeConsensusConfig _ praosEpochInfo praosParams = PraosConfig {..} @@ -208,36 +213,6 @@ instance SL.PraosCrypto c => HasPartialConsensusConfig (TPraos c) where toPartialConsensusConfig _ = tpraosParams -data ShelleyPartialLedgerConfig era = ShelleyPartialLedgerConfig { - -- | We cache the non-partial ledger config containing a dummy - -- 'EpochInfo' that needs to be replaced with the correct one. - -- - -- We do this to avoid recomputing the ledger config each time - -- 'completeLedgerConfig' is called, as 'mkShelleyLedgerConfig' does - -- some rather expensive computations that shouldn't be repeated too - -- often (e.g., 'sgActiveSlotCoeff'). - shelleyLedgerConfig :: !(ShelleyLedgerConfig era) - , shelleyTriggerHardFork :: !TriggerHardFork - } - deriving (Generic) - -deriving instance (NoThunks (SL.TranslationContext era), SL.Era era) => - NoThunks (ShelleyPartialLedgerConfig era) - -instance ShelleyCompatible proto era => HasPartialLedgerConfig (ShelleyBlock proto era) where - type PartialLedgerConfig (ShelleyBlock proto era) = ShelleyPartialLedgerConfig era - - -- Replace the dummy 'EpochInfo' with the real one - completeLedgerConfig _ epochInfo (ShelleyPartialLedgerConfig cfg _) = - cfg { - shelleyLedgerGlobals = (shelleyLedgerGlobals cfg) { - SL.epochInfo = - hoistEpochInfo - (runExcept . withExceptT (T.pack . show)) - epochInfo - } - } - translateChainDepStateAcrossShelley :: forall eraFrom eraTo protoFrom protoTo. ( TranslateProto protoFrom protoTo @@ -315,7 +290,6 @@ forecastAcrossShelley cfgFrom cfgTo transition forecastFor ledgerStateFrom instance ( ShelleyBasedEra era , ShelleyBasedEra (SL.PreviousEra era) , SL.Era (SL.PreviousEra era) - , EraCrypto (SL.PreviousEra era) ~ EraCrypto era ) => SL.TranslateEra era (ShelleyTip proto) where translateEra _ (ShelleyTip sno bno (ShelleyHash hash)) = return $ ShelleyTip sno bno (ShelleyHash hash) diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node/Serialisation.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node/Serialisation.hs index 052da0c3f3..b361fa29cd 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node/Serialisation.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Ouroboros/Consensus/ByronDual/Node/Serialisation.hs @@ -8,6 +8,7 @@ module Ouroboros.Consensus.ByronDual.Node.Serialisation () where +import Cardano.Binary import Cardano.Chain.Slotting (EpochSlots) import qualified Data.ByteString.Lazy as Lazy import Data.Proxy @@ -136,6 +137,10 @@ instance SerialiseNodeToNode DualByronBlock (GenTxId DualByronBlock) where instance SerialiseNodeToClientConstraints DualByronBlock +instance SerialiseNodeToClient DualByronBlock (DualLedgerConfig ByronBlock ByronSpecBlock) where + encodeNodeToClient ccfg version = encodeDualLedgerConfig toCBOR (encodeNodeToClient ccfg version) + decodeNodeToClient ccfg version = decodeDualLedgerConfig fromCBOR (decodeNodeToClient ccfg version) + -- | CBOR-in-CBOR for the annotation. This also makes it compatible with the -- wrapped ('Serialised') variant. instance SerialiseNodeToClient DualByronBlock DualByronBlock where diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs index 9626d98aa9..b0e35a1ea5 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -28,6 +30,7 @@ import qualified Cardano.Chain.Byron.API as CC import qualified Cardano.Chain.Common as CC import qualified Cardano.Chain.Update.Validation.Interface as CC.UPI import qualified Cardano.Chain.UTxO as CC +import Cardano.Ledger.BaseTypes (knownNonZeroBounded) import Control.Monad.Except (runExcept) import qualified Data.Map.Strict as Map import Ouroboros.Consensus.Block @@ -62,7 +65,7 @@ import Test.Util.Serialisation.SomeResult (SomeResult (..)) -- 'S.WindowSize', because 'decodeByronChainDepState' only takes the -- 'SecurityParam' and uses it as the basis for the 'S.WindowSize'. secParam :: SecurityParam -secParam = SecurityParam 2 +secParam = SecurityParam $ knownNonZeroBounded @2 windowSize :: S.WindowSize windowSize = S.WindowSize 2 @@ -104,6 +107,7 @@ examples = Examples { , exampleQuery = unlabelled exampleQuery , exampleResult = unlabelled exampleResult , exampleAnnTip = unlabelled exampleAnnTip + , exampleLedgerConfig = unlabelled ledgerConfig , exampleLedgerState = unlabelled exampleLedgerState , exampleChainDepState = unlabelled exampleChainDepState , exampleExtLedgerState = unlabelled exampleExtLedgerState @@ -122,7 +126,7 @@ exampleBlock = cfg (BlockNo 1) (SlotNo 1) - (applyChainTick ledgerConfig (SlotNo 1) ledgerStateAfterEBB) + (applyChainTick OmitLedgerEvents ledgerConfig (SlotNo 1) ledgerStateAfterEBB) [ValidatedByronTx exampleGenTx] (fakeMkIsLeader leaderCredentials) where @@ -180,14 +184,14 @@ emptyLedgerState = ByronLedgerState { ledgerStateAfterEBB :: LedgerState ByronBlock ledgerStateAfterEBB = - reapplyLedgerBlock ledgerConfig exampleEBB - . applyChainTick ledgerConfig (SlotNo 0) + reapplyLedgerBlock OmitLedgerEvents ledgerConfig exampleEBB + . applyChainTick OmitLedgerEvents ledgerConfig (SlotNo 0) $ emptyLedgerState exampleLedgerState :: LedgerState ByronBlock exampleLedgerState = - reapplyLedgerBlock ledgerConfig exampleBlock - . applyChainTick ledgerConfig (SlotNo 1) + reapplyLedgerBlock OmitLedgerEvents ledgerConfig exampleBlock + . applyChainTick OmitLedgerEvents ledgerConfig (SlotNo 1) $ ledgerStateAfterEBB exampleHeaderState :: HeaderState ByronBlock diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Generators.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Generators.hs index ee39d62924..2dbcd10367 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Generators.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Generators.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -14,7 +16,8 @@ import Cardano.Chain.Block (ABlockOrBoundary (..), ABlockOrBoundaryHdr (..)) import qualified Cardano.Chain.Block as CC.Block import qualified Cardano.Chain.Byron.API as API -import Cardano.Chain.Common (KeyHash) +import Cardano.Chain.Common (Address, BlockCount (..), CompactAddress, + KeyHash, Lovelace) import qualified Cardano.Chain.Delegation as CC.Del import qualified Cardano.Chain.Delegation.Validation.Activation as CC.Act import qualified Cardano.Chain.Delegation.Validation.Interface as CC.DI @@ -26,12 +29,21 @@ import qualified Cardano.Chain.Update as CC.Update import qualified Cardano.Chain.Update.Validation.Interface as CC.UPI import qualified Cardano.Chain.Update.Validation.Registration as CC.Reg import qualified Cardano.Chain.UTxO as CC.UTxO -import Cardano.Crypto (ProtocolMagicId (..)) +import Cardano.Crypto (ProtocolMagicId (..), + RequiresNetworkMagic (..)) import Cardano.Crypto.Hashing (Hash) +import Cardano.Crypto.Signing +import qualified Cardano.Crypto.Wallet as Wallet +import Cardano.Ledger.BaseTypes (knownNonZeroBounded) import Cardano.Ledger.Binary (decCBOR, encCBOR) import Control.Monad (replicateM) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as BSC8 import Data.Coerce (coerce) import qualified Data.Map.Strict as Map +import Data.String (IsString (fromString)) +import qualified Data.Text as T import Ouroboros.Consensus.Block import Ouroboros.Consensus.Byron.Ledger import Ouroboros.Consensus.Byron.Protocol @@ -63,7 +75,7 @@ import Test.Util.Serialisation.SomeResult (SomeResult (..)) -- | Matches that from the 'CC.dummyConfig' k :: SecurityParam -k = SecurityParam 10 +k = SecurityParam $ knownNonZeroBounded @10 -- | Matches that from the 'CC.dummyConfig' epochSlots :: EpochSlots @@ -72,6 +84,82 @@ epochSlots = EpochSlots 100 protocolMagicId :: ProtocolMagicId protocolMagicId = ProtocolMagicId 100 +instance Arbitrary CC.Genesis.Config where + arbitrary = CC.Genesis.Config + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary CC.Genesis.GenesisData where + arbitrary = CC.Genesis.GenesisData + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary CC.Genesis.GenesisKeyHashes where + arbitrary = CC.Genesis.GenesisKeyHashes <$> arbitrary + +instance Arbitrary CC.Genesis.GenesisDelegation where + arbitrary = (CC.Genesis.mkGenesisDelegation <$> arbitrary) + `suchThatMap` (either (const Nothing) Just) + +instance Arbitrary (CC.Del.ACertificate ()) where + arbitrary = CC.Del.signCertificate + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary SafeSigner where + arbitrary = do + seed <- BS.pack <$> sequence (replicate 32 arbitrary) + passPhrase <- BS.pack <$> sequence (replicate passphraseLength arbitrary) + let xprv = Wallet.generate seed passPhrase + return $ SafeSigner (SigningKey xprv) (PassPhrase (fromString (BSC8.unpack passPhrase))) + +instance Arbitrary VerificationKey where + arbitrary = either (error . show) id . parseFullVerificationKey <$> + (T.pack . BSC8.unpack . B64.encode <$> arbitraryKey) + where + -- The key must be 64 bytes + arbitraryKey = BS.pack <$> sequence (replicate 64 arbitrary) + +instance Arbitrary CC.Genesis.GenesisNonAvvmBalances where + arbitrary = CC.Genesis.GenesisNonAvvmBalances <$> arbitrary + +instance Arbitrary Address where + arbitrary = hedgehog CC.genAddress + +instance Arbitrary Lovelace where + arbitrary = hedgehog CC.genLovelace + +instance Arbitrary CC.Genesis.GenesisAvvmBalances where + arbitrary = CC.Genesis.GenesisAvvmBalances <$> arbitrary + +instance Arbitrary CompactRedeemVerificationKey where + arbitrary = hedgehog CC.genCompactRedeemVerificationKey + +instance Arbitrary BlockCount where + arbitrary = hedgehog CC.genBlockCount + +instance Arbitrary RequiresNetworkMagic where + arbitrary = hedgehog CC.genRequiresNetworkMagic + +instance Arbitrary ProtocolMagicId where + arbitrary = hedgehog CC.genProtocolMagicId + +instance Arbitrary CC.UTxO.UTxOConfiguration where + arbitrary = CC.UTxO.UTxOConfiguration <$> arbitrary + +instance Arbitrary CompactAddress where + arbitrary = hedgehog CC.genCompactAddress + -- | A 'ByronBlock' that is never an EBB. newtype RegularBlock = RegularBlock { unRegularBlock :: ByronBlock } deriving (Eq, Show) diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/Genesis.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/Genesis.hs index 2cb0ee2b1d..38a6d58400 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/Genesis.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/Genesis.hs @@ -10,6 +10,7 @@ import qualified Cardano.Chain.Common as Common import qualified Cardano.Chain.Genesis as Genesis import qualified Cardano.Chain.Update as Update import qualified Cardano.Crypto as Crypto +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Monad.Except (runExceptT) import Ouroboros.Consensus.BlockchainTime import Ouroboros.Consensus.Byron.Ledger.Conversions @@ -37,7 +38,7 @@ byronPBftParams paramK numCoreNodes = PBftParams n = fromIntegral x where NumCoreNodes x = numCoreNodes k :: Num a => a - k = fromIntegral x where SecurityParam x = paramK + k = fromIntegral x where x = unNonZero $ maxRollbacks paramK -- Instead of using 'Dummy.dummyConfig', which hard codes the number of rich -- men (= CoreNodes for us) to 4, we generate a dummy config with the given @@ -62,7 +63,7 @@ generateGenesisConfig slotLen params = -- The nodes are the richmen { Genesis.tboRichmen = fromIntegral numCoreNodes } } - , Genesis.gsK = Common.BlockCount $ maxRollbacks pbftSecurityParam + , Genesis.gsK = Common.BlockCount $ unNonZero $ maxRollbacks pbftSecurityParam , Genesis.gsProtocolParameters = gsProtocolParameters { Update.ppSlotDuration = toByronSlotLength slotLen } diff --git a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/TrackUpdates.hs b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/TrackUpdates.hs index 98848eecb9..24c40bf8ef 100644 --- a/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/TrackUpdates.hs +++ b/ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/ThreadNet/Infra/Byron/TrackUpdates.hs @@ -24,6 +24,7 @@ import qualified Cardano.Chain.Update.Validation.Registration as Registration import Cardano.Chain.Update.Vote (AVote) import qualified Cardano.Chain.Update.Vote as Vote import qualified Cardano.Crypto as Crypto +import Cardano.Ledger.BaseTypes (unNonZero) import Cardano.Ledger.Binary (ByteSpan, DecCBOR (..), EncCBOR (..)) import Control.Exception (assert) import Control.Monad (guard) @@ -106,7 +107,7 @@ mkUpdateLabels params numSlots genesisConfig nodeJoinPlan topology result -- a block forged in slot @s@ becomes immutable/stable in slot @s + twoK@ -- according to the Byron Chain Density invariant twoK :: SlotNo - twoK = SlotNo $ 2 * maxRollbacks pbftSecurityParam + twoK = SlotNo $ 2 * unNonZero (maxRollbacks pbftSecurityParam) -- the number of slots in an epoch epochSlots :: SlotNo diff --git a/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Genesis.hs b/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Genesis.hs index 442ac748a6..ae7a17e0b7 100644 --- a/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Genesis.hs +++ b/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Genesis.hs @@ -1,5 +1,10 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} -- | Genesis config for the spec -- @@ -23,12 +28,15 @@ import qualified Byron.Spec.Chain.STS.Rule.Chain as Spec import qualified Byron.Spec.Ledger.Core as Spec import qualified Byron.Spec.Ledger.Update as Spec import qualified Byron.Spec.Ledger.UTxO as Spec +import Cardano.Binary +import Codec.Serialise (Serialise (..)) import qualified Control.State.Transition as Spec import Data.Coerce (coerce) import Data.Set (Set) import NoThunks.Class (AllowThunk (..), NoThunks) import Numeric.Natural (Natural) import Ouroboros.Consensus.ByronSpec.Ledger.Orphans () +import Ouroboros.Consensus.Node.Serialisation {------------------------------------------------------------------------------- Genesis config @@ -52,6 +60,24 @@ data ByronSpecGenesis = ByronSpecGenesis { deriving stock (Show) deriving NoThunks via AllowThunk ByronSpecGenesis +instance SerialiseNodeToClient blk ByronSpecGenesis where + encodeNodeToClient _ _ (ByronSpecGenesis delegators utxo pparams k slotLength) = mconcat + [ encodeListLen 5 + , toCBOR delegators + , encode utxo + , encode pparams + , toCBOR k + , toCBOR slotLength + ] + decodeNodeToClient _ _ = do + enforceSize "ByronSpecGenesis" 5 + ByronSpecGenesis + <$> fromCBOR @(Set Spec.VKeyGenesis) + <*> decode @Spec.UTxO + <*> decode @Spec.PParams + <*> fromCBOR @Spec.BlockCount + <*> fromCBOR @Natural + modPBftThreshold :: (Double -> Double) -> ByronSpecGenesis -> ByronSpecGenesis modPBftThreshold = modPParams . modPParamsPBftThreshold diff --git a/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs b/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs index 685056d3f3..379949fb89 100644 --- a/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs +++ b/ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs @@ -33,7 +33,6 @@ import qualified Ouroboros.Consensus.ByronSpec.Ledger.Rules as Rules import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.CommonProtocolParams import Ouroboros.Consensus.Ticked -import Ouroboros.Consensus.Util ((..:)) {------------------------------------------------------------------------------- State @@ -103,7 +102,7 @@ instance IsLedger (LedgerState ByronSpecBlock) where type AuxLedgerEvent (LedgerState ByronSpecBlock) = VoidLedgerEvent (LedgerState ByronSpecBlock) - applyChainTickLedgerResult cfg slot (ByronSpecLedgerState tip state) = + applyChainTickLedgerResult _evs cfg slot (ByronSpecLedgerState tip state) = pureLedgerResult $ TickedByronSpecLedgerState { untickedByronSpecLedgerTip = tip @@ -118,7 +117,7 @@ instance IsLedger (LedgerState ByronSpecBlock) where -------------------------------------------------------------------------------} instance ApplyBlock (LedgerState ByronSpecBlock) ByronSpecBlock where - applyBlockLedgerResult cfg block (TickedByronSpecLedgerState _tip state) = + applyBlockLedgerResultWithValidation _ _ cfg block (TickedByronSpecLedgerState _tip state) = withExcept ByronSpecLedgerError $ fmap (pureLedgerResult . ByronSpecLedgerState (Just (blockSlot block))) $ -- Note that the CHAIN rule also applies the chain tick. So even @@ -131,14 +130,9 @@ instance ApplyBlock (LedgerState ByronSpecBlock) ByronSpecBlock where (byronSpecBlock block) state + applyBlockLedgerResult = defaultApplyBlockLedgerResult reapplyBlockLedgerResult = - -- The spec doesn't have a "reapply" mode - dontExpectError ..: applyBlockLedgerResult - where - dontExpectError :: Except a b -> b - dontExpectError mb = case runExcept mb of - Left _ -> error "reapplyBlockLedgerResult: unexpected error" - Right b -> b + defaultReapplyBlockLedgerResult (error . ("reapplyBlockLedgerResult: unexpected error " ++) . show) {------------------------------------------------------------------------------- CommonProtocolParams diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs index 18741f6dae..716f325a72 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -27,22 +29,23 @@ module Test.Consensus.Cardano.Examples ( , examples ) where -import Data.Coerce (Coercible) +import Data.Coerce (Coercible, coerce) import Data.SOP.BasicFunctors import Data.SOP.Counting (Exactly (..)) -import Data.SOP.Index (Index (..)) +import Data.SOP.Index (Index (..), himap) import Data.SOP.Strict import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Byron.ByronHFC import Ouroboros.Consensus.Byron.Ledger (ByronBlock) import qualified Ouroboros.Consensus.Byron.Ledger as Byron import Ouroboros.Consensus.Cardano.Block -import Ouroboros.Consensus.Cardano.CanHardFork () +import Ouroboros.Consensus.Cardano.CanHardFork import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.HardFork.Combinator.Embed.Nary import qualified Ouroboros.Consensus.HardFork.Combinator.State as State import qualified Ouroboros.Consensus.HardFork.History as History -import Ouroboros.Consensus.HeaderValidation (AnnTip) -import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..)) +import Ouroboros.Consensus.HeaderValidation +import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr) import Ouroboros.Consensus.Protocol.TPraos (TPraos) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) @@ -75,28 +78,83 @@ eraExamples = combineEras :: NP Examples (CardanoEras Crypto) -> Examples (CardanoBlock Crypto) -combineEras = mconcat . hcollapse . hap eraInjections +combineEras perEraExamples = Examples { + exampleBlock = coerce $ viaInject @I (coerce exampleBlock) + , exampleSerialisedBlock = viaInject exampleSerialisedBlock + , exampleHeader = viaInject exampleHeader + , exampleSerialisedHeader = viaInject exampleSerialisedHeader + , exampleHeaderHash = coerce $ viaInject @WrapHeaderHash (coerce exampleHeaderHash) + , exampleGenTx = viaInject exampleGenTx + , exampleGenTxId = coerce $ viaInject @WrapGenTxId (coerce exampleGenTxId) + , exampleApplyTxErr = coerce $ viaInject @WrapApplyTxErr (coerce exampleApplyTxErr) + , exampleQuery = viaInject exampleQuery + , exampleResult = viaInject exampleResult + , exampleAnnTip = viaInject exampleAnnTip + , exampleLedgerState = viaInject exampleLedgerState + , exampleChainDepState = coerce $ viaInject @WrapChainDepState (coerce exampleChainDepState) + , exampleExtLedgerState = viaInject exampleExtLedgerState + , exampleSlotNo = coerce $ viaInject @(K SlotNo) (coerce exampleSlotNo) + , exampleLedgerConfig = exampleLedgerConfigCardano + } where - eraInjections :: NP (Examples -.-> K (Examples (CardanoBlock Crypto))) - (CardanoEras Crypto) - eraInjections = - fn (K . injExamples "Byron" IZ) - :* fn (K . injExamples "Shelley" (IS IZ)) - :* fn (K . injExamples "Allegra" (IS (IS IZ))) - :* fn (K . injExamples "Mary" (IS (IS (IS IZ)))) - :* fn (K . injExamples "Alonzo" (IS (IS (IS (IS IZ))))) - :* fn (K . injExamples "Babbage" (IS (IS (IS (IS (IS IZ)))))) - :* fn (K . injExamples "Conway" (IS (IS (IS (IS (IS (IS IZ))))))) - :* Nil - - injExamples :: - String - -> Index (CardanoEras Crypto) blk - -> Examples blk - -> Examples (CardanoBlock Crypto) - injExamples eraName idx = - prefixExamples eraName - . inject (oracularInjectionIndex exampleStartBounds idx) + viaInject :: + forall f. Inject f + => (forall blk. Examples blk -> Labelled (f blk)) + -> Labelled (f (CardanoBlock Crypto)) + viaInject getExamples = + mconcat + $ hcollapse + $ himap (\ix -> K . inj ix . getExamples) perEraExamplesPrefixed + where + inj :: forall blk. Index (CardanoEras Crypto) blk -> Labelled (f blk) -> Labelled (f (CardanoBlock Crypto)) + inj idx = fmap (fmap (inject $ oracularInjectionIndex exampleStartBounds idx)) + + perEraExamplesPrefixed :: NP Examples (CardanoEras Crypto) + perEraExamplesPrefixed = hzipWith (\(K eraName) es -> prefixExamples eraName es) perEraNames perEraExamples + where + perEraNames = K "Byron" + :* K "Shelley" + :* K "Allegra" + :* K "Mary" + :* K "Alonzo" + :* K "Babbage" + :* K "Conway" + :* Nil + + exampleLedgerConfigCardano :: + Labelled (HardForkLedgerConfig (CardanoEras Crypto)) + exampleLedgerConfigCardano = [ + ( Nothing + , HardForkLedgerConfig + cardanoShape + (PerEraLedgerConfig ( + WrapPartialLedgerConfig (ByronPartialLedgerConfig lcByron (TriggerHardForkAtEpoch shelleyTransitionEpoch)) + :* WrapPartialLedgerConfig (ShelleyPartialLedgerConfig lcShelley (TriggerHardForkAtEpoch (History.boundEpoch allegraStartBound))) + :* WrapPartialLedgerConfig (ShelleyPartialLedgerConfig lcAllegra (TriggerHardForkAtEpoch (History.boundEpoch maryStartBound))) + :* WrapPartialLedgerConfig (ShelleyPartialLedgerConfig lcMary (TriggerHardForkAtEpoch (History.boundEpoch alonzoStartBound))) + :* WrapPartialLedgerConfig (ShelleyPartialLedgerConfig lcAlonzo (TriggerHardForkAtEpoch (History.boundEpoch babbageStartBound))) + :* WrapPartialLedgerConfig (ShelleyPartialLedgerConfig lcBabbage (TriggerHardForkAtEpoch (History.boundEpoch conwayStartBound))) + :* WrapPartialLedgerConfig (ShelleyPartialLedgerConfig lcConway TriggerHardForkNotDuringThisExecution) + :* Nil)) + ) + | WrapLedgerConfig lcByron <- labelledLcByron + , WrapLedgerConfig lcShelley <- labelledLcShelley + , WrapLedgerConfig lcAllegra <- labelledLcAllegra + , WrapLedgerConfig lcMary <- labelledLcMary + , WrapLedgerConfig lcAlonzo <- labelledLcAlonzo + , WrapLedgerConfig lcBabbage <- labelledLcBabbage + , WrapLedgerConfig lcConway <- labelledLcConway + ] + where + ( Comp labelledLcByron + :* Comp labelledLcShelley + :* Comp labelledLcAllegra + :* Comp labelledLcMary + :* Comp labelledLcAlonzo + :* Comp labelledLcBabbage + :* Comp labelledLcConway + :* Nil + ) = hmap (Comp . fmap (WrapLedgerConfig . snd) . exampleLedgerConfig) perEraExamples {------------------------------------------------------------------------------- Inject instances @@ -130,6 +188,8 @@ instance Inject Examples where , exampleChainDepState = inj (Proxy @WrapChainDepState) exampleChainDepState , exampleExtLedgerState = inj (Proxy @ExtLedgerState) exampleExtLedgerState , exampleSlotNo = exampleSlotNo + -- We cannot create a HF Ledger Config out of just one of the eras + , exampleLedgerConfig = mempty } where inj :: @@ -141,6 +201,8 @@ instance Inject Examples where => Proxy f -> Labelled a -> Labelled b inj p = map (fmap (inject' p iidx)) + + {------------------------------------------------------------------------------- Setup -------------------------------------------------------------------------------} @@ -149,22 +211,22 @@ byronEraParams :: History.EraParams byronEraParams = Byron.byronEraParams Byron.ledgerConfig shelleyEraParams :: History.EraParams -shelleyEraParams = Shelley.shelleyEraParams @StandardCrypto Shelley.testShelleyGenesis +shelleyEraParams = Shelley.shelleyEraParams Shelley.testShelleyGenesis allegraEraParams :: History.EraParams -allegraEraParams = Shelley.shelleyEraParams @StandardCrypto Shelley.testShelleyGenesis +allegraEraParams = Shelley.shelleyEraParams Shelley.testShelleyGenesis maryEraParams :: History.EraParams -maryEraParams = Shelley.shelleyEraParams @StandardCrypto Shelley.testShelleyGenesis +maryEraParams = Shelley.shelleyEraParams Shelley.testShelleyGenesis alonzoEraParams :: History.EraParams -alonzoEraParams = Shelley.shelleyEraParams @StandardCrypto Shelley.testShelleyGenesis +alonzoEraParams = Shelley.shelleyEraParams Shelley.testShelleyGenesis babbageEraParams :: History.EraParams -babbageEraParams = Shelley.shelleyEraParams @StandardCrypto Shelley.testShelleyGenesis +babbageEraParams = Shelley.shelleyEraParams Shelley.testShelleyGenesis conwayEraParams :: History.EraParams -conwayEraParams = Shelley.shelleyEraParams @StandardCrypto Shelley.testShelleyGenesis +conwayEraParams = Shelley.shelleyEraParams Shelley.testShelleyGenesis -- | We use 10, 20, 30, 40, ... as the transition epochs shelleyTransitionEpoch :: EpochNo @@ -251,8 +313,8 @@ summary = eraInfoByron :: SingleEraInfo ByronBlock eraInfoByron = singleEraInfo (Proxy @ByronBlock) -eraInfoShelley :: SingleEraInfo (ShelleyBlock (TPraos StandardCrypto) StandardShelley) -eraInfoShelley = singleEraInfo (Proxy @(ShelleyBlock (TPraos StandardCrypto) StandardShelley)) +eraInfoShelley :: SingleEraInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) +eraInfoShelley = singleEraInfo (Proxy @(ShelleyBlock (TPraos StandardCrypto) ShelleyEra)) codecConfig :: CardanoCodecConfig Crypto codecConfig = 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 90699827fd..16f448787a 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 @@ -21,20 +21,23 @@ -- -- We combine the Byron and Shelley-based instances defined elsewhere into -- Cardano instances by picking randomly from one of the eras. -module Test.Consensus.Cardano.Generators (module Test.Consensus.Byron.Generators) where +module Test.Consensus.Cardano.Generators () where import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe) import Data.Proxy import Data.SOP.BasicFunctors +import Data.SOP.Counting (Exactly (..)) import Data.SOP.Index import Data.SOP.NonEmpty import Data.SOP.Sing import Data.SOP.Strict import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Byron.ByronHFC import Ouroboros.Consensus.Byron.Ledger import Ouroboros.Consensus.Cardano.Block -import Ouroboros.Consensus.Cardano.Node (CardanoHardForkConstraints) +import Ouroboros.Consensus.Cardano.CanHardFork +import Ouroboros.Consensus.Cardano.Node () import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.HardFork.Combinator.Serialisation import qualified Ouroboros.Consensus.HardFork.History as History @@ -42,13 +45,15 @@ import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.Serialisation (Some (..)) import Ouroboros.Consensus.Protocol.TPraos (TPraos) +import Ouroboros.Consensus.Shelley.HFEras () import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Ledger.Block () import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.TypeFamilyWrappers +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.Byron.Generators () import Test.Consensus.Cardano.MockCrypto import Test.Consensus.Protocol.Serialisation.Generators () import Test.Consensus.Shelley.Generators @@ -113,7 +118,7 @@ instance Arbitrary (Coherent (CardanoBlock MockCryptoCompatByron)) where instance Arbitrary (CardanoHeader MockCryptoCompatByron) where arbitrary = getHeader <$> arbitrary -instance (CanMock (TPraos c) (ShelleyEra c), CardanoHardForkConstraints c) +instance (CanMock (TPraos c) ShelleyEra, CardanoHardForkConstraints c) => Arbitrary (OneEraHash (CardanoEras c)) where arbitrary = inj <$> arbitrary where @@ -125,7 +130,7 @@ instance (CanMock (TPraos c) (ShelleyEra c), CardanoHardForkConstraints c) => WrapHeaderHash blk -> K (OneEraHash (CardanoEras c)) blk aux = K . OneEraHash . toShortRawHash (Proxy @blk) . unwrapHeaderHash -instance (c ~ MockCryptoCompatByron, ShelleyBasedEra (ShelleyEra c)) +instance (c ~ MockCryptoCompatByron, ShelleyBasedEra ShelleyEra) => Arbitrary (AnnTip (CardanoBlock c)) where arbitrary = AnnTip <$> (SlotNo <$> arbitrary) @@ -543,19 +548,6 @@ instance Arbitrary History.EraEnd where , return History.EraUnbounded ] -instance Arbitrary History.SafeZone where - arbitrary = oneof - [ History.StandardSafeZone <$> arbitrary - , return History.UnsafeIndefiniteSafeZone - ] - -instance Arbitrary History.EraParams where - arbitrary = History.EraParams - <$> (EpochSize <$> arbitrary) - <*> arbitrary - <*> arbitrary - <*> (GenesisWindow <$> arbitrary) - instance Arbitrary History.EraSummary where arbitrary = History.EraSummary <$> arbitrary @@ -705,3 +697,63 @@ instance c ~ MockCryptoCompatByron <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary) <*> (SomeResult (QueryHardFork GetCurrentEra) <$> arbitrary) ] + +{------------------------------------------------------------------------------ + Ledger Config +------------------------------------------------------------------------------} + + +-- | See 'encodeNodeToClientNP' and 'decodeNodeToClientNP'. +instance CardanoHardForkConstraints c + => Arbitrary (WithVersion + (HardForkNodeToClientVersion (CardanoEras c)) + (HardForkLedgerConfig (CardanoEras c)) + ) where + arbitrary = WithVersion + -- Use a version that enables all eras. We assume that all eras are + -- enabled in the maximum supported version. + (snd $ fromMaybe err $ Map.lookupMax $ supportedNodeToClientVersions (Proxy @(CardanoBlock c))) + <$> arbitrary + where + err = error "Expected at least 1 supported note-to-client version, but `supportedNodeToClientVersions` has none" + +instance CardanoHardForkConstraints c + => Arbitrary (HardForkLedgerConfig (CardanoEras c)) where + arbitrary = HardForkLedgerConfig <$> arbitrary <*> arbitrary + +instance SListI xs => Arbitrary (History.Shape xs) where + arbitrary = History.Shape . Exactly <$> hsequenceK (hpure (K arbitrary)) + +instance (CardanoHardForkConstraints c) + => Arbitrary (PerEraLedgerConfig (CardanoEras c)) where + arbitrary = do + byronPLC <- WrapPartialLedgerConfig <$> arbitrary + shelleyPLC <- WrapPartialLedgerConfig <$> arbitrary + allegraPLC <- WrapPartialLedgerConfig <$> arbitrary + maryPLC <- WrapPartialLedgerConfig <$> arbitrary + alonzoPLC <- WrapPartialLedgerConfig <$> arbitrary + babbagePLC <- WrapPartialLedgerConfig <$> arbitrary + conwayPLC <- WrapPartialLedgerConfig <$> arbitrary + return $ PerEraLedgerConfig $ + byronPLC + :* shelleyPLC + :* allegraPLC + :* maryPLC + :* alonzoPLC + :* babbagePLC + :* conwayPLC + :* Nil + +instance Arbitrary ByronPartialLedgerConfig where + arbitrary = ByronPartialLedgerConfig <$> arbitrary <*> arbitrary + +instance Arbitrary (ShelleyLedgerConfig era) + => Arbitrary (ShelleyPartialLedgerConfig era) where + arbitrary = ShelleyPartialLedgerConfig <$> arbitrary <*> arbitrary + +instance Arbitrary TriggerHardFork where + arbitrary = oneof [ + TriggerHardForkAtVersion <$> arbitrary + , TriggerHardForkAtEpoch <$> arbitrary + , pure TriggerHardForkNotDuringThisExecution + ] diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/MockCrypto.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/MockCrypto.hs index 7babc4c283..7685c21881 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/MockCrypto.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/MockCrypto.hs @@ -6,11 +6,9 @@ module Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron) where -import Cardano.Crypto.DSIGN (Ed25519DSIGN) -import Cardano.Crypto.Hash (Blake2b_224, Blake2b_256) import Cardano.Crypto.KES (MockKES) import Cardano.Crypto.VRF (MockVRF) -import Cardano.Ledger.Crypto (Crypto (..)) +import Cardano.Protocol.Crypto (Crypto (..)) import qualified Ouroboros.Consensus.Protocol.Praos as Praos import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos @@ -35,9 +33,6 @@ import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos data MockCryptoCompatByron instance Crypto MockCryptoCompatByron where - type ADDRHASH MockCryptoCompatByron = Blake2b_224 - type DSIGN MockCryptoCompatByron = Ed25519DSIGN - type HASH MockCryptoCompatByron = Blake2b_256 type KES MockCryptoCompatByron = MockKES 10 type VRF MockCryptoCompatByron = MockVRF diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs index e3943da9f6..398e487864 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -- | Utility functions to elaborate a Cardano 'ProtocolInfo' from certain parameters. module Test.Consensus.Cardano.ProtocolInfo ( @@ -23,9 +22,9 @@ module Test.Consensus.Cardano.ProtocolInfo ( import qualified Cardano.Chain.Genesis as CC.Genesis import qualified Cardano.Chain.Update as CC.Update -import Cardano.Ledger.Api.Era (StandardCrypto) import qualified Cardano.Ledger.Api.Transition as L import qualified Cardano.Ledger.BaseTypes as SL +import Cardano.Protocol.Crypto (StandardCrypto) import qualified Cardano.Protocol.TPraos.OCert as SL import qualified Cardano.Slotting.Time as Time import Data.Proxy (Proxy (..)) @@ -144,7 +143,7 @@ hardForkInto Conway = -- mkSimpleTestProtocolInfo :: forall c - . (CardanoHardForkConstraints c, c ~ StandardCrypto) + . (CardanoHardForkConstraints c) => Shelley.DecentralizationParam -- ^ Network decentralization parameter. -> SecurityParam @@ -175,6 +174,7 @@ mkSimpleTestProtocolInfo aByronProtocolVersion = CC.Update.ProtocolVersion 0 0 0 + coreNodeShelley :: Shelley.CoreNode c coreNodeShelley = runGen initSeed $ Shelley.genCoreNode initialKESPeriod where initSeed :: Seed @@ -190,7 +190,7 @@ mkSimpleTestProtocolInfo (genesisByron, generatedSecretsByron) = Byron.generateGenesisConfig (toSlotLength byronSlotLenghtInSeconds) pbftParams - shelleyGenesis :: ShelleyGenesis c + shelleyGenesis :: ShelleyGenesis shelleyGenesis = Shelley.mkGenesisConfig protocolVersion @@ -199,7 +199,7 @@ mkSimpleTestProtocolInfo decentralizationParam maxLovelaceSupply (toSlotLength shelleySlotLengthInSeconds) - (Shelley.mkKesConfig (Proxy @c) numSlots) + (Shelley.mkKesConfig (Proxy @StandardCrypto) numSlots) [coreNodeShelley] where maxLovelaceSupply :: Word64 @@ -214,10 +214,10 @@ mkSimpleTestProtocolInfo -- mkTestProtocolInfo :: forall m c - . (CardanoHardForkConstraints c, IOLike m, c ~ StandardCrypto) + . (CardanoHardForkConstraints c, IOLike m) --, c ~ StandardCrypto) => (CoreNodeId, Shelley.CoreNode c) -- ^ Id of the node for which the protocol info will be elaborated. - -> ShelleyGenesis c + -> ShelleyGenesis -- ^ These nodes will be part of the initial delegation mapping, and funds -- will be allocated to these nodes. -> CC.Update.ProtocolVersion diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs index 6f12f3d9b6..4465d5df69 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs @@ -41,8 +41,7 @@ import Data.Void (Void) import Lens.Micro ((^.)) import Ouroboros.Consensus.Block.Forging (BlockForging) import Ouroboros.Consensus.Cardano.CanHardFork - (ShelleyPartialLedgerConfig (..), - crossEraForecastAcrossShelley, + (crossEraForecastAcrossShelley, translateChainDepStateAcrossShelley) import Ouroboros.Consensus.Cardano.Node (TriggerHardFork (..)) import Ouroboros.Consensus.HardFork.Combinator @@ -60,6 +59,7 @@ import Ouroboros.Consensus.Protocol.TPraos import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Node +import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util (eitherToMaybe) import Ouroboros.Consensus.Util.IOLike (IOLike) @@ -156,9 +156,9 @@ type ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 = , SL.TranslationError era2 SL.NewEpochState ~ Void -- At the moment, fix the protocols together - , EraCrypto era1 ~ EraCrypto era2 - , PraosCrypto (EraCrypto era1) - , proto1 ~ TPraos (EraCrypto era1) + , ProtoCrypto proto1 ~ ProtoCrypto proto2 + , PraosCrypto (ProtoCrypto proto1) + , proto1 ~ TPraos (ProtoCrypto proto1) , proto1 ~ proto2 ) @@ -266,7 +266,7 @@ instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 protocolInfoShelleyBasedHardFork :: forall m proto1 era1 proto2 era2. (IOLike m, ShelleyBasedHardForkConstraints proto1 era1 proto2 era2) - => ProtocolParamsShelleyBased (EraCrypto era1) + => ProtocolParamsShelleyBased (ProtoCrypto proto1) -> SL.ProtVer -> SL.ProtVer -> L.TransitionConfig era2 @@ -300,7 +300,7 @@ protocolInfoShelleyBasedHardFork protocolParamsShelleyBased -- Era 1 - genesis :: SL.ShelleyGenesis (EraCrypto era1) + genesis :: SL.ShelleyGenesis genesis = transCfg2 ^. L.tcShelleyGenesisL protocolInfo1 :: ProtocolInfo (ShelleyBlock proto1 era1) diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs index 713d4043c0..38625a7bfc 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/TwoEras.hs @@ -35,6 +35,7 @@ module Test.ThreadNet.Infra.TwoEras ( import qualified Cardano.Chain.Common as CC.Common import Cardano.Chain.ProtocolConstants (kEpochSlots) import Cardano.Chain.Slotting (unEpochSlots) +import Cardano.Ledger.BaseTypes (unNonZero) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Protocol.TPraos.Rules.Overlay as SL import Cardano.Slotting.EpochInfo @@ -91,7 +92,7 @@ genTestConfig k (EpochSize epochSize1, EpochSize epochSize2) = do initSeed <- arbitrary numSlots <- do - let wiggle = min epochSize1 (2 * maxRollbacks k) + let wiggle = min epochSize1 (2 * unNonZero (maxRollbacks k)) approachSecondEra = choose (0, wiggle) <&> \t -> epochSize1 + t - wiggle @@ -140,10 +141,12 @@ genTestConfig k (EpochSize epochSize1, EpochSize epochSize2) = do -- | Generate 'setupPartition' genPartition :: NumCoreNodes -> NumSlots -> SecurityParam -> Gen Partition -genPartition (NumCoreNodes n) (NumSlots t) (SecurityParam k) = do +genPartition (NumCoreNodes n) (NumSlots t) (SecurityParam k') = do let ultimateSlot :: Word64 ultimateSlot = assert (t > 0) $ t - 1 + k = unNonZero k' + crop :: Word64 -> Word64 crop s = min ultimateSlot s @@ -227,7 +230,7 @@ genPartition (NumCoreNodes n) (NumSlots t) (SecurityParam k) = do , (1, Just $ 4 * k + 1) , (1, Just $ 4 * k + 1 + quorum) , (20, assert (numFirstEraEpochs == (1 :: Int)) $ - Just $ byronEpochSize (SecurityParam k)) + Just $ byronEpochSize (SecurityParam k')) ] -- Position the partition so that it at least abuts the focus slot. @@ -448,7 +451,7 @@ mkMessageDelay part = CalcMessageDelay $ byronEpochSize :: SecurityParam -> Word64 byronEpochSize (SecurityParam k) = - unEpochSlots $ kEpochSlots $ CC.Common.BlockCount k + unEpochSlots $ kEpochSlots $ CC.Common.BlockCount $ unNonZero k shelleyEpochSize :: SecurityParam -> Word64 shelleyEpochSize k = unEpochSize $ Shelley.mkEpochSize k activeSlotCoeff @@ -463,15 +466,15 @@ isFirstEraBlock = \case -- PREREQUISITE: The number must not be greater than @k@. diffK :: SecurityParam -> Word64 -> String diffK (SecurityParam k) v = - assert (k >= v) $ - "k - " <> show (k - v) + assert (unNonZero k >= v) $ + "k - " <> show (unNonZero k - v) -- | Render a number as the nearest tenths of @k@ approxFracK :: SecurityParam -> Word64 -> String approxFracK (SecurityParam k) v = "k * " <> show (fromIntegral tenths / 10 :: Double) where - ratio = toRational v / toRational k + ratio = toRational v / toRational (unNonZero k) tenths = round (ratio * 10) :: Int -- | diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Allegra.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Allegra.hs index 7b6bf1170e..a6abc00c2f 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Allegra.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Allegra.hs @@ -12,7 +12,7 @@ import Test.ThreadNet.TxGen (TxGen (..)) -- | Dummy generator until CAD-2119 is done, i.e., the transaction generator in -- the ledger has been generalised over the eras. -instance TxGen (ShelleyBlock (TPraos c) (AllegraEra c)) where +instance TxGen (ShelleyBlock (TPraos c) AllegraEra) where type TxGenExtra _ = () diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Alonzo.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Alonzo.hs index 3b8bc274bb..b3398a66ae 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Alonzo.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Alonzo.hs @@ -12,7 +12,7 @@ import Test.ThreadNet.TxGen (TxGen (..)) -- | Dummy generator until CAD-2119 is done, i.e., the transaction generator in -- the ledger has been generalised over the eras. -instance TxGen (ShelleyBlock (TPraos c) (AlonzoEra c)) where +instance TxGen (ShelleyBlock (TPraos c) AlonzoEra) where type TxGenExtra _ = () diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Babbage.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Babbage.hs index 97f0526815..f4b8bd7655 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Babbage.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Babbage.hs @@ -12,7 +12,7 @@ import Test.ThreadNet.TxGen (TxGen (..)) -- | Dummy generator until CAD-2119 is done, i.e., the transaction generator in -- the ledger has been generalised over the eras. -instance TxGen (ShelleyBlock (Praos c) (BabbageEra c)) where +instance TxGen (ShelleyBlock (Praos c) BabbageEra) where type TxGenExtra _ = () diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Cardano.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Cardano.hs index 961a7b5555..2ddbbd0efb 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Cardano.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Cardano.hs @@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -13,14 +14,17 @@ module Test.ThreadNet.TxGen.Cardano (CardanoTxGenExtra (..)) where import qualified Cardano.Chain.Common as Byron import Cardano.Chain.Genesis (GeneratedSecrets (..)) import Cardano.Crypto (toVerification) +import qualified Cardano.Crypto.DSIGN as DSIGN import qualified Cardano.Crypto.Signing as Byron +import qualified Cardano.Crypto.VRF as VRF import qualified Cardano.Ledger.Address as SL (BootstrapAddress (..)) import qualified Cardano.Ledger.Hashes as SL +import Cardano.Ledger.Keys (DSIGN) import qualified Cardano.Ledger.Keys.Bootstrap as SL (makeBootstrapWitness) -import qualified Cardano.Ledger.SafeHash as SL import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.Core as SL import Cardano.Ledger.Val ((<->)) +import Cardano.Protocol.Crypto (VRF) import Control.Exception (assert) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -41,8 +45,8 @@ import Ouroboros.Consensus.HardFork.Combinator.Ledger (tickedHardForkLedgerStatePerEra) import Ouroboros.Consensus.HardFork.Combinator.State.Types (currentState, getHardForkState) -import Ouroboros.Consensus.Ledger.Basics (LedgerConfig, LedgerState, - applyChainTick) +import Ouroboros.Consensus.Ledger.Basics (ComputeLedgerEvents (..), + LedgerConfig, LedgerState, applyChainTick) import Ouroboros.Consensus.NodeId (CoreNodeId (..)) import Ouroboros.Consensus.Protocol.TPraos (TPraos) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, mkShelleyTx) @@ -98,7 +102,7 @@ instance CardanoHardForkConstraints c => TxGen (CardanoBlock c) where -- Reuse the payment key as the pool key, since it's an individual -- stake pool and the namespaces are separate. - poolSK :: SL.SignKeyDSIGN c + poolSK :: DSIGN.SignKeyDSIGN DSIGN poolSK = paymentSK -- | See 'migrateUTxO' @@ -107,10 +111,10 @@ data MigrationInfo c = MigrationInfo -- ^ Needed for creating a Byron address. , byronSK :: Byron.SigningKey -- ^ The core node's Byron secret. - , paymentSK :: SL.SignKeyDSIGN c - , poolSK :: SL.SignKeyDSIGN c - , stakingSK :: SL.SignKeyDSIGN c - , vrfSK :: SL.SignKeyVRF c + , paymentSK :: DSIGN.SignKeyDSIGN DSIGN + , poolSK :: DSIGN.SignKeyDSIGN DSIGN + , stakingSK :: DSIGN.SignKeyDSIGN DSIGN + , vrfSK :: VRF.SignKeyVRF (VRF c) -- ^ To be re-used by the individual pool. } @@ -124,7 +128,9 @@ data MigrationInfo c = MigrationInfo -- It returns 'Nothing' if the core node does not have any utxo in its -- 'byronAddr' (eg if this transaction has already been applied). migrateUTxO :: - forall c. CardanoHardForkConstraints c + forall c. + ( CardanoHardForkConstraints c + ) => MigrationInfo c -> SlotNo -> LedgerConfig (CardanoBlock c) @@ -133,7 +139,7 @@ migrateUTxO :: migrateUTxO migrationInfo curSlot lcfg lst | Just utxo <- mbUTxO = - let picked :: Map (SL.TxIn c) (SL.TxOut (ShelleyEra c)) + let picked :: Map SL.TxIn (SL.TxOut ShelleyEra) picked = Map.filter pick $ SL.unUTxO utxo where pick (SL.ShelleyTxOut addr _) = @@ -156,7 +162,7 @@ migrateUTxO migrationInfo curSlot lcfg lst assert (pickedCoin > spentCoin) $ pickedCoin <-> spentCoin - body :: SL.TxBody (ShelleyEra c) + body :: SL.TxBody ShelleyEra body = SL.mkBasicTxBody & SL.certsTxBodyL .~ StrictSeq.fromList [ SL.RegTxCert $ Shelley.mkCredential stakingSK @@ -170,24 +176,24 @@ migrateUTxO migrationInfo curSlot lcfg lst & SL.ttlTxBodyL .~ SlotNo maxBound & SL.feeTxBodyL .~ fee - bodyHash :: SL.SafeHash c SL.EraIndependentTxBody + bodyHash :: SL.SafeHash SL.EraIndependentTxBody bodyHash = SL.hashAnnotated body -- Witness the use of bootstrap address's utxo. - byronWit :: SL.BootstrapWitness c + byronWit :: SL.BootstrapWitness byronWit = SL.makeBootstrapWitness (SL.extractHash bodyHash) byronSK $ Byron.addrAttributes byronAddr -- Witness the stake delegation. - delegWit :: SL.WitVKey 'SL.Witness c + delegWit :: SL.WitVKey 'SL.Witness delegWit = TL.mkWitnessVKey bodyHash (Shelley.mkKeyPair stakingSK) -- Witness the pool registration. - poolWit :: SL.WitVKey 'SL.Witness c + poolWit :: SL.WitVKey 'SL.Witness poolWit = TL.mkWitnessVKey bodyHash @@ -207,11 +213,11 @@ migrateUTxO migrationInfo curSlot lcfg lst | otherwise = Nothing where - mbUTxO :: Maybe (SL.UTxO (ShelleyEra c)) + mbUTxO :: Maybe (SL.UTxO ShelleyEra) mbUTxO = fmap getUTxOShelley $ ejectShelleyTickedLedgerState $ - applyChainTick lcfg curSlot $ + applyChainTick OmitLedgerEvents lcfg curSlot $ lst MigrationInfo @@ -229,14 +235,14 @@ migrateUTxO migrationInfo curSlot lcfg lst -- We use a base reference for the stake so that we can refer to it in the -- same tx that registers it. - shelleyAddr :: SL.Addr c + shelleyAddr :: SL.Addr shelleyAddr = SL.Addr Shelley.networkId (Shelley.mkCredential paymentSK) (SL.StakeRefBase $ Shelley.mkCredential stakingSK) -- A simplistic individual pool - poolParams :: SL.Coin -> SL.PoolParams c + poolParams :: SL.Coin -> SL.PoolParams poolParams pledge = SL.PoolParams { SL.ppCost = SL.Coin 1 , SL.ppMetadata = SL.SNothing @@ -247,14 +253,14 @@ migrateUTxO migrationInfo curSlot lcfg lst , SL.ppRewardAccount = SL.RewardAccount Shelley.networkId $ Shelley.mkCredential poolSK , SL.ppRelays = StrictSeq.empty - , SL.ppVrf = Shelley.mkKeyHashVrf vrfSK + , SL.ppVrf = Shelley.mkKeyHashVrf @c vrfSK } ----- ejectShelleyNS :: NS f (CardanoEras c) - -> Maybe (f (ShelleyBlock (TPraos c) (ShelleyEra c))) + -> Maybe (f (ShelleyBlock (TPraos c) ShelleyEra)) ejectShelleyNS = \case S (Z x) -> Just x _ -> Nothing @@ -270,7 +276,7 @@ getUTxOShelley tls = ejectShelleyTickedLedgerState :: Ticked (LedgerState (CardanoBlock c)) - -> Maybe (Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))) + -> Maybe (Ticked (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))) ejectShelleyTickedLedgerState ls = fmap (unComp . currentState) $ ejectShelleyNS $ diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Mary.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Mary.hs index 2fe8d79fce..e3e8254e11 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Mary.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Mary.hs @@ -12,7 +12,7 @@ import Test.ThreadNet.TxGen (TxGen (..)) -- | Dummy generator until CAD-2119 is done, i.e., the transaction generator in -- the ledger has been generalised over the eras. -instance TxGen (ShelleyBlock (TPraos c) (MaryEra c)) where +instance TxGen (ShelleyBlock (TPraos c) MaryEra) where type TxGenExtra _ = () diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysPraos.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysPraos.hs index 153f0a3cd5..815371f197 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysPraos.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysPraos.hs @@ -31,9 +31,8 @@ import qualified Cardano.Crypto.DSIGN.Class as Crypto import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Crypto.KES.Class as Crypto import qualified Cardano.Crypto.VRF.Class as Crypto -import Cardano.Ledger.Crypto (StandardCrypto) -import qualified Cardano.Ledger.Crypto as Shelley (KES, VRF) -import qualified Cardano.Ledger.Keys as Shelley +import Cardano.Ledger.Hashes (HASH) +import Cardano.Protocol.Crypto (Crypto (..), StandardCrypto) import Data.String (IsString (..)) -- @@ -49,33 +48,33 @@ instance HasTypeProxy KesKey where instance Key KesKey where newtype VerificationKey KesKey = - KesVerificationKey (Shelley.VerKeyKES StandardCrypto) + KesVerificationKey (Crypto.VerKeyKES (KES StandardCrypto)) deriving stock (Eq) deriving (Show, IsString) via UsingRawBytesHex (VerificationKey KesKey) deriving newtype (EncCBOR, DecCBOR, ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR newtype SigningKey KesKey = - KesSigningKey (Shelley.SignKeyKES StandardCrypto) + KesSigningKey (Crypto.UnsoundPureSignKeyKES (KES StandardCrypto)) deriving (Show, IsString) via UsingRawBytesHex (SigningKey KesKey) - deriving newtype (EncCBOR, DecCBOR, ToCBOR, FromCBOR) - deriving anyclass SerialiseAsCBOR + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass (EncCBOR, DecCBOR, SerialiseAsCBOR) --This loses the mlock safety of the seed, since it starts from a normal in-memory seed. deterministicSigningKey :: AsType KesKey -> Crypto.Seed -> SigningKey KesKey deterministicSigningKey AsKesKey = - KesSigningKey . Crypto.genKeyKES + KesSigningKey . Crypto.unsoundPureGenKeyKES deterministicSigningKeySeedSize :: AsType KesKey -> Word deterministicSigningKeySeedSize AsKesKey = Crypto.seedSizeKES proxy where - proxy :: Proxy (Shelley.KES StandardCrypto) + proxy :: Proxy (KES StandardCrypto) proxy = Proxy getVerificationKey :: SigningKey KesKey -> VerificationKey KesKey getVerificationKey (KesSigningKey sk) = - KesVerificationKey (Crypto.deriveVerKeyKES sk) + KesVerificationKey (Crypto.unsoundPureDeriveVerKeyKES sk) verificationKeyHash :: VerificationKey KesKey -> Hash KesKey verificationKeyHash (KesVerificationKey vkey) = @@ -92,10 +91,10 @@ instance SerialiseAsRawBytes (VerificationKey KesKey) where instance SerialiseAsRawBytes (SigningKey KesKey) where serialiseToRawBytes (KesSigningKey sk) = - Crypto.rawSerialiseSignKeyKES sk + Crypto.rawSerialiseUnsoundPureSignKeyKES sk deserialiseFromRawBytes (AsSigningKey AsKesKey) bs = - KesSigningKey <$> Crypto.rawDeserialiseSignKeyKES bs + KesSigningKey <$> Crypto.rawDeserialiseUnsoundPureSignKeyKES bs instance SerialiseAsBech32 (VerificationKey KesKey) where bech32PrefixFor _ = "kes_vk" @@ -107,8 +106,8 @@ instance SerialiseAsBech32 (SigningKey KesKey) where newtype instance Hash KesKey = - KesKeyHash (Shelley.Hash StandardCrypto - (Shelley.VerKeyKES StandardCrypto)) + KesKeyHash (Crypto.Hash HASH + (Crypto.VerKeyKES (KES StandardCrypto))) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash KesKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash KesKey) @@ -125,14 +124,14 @@ instance HasTextEnvelope (VerificationKey KesKey) where textEnvelopeType _ = "KesVerificationKey_" <> fromString (Crypto.algorithmNameKES proxy) where - proxy :: Proxy (Shelley.KES StandardCrypto) + proxy :: Proxy (KES StandardCrypto) proxy = Proxy instance HasTextEnvelope (SigningKey KesKey) where textEnvelopeType _ = "KesSigningKey_" <> fromString (Crypto.algorithmNameKES proxy) where - proxy :: Proxy (Shelley.KES StandardCrypto) + proxy :: Proxy (KES StandardCrypto) proxy = Proxy @@ -149,14 +148,14 @@ instance HasTypeProxy VrfKey where instance Key VrfKey where newtype VerificationKey VrfKey = - VrfVerificationKey (Shelley.VerKeyVRF StandardCrypto) + VrfVerificationKey (Crypto.VerKeyVRF (VRF StandardCrypto)) deriving stock (Eq) deriving (Show, IsString) via UsingRawBytesHex (VerificationKey VrfKey) deriving newtype (EncCBOR, DecCBOR, ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR newtype SigningKey VrfKey = - VrfSigningKey (Shelley.SignKeyVRF StandardCrypto) + VrfSigningKey (Crypto.SignKeyVRF (VRF StandardCrypto)) deriving (Show, IsString) via UsingRawBytesHex (SigningKey VrfKey) deriving newtype (EncCBOR, DecCBOR, ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR @@ -169,7 +168,7 @@ instance Key VrfKey where deterministicSigningKeySeedSize AsVrfKey = Crypto.seedSizeVRF proxy where - proxy :: Proxy (Shelley.VRF StandardCrypto) + proxy :: Proxy (VRF StandardCrypto) proxy = Proxy getVerificationKey :: SigningKey VrfKey -> VerificationKey VrfKey @@ -203,8 +202,8 @@ instance SerialiseAsBech32 (SigningKey VrfKey) where bech32PrefixesPermitted _ = ["vrf_sk"] newtype instance Hash VrfKey = - VrfKeyHash (Shelley.Hash StandardCrypto - (Shelley.VerKeyVRF StandardCrypto)) + VrfKeyHash (Crypto.Hash HASH + (Crypto.VerKeyVRF (VRF StandardCrypto))) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash VrfKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash VrfKey) @@ -220,12 +219,12 @@ instance SerialiseAsRawBytes (Hash VrfKey) where instance HasTextEnvelope (VerificationKey VrfKey) where textEnvelopeType _ = "VrfVerificationKey_" <> fromString (Crypto.algorithmNameVRF proxy) where - proxy :: Proxy (Shelley.VRF StandardCrypto) + proxy :: Proxy (VRF StandardCrypto) proxy = Proxy instance HasTextEnvelope (SigningKey VrfKey) where textEnvelopeType _ = "VrfSigningKey_" <> fromString (Crypto.algorithmNameVRF proxy) where - proxy :: Proxy (Shelley.VRF StandardCrypto) + proxy :: Proxy (VRF StandardCrypto) proxy = Proxy diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysShelley.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysShelley.hs index 9ff4c0990a..673ead3ed6 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysShelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/KeysShelley.hs @@ -39,12 +39,12 @@ import Cardano.Api.Any import Cardano.Api.Key import Cardano.Api.SerialiseTextEnvelope import Cardano.Api.SerialiseUsing +import Cardano.Crypto.DSIGN (SignKeyDSIGN) import qualified Cardano.Crypto.DSIGN.Class as Crypto import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Crypto.Seed as Crypto import qualified Cardano.Crypto.Wallet as Crypto.HD -import Cardano.Ledger.Crypto (StandardCrypto) -import qualified Cardano.Ledger.Crypto as Shelley (DSIGN) +import Cardano.Ledger.Keys (DSIGN) import qualified Cardano.Ledger.Keys as Shelley import Data.Aeson.Types (FromJSON (..), ToJSON (..), ToJSONKey (..), toJSONKeyText, withText) @@ -72,14 +72,14 @@ instance HasTypeProxy PaymentKey where instance Key PaymentKey where newtype VerificationKey PaymentKey = - PaymentVerificationKey (Shelley.VKey Shelley.Payment StandardCrypto) + PaymentVerificationKey (Shelley.VKey Shelley.Payment) deriving stock (Eq) deriving (Show, IsString) via UsingRawBytesHex (VerificationKey PaymentKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR newtype SigningKey PaymentKey = - PaymentSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + PaymentSigningKey (SignKeyDSIGN DSIGN) deriving (Show, IsString) via UsingRawBytesHex (SigningKey PaymentKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR @@ -92,7 +92,7 @@ instance Key PaymentKey where deterministicSigningKeySeedSize AsPaymentKey = Crypto.seedSizeDSIGN proxy where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy getVerificationKey :: SigningKey PaymentKey -> VerificationKey PaymentKey @@ -127,7 +127,7 @@ instance SerialiseAsBech32 (SigningKey PaymentKey) where bech32PrefixesPermitted _ = ["addr_sk"] newtype instance Hash PaymentKey = - PaymentKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto) + PaymentKeyHash (Shelley.KeyHash Shelley.Payment) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentKey) @@ -144,14 +144,14 @@ instance HasTextEnvelope (VerificationKey PaymentKey) where textEnvelopeType _ = "PaymentVerificationKeyShelley_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy instance HasTextEnvelope (SigningKey PaymentKey) where textEnvelopeType _ = "PaymentSigningKeyShelley_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy @@ -269,7 +269,7 @@ instance SerialiseAsBech32 (SigningKey PaymentExtendedKey) where newtype instance Hash PaymentExtendedKey = - PaymentExtendedKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto) + PaymentExtendedKeyHash (Shelley.KeyHash Shelley.Payment) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentExtendedKey) @@ -314,14 +314,14 @@ instance HasTypeProxy StakeKey where instance Key StakeKey where newtype VerificationKey StakeKey = - StakeVerificationKey (Shelley.VKey Shelley.Staking StandardCrypto) + StakeVerificationKey (Shelley.VKey Shelley.Staking) deriving stock (Eq) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR deriving (Show, IsString) via UsingRawBytesHex (VerificationKey StakeKey) newtype SigningKey StakeKey = - StakeSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + StakeSigningKey (SignKeyDSIGN DSIGN) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR deriving (Show, IsString) via UsingRawBytesHex (SigningKey StakeKey) @@ -334,7 +334,7 @@ instance Key StakeKey where deterministicSigningKeySeedSize AsStakeKey = Crypto.seedSizeDSIGN proxy where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy getVerificationKey :: SigningKey StakeKey -> VerificationKey StakeKey @@ -371,7 +371,7 @@ instance SerialiseAsBech32 (SigningKey StakeKey) where newtype instance Hash StakeKey = - StakeKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + StakeKeyHash (Shelley.KeyHash Shelley.Staking) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash StakeKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeKey) @@ -388,14 +388,14 @@ instance HasTextEnvelope (VerificationKey StakeKey) where textEnvelopeType _ = "StakeVerificationKeyShelley_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy instance HasTextEnvelope (SigningKey StakeKey) where textEnvelopeType _ = "StakeSigningKeyShelley_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy @@ -513,7 +513,7 @@ instance SerialiseAsBech32 (SigningKey StakeExtendedKey) where newtype instance Hash StakeExtendedKey = - StakeExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + StakeExtendedKeyHash (Shelley.KeyHash Shelley.Staking) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash StakeExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeExtendedKey) @@ -558,14 +558,14 @@ instance HasTypeProxy GenesisKey where instance Key GenesisKey where newtype VerificationKey GenesisKey = - GenesisVerificationKey (Shelley.VKey Shelley.Genesis StandardCrypto) + GenesisVerificationKey (Shelley.VKey Shelley.Genesis) deriving stock (Eq) deriving (Show, IsString) via UsingRawBytesHex (VerificationKey GenesisKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR newtype SigningKey GenesisKey = - GenesisSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + GenesisSigningKey (SignKeyDSIGN DSIGN) deriving (Show, IsString) via UsingRawBytesHex (SigningKey GenesisKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR @@ -578,7 +578,7 @@ instance Key GenesisKey where deterministicSigningKeySeedSize AsGenesisKey = Crypto.seedSizeDSIGN proxy where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy getVerificationKey :: SigningKey GenesisKey -> VerificationKey GenesisKey @@ -607,7 +607,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisKey) where newtype instance Hash GenesisKey = - GenesisKeyHash (Shelley.KeyHash Shelley.Genesis StandardCrypto) + GenesisKeyHash (Shelley.KeyHash Shelley.Genesis) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisKey) @@ -624,14 +624,14 @@ instance HasTextEnvelope (VerificationKey GenesisKey) where textEnvelopeType _ = "GenesisVerificationKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy instance HasTextEnvelope (SigningKey GenesisKey) where textEnvelopeType _ = "GenesisSigningKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy @@ -738,7 +738,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisExtendedKey) where newtype instance Hash GenesisExtendedKey = - GenesisExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + GenesisExtendedKeyHash (Shelley.KeyHash Shelley.Staking) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisExtendedKey) @@ -784,14 +784,14 @@ instance HasTypeProxy GenesisDelegateKey where instance Key GenesisDelegateKey where newtype VerificationKey GenesisDelegateKey = - GenesisDelegateVerificationKey (Shelley.VKey Shelley.GenesisDelegate StandardCrypto) + GenesisDelegateVerificationKey (Shelley.VKey Shelley.GenesisDelegate) deriving stock (Eq) deriving (Show, IsString) via UsingRawBytesHex (VerificationKey GenesisDelegateKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR newtype SigningKey GenesisDelegateKey = - GenesisDelegateSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + GenesisDelegateSigningKey ((SignKeyDSIGN DSIGN)) deriving (Show, IsString) via UsingRawBytesHex (SigningKey GenesisDelegateKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR @@ -804,7 +804,7 @@ instance Key GenesisDelegateKey where deterministicSigningKeySeedSize AsGenesisDelegateKey = Crypto.seedSizeDSIGN proxy where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy getVerificationKey :: SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey @@ -833,7 +833,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisDelegateKey) where newtype instance Hash GenesisDelegateKey = - GenesisDelegateKeyHash (Shelley.KeyHash Shelley.GenesisDelegate StandardCrypto) + GenesisDelegateKeyHash (Shelley.KeyHash Shelley.GenesisDelegate) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisDelegateKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateKey) @@ -850,14 +850,14 @@ instance HasTextEnvelope (VerificationKey GenesisDelegateKey) where textEnvelopeType _ = "GenesisDelegateVerificationKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy instance HasTextEnvelope (SigningKey GenesisDelegateKey) where textEnvelopeType _ = "GenesisDelegateSigningKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy instance CastVerificationKeyRole GenesisDelegateKey StakePoolKey where @@ -972,7 +972,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisDelegateExtendedKey) where newtype instance Hash GenesisDelegateExtendedKey = - GenesisDelegateExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + GenesisDelegateExtendedKeyHash (Shelley.KeyHash Shelley.Staking) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisDelegateExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateExtendedKey) @@ -1018,14 +1018,14 @@ instance HasTypeProxy GenesisUTxOKey where instance Key GenesisUTxOKey where newtype VerificationKey GenesisUTxOKey = - GenesisUTxOVerificationKey (Shelley.VKey Shelley.Payment StandardCrypto) + GenesisUTxOVerificationKey (Shelley.VKey Shelley.Payment) deriving stock (Eq) deriving (Show, IsString) via UsingRawBytesHex (VerificationKey GenesisUTxOKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR newtype SigningKey GenesisUTxOKey = - GenesisUTxOSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + GenesisUTxOSigningKey (SignKeyDSIGN DSIGN) deriving (Show, IsString) via UsingRawBytesHex (SigningKey GenesisUTxOKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR @@ -1038,7 +1038,7 @@ instance Key GenesisUTxOKey where deterministicSigningKeySeedSize AsGenesisUTxOKey = Crypto.seedSizeDSIGN proxy where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy getVerificationKey :: SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey @@ -1067,7 +1067,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisUTxOKey) where newtype instance Hash GenesisUTxOKey = - GenesisUTxOKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto) + GenesisUTxOKeyHash (Shelley.KeyHash Shelley.Payment) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisUTxOKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisUTxOKey) @@ -1084,14 +1084,14 @@ instance HasTextEnvelope (VerificationKey GenesisUTxOKey) where textEnvelopeType _ = "GenesisUTxOVerificationKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy instance HasTextEnvelope (SigningKey GenesisUTxOKey) where textEnvelopeType _ = "GenesisUTxOSigningKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy -- TODO: use a different type from the stake pool key, since some operations -- need a genesis key specifically @@ -1118,14 +1118,14 @@ instance HasTypeProxy StakePoolKey where instance Key StakePoolKey where newtype VerificationKey StakePoolKey = - StakePoolVerificationKey (Shelley.VKey Shelley.StakePool StandardCrypto) + StakePoolVerificationKey (Shelley.VKey Shelley.StakePool) deriving stock (Eq) deriving (Show, IsString) via UsingRawBytesHex (VerificationKey StakePoolKey) deriving newtype (EncCBOR, DecCBOR, ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR newtype SigningKey StakePoolKey = - StakePoolSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + StakePoolSigningKey (SignKeyDSIGN DSIGN) deriving (Show, IsString) via UsingRawBytesHex (SigningKey StakePoolKey) deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR @@ -1138,7 +1138,7 @@ instance Key StakePoolKey where deterministicSigningKeySeedSize AsStakePoolKey = Crypto.seedSizeDSIGN proxy where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy getVerificationKey :: SigningKey StakePoolKey -> VerificationKey StakePoolKey @@ -1173,7 +1173,7 @@ instance SerialiseAsBech32 (SigningKey StakePoolKey) where bech32PrefixesPermitted _ = ["pool_sk"] newtype instance Hash StakePoolKey = - StakePoolKeyHash (Shelley.KeyHash Shelley.StakePool StandardCrypto) + StakePoolKeyHash (Shelley.KeyHash Shelley.StakePool) deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash StakePoolKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakePoolKey) @@ -1208,13 +1208,13 @@ instance HasTextEnvelope (VerificationKey StakePoolKey) where textEnvelopeType _ = "StakePoolVerificationKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy instance HasTextEnvelope (SigningKey StakePoolKey) where textEnvelopeType _ = "StakePoolSigningKey_" <> fromString (Crypto.algorithmNameDSIGN proxy) where - proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy :: Proxy Shelley.DSIGN proxy = Proxy diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/OperationalCertificate.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/OperationalCertificate.hs index 9570a3175b..b8eb736501 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/OperationalCertificate.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/OperationalCertificate.hs @@ -28,7 +28,7 @@ import Cardano.Api.KeysShelley import Cardano.Api.SerialiseTextEnvelope import qualified Cardano.Ledger.Binary as CBOR (CBORGroup (..), shelleyProtVer, toPlainDecoder, toPlainEncoding) -import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Protocol.Crypto (StandardCrypto) import qualified Cardano.Protocol.TPraos.OCert as Shelley import Data.Word diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs index 60aa1de618..ad5f8fdf4e 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs @@ -85,11 +85,11 @@ instance CardanoHardForkConstraints StandardCrypto => ProtocolClient (CardanoBlo instance ( IOLike m , Consensus.LedgerSupportsProtocol (Consensus.ShelleyBlock - (Consensus.TPraos StandardCrypto) (ShelleyEra StandardCrypto)) + (Consensus.TPraos StandardCrypto) ShelleyEra) ) - => Protocol m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) where - data ProtocolInfoArgs m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) = ProtocolInfoArgsShelley - (ShelleyGenesis StandardCrypto) + => Protocol m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) where + data ProtocolInfoArgs m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) = ProtocolInfoArgsShelley + ShelleyGenesis (ProtocolParamsShelleyBased StandardCrypto) ProtVer protocolInfo (ProtocolInfoArgsShelley genesis shelleyBasedProtocolParams' protVer) = @@ -97,16 +97,16 @@ instance ( IOLike m instance Consensus.LedgerSupportsProtocol (Consensus.ShelleyBlock - (Consensus.TPraos StandardCrypto) (Consensus.ShelleyEra StandardCrypto)) - => ProtocolClient (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) where - data ProtocolClientInfoArgs (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) = + (Consensus.TPraos StandardCrypto) Consensus.ShelleyEra) + => ProtocolClient (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) where + data ProtocolClientInfoArgs (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) = ProtocolClientInfoArgsShelley protocolClientInfo ProtocolClientInfoArgsShelley = inject protocolClientInfoShelley data BlockType blk where ByronBlockType :: BlockType ByronBlockHFC - ShelleyBlockType :: BlockType (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) StandardShelley) + ShelleyBlockType :: BlockType (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) CardanoBlockType :: BlockType (CardanoBlock StandardCrypto) deriving instance Eq (BlockType blk) diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs index 422b71dfb9..bf1a35e957 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Cardano.hs @@ -239,7 +239,7 @@ mkConsensusProtocolCardano NodeByronProtocolConfiguration { } transitionLedgerConfig emptyCheckpointsMap - (ProtVer (L.eraProtVerHigh @(L.LatestKnownEra StandardCrypto)) 0) + (ProtVer (L.eraProtVerHigh @L.LatestKnownEra) 0) ------------------------------------------------------------------------------ -- Errors diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Conway.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Conway.hs index e22a100a59..db1f90aecf 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Conway.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Conway.hs @@ -10,7 +10,6 @@ module Cardano.Node.Protocol.Conway ( ) where import qualified Cardano.Ledger.Conway.Genesis as Conway -import qualified Cardano.Ledger.Crypto as Crypto import Cardano.Node.Protocol.Shelley (GenesisReadError, readGenesisAny) import Cardano.Node.Types @@ -20,14 +19,13 @@ import Cardano.Prelude -- Conway genesis -- -readGenesis :: Crypto.Crypto c - => GenesisFile +readGenesis :: GenesisFile -> Maybe GenesisHash -> ExceptT GenesisReadError IO - (Conway.ConwayGenesis c, GenesisHash) + (Conway.ConwayGenesis, GenesisHash) readGenesis = readGenesisAny -validateGenesis :: Conway.ConwayGenesis c +validateGenesis :: Conway.ConwayGenesis -> ExceptT ConwayProtocolInstantiationError IO () validateGenesis _ = return () --TODO conway: do the validation diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs index fd58263650..38f87e5ca3 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Node/Protocol/Shelley.hs @@ -32,12 +32,12 @@ import qualified Cardano.Api.Protocol.Types as Protocol import Cardano.Api.SerialiseTextEnvelope import qualified Cardano.Crypto.Hash.Class as Crypto import Cardano.Ledger.BaseTypes (ProtVer (..), natVersion) -import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Keys (coerceKeyRole) import qualified Cardano.Ledger.Shelley.Genesis as Shelley import Cardano.Node.Protocol.Types import Cardano.Node.Types import Cardano.Prelude +import Cardano.Protocol.Crypto (StandardCrypto) import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, newExceptT) import qualified Data.Aeson as Aeson (FromJSON (..), eitherDecodeStrict') @@ -93,7 +93,7 @@ genesisHashToPraosNonce (GenesisHash h) = Nonce (Crypto.castHash h) readGenesis :: GenesisFile -> Maybe GenesisHash -> ExceptT GenesisReadError IO - (ShelleyGenesis StandardCrypto, GenesisHash) + (ShelleyGenesis, GenesisHash) readGenesis = readGenesisAny readGenesisAny :: Aeson.FromJSON genesis @@ -117,7 +117,7 @@ readGenesisAny (GenesisFile file) mbExpectedGenesisHash = do -> throwError (GenesisHashMismatch actual expected) _ -> return () -validateGenesis :: ShelleyGenesis StandardCrypto +validateGenesis :: ShelleyGenesis -> ExceptT GenesisValidationError IO () validateGenesis genesis = firstExceptT GenesisValidationErrors . hoistEither $ diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs index 6dfd65d6b2..ebf78c3628 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs @@ -56,8 +56,8 @@ import Ouroboros.Consensus.Ledger.Abstract (ApplyBlock (reapplyBlockLedgerResult), LedgerCfg, LedgerConfig, applyBlockLedgerResult, applyChainTick, tickThenApply, tickThenApplyLedgerResult, tickThenReapply) -import Ouroboros.Consensus.Ledger.Basics (LedgerResult (..), - LedgerState, getTipSlot) +import Ouroboros.Consensus.Ledger.Basics (ComputeLedgerEvents (..), + LedgerResult (..), LedgerState, getTipSlot) import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.SupportsMempool (LedgerSupportsMempool) @@ -74,7 +74,7 @@ import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB import Ouroboros.Consensus.Storage.LedgerDB (DiskSnapshot (..), writeSnapshot) import Ouroboros.Consensus.Storage.Serialisation (encodeDisk) -import Ouroboros.Consensus.Util (Flag (..), (..:)) +import Ouroboros.Consensus.Util (Flag (..), (...:)) import qualified Ouroboros.Consensus.Util.IOLike as IOLike import Ouroboros.Network.SizeInBytes import System.FS.API (SomeHasFS (..)) @@ -394,7 +394,7 @@ storeLedgerStateAt slotNo ledgerAppMode doChecksum env = do process :: ExtLedgerState blk -> blk -> IO (NextStep, ExtLedgerState blk) process oldLedger blk = do let ledgerCfg = ExtLedgerCfg cfg - case runExcept $ tickThenXApply ledgerCfg blk oldLedger of + case runExcept $ tickThenXApply OmitLedgerEvents ledgerCfg blk oldLedger of Right newLedger -> do when (blockSlot blk >= slotNo) $ storeLedgerState newLedger when (blockSlot blk > slotNo) $ issueWarning blk @@ -406,7 +406,7 @@ storeLedgerStateAt slotNo ledgerAppMode doChecksum env = do pure (Stop, oldLedger) tickThenXApply = case ledgerAppMode of - LedgerReapply -> pure ..: tickThenReapply + LedgerReapply -> pure ...: tickThenReapply LedgerApply -> tickThenApply continue :: blk -> NextStep @@ -473,7 +473,7 @@ checkNoThunksEvery process :: ExtLedgerState blk -> blk -> IO (ExtLedgerState blk) process oldLedger blk = do let ledgerCfg = ExtLedgerCfg cfg - appliedResult = tickThenApplyLedgerResult ledgerCfg blk oldLedger + appliedResult = tickThenApplyLedgerResult OmitLedgerEvents ledgerCfg blk oldLedger newLedger = either (error . show) lrResult $ runExcept $ appliedResult bn = blockNo blk when (unBlockNo bn `mod` nBlocks == 0 ) $ IOLike.evaluate (ledgerState newLedger) >>= checkNoThunks bn @@ -511,7 +511,7 @@ traceLedgerProcessing -> IO (ExtLedgerState blk) process oldLedger blk = do let ledgerCfg = ExtLedgerCfg cfg - appliedResult = tickThenApplyLedgerResult ledgerCfg blk oldLedger + appliedResult = tickThenApplyLedgerResult OmitLedgerEvents ledgerCfg blk oldLedger newLedger = either (error . show) lrResult $ runExcept $ appliedResult traces = (HasAnalysis.emitTraces $ @@ -667,18 +667,18 @@ benchmarkLedgerOps mOutfile ledgerAppMode AnalysisEnv {db, registry, startFrom, -> ExtLedgerState blk -> IO (Ticked (LedgerState blk)) tickTheLedgerState slot st = - pure $ applyChainTick lcfg slot (ledgerState st) + pure $ applyChainTick OmitLedgerEvents lcfg slot (ledgerState st) applyTheBlock :: Ticked (LedgerState blk) -> IO (LedgerState blk) applyTheBlock tickedLedgerSt = case ledgerAppMode of LedgerApply -> - case runExcept (lrResult <$> applyBlockLedgerResult lcfg blk tickedLedgerSt) of + case runExcept (lrResult <$> applyBlockLedgerResult OmitLedgerEvents lcfg blk tickedLedgerSt) of Left err -> fail $ "benchmark doesn't support invalid blocks: " <> show rp <> " " <> show err Right x -> pure x LedgerReapply -> - pure $! lrResult $ reapplyBlockLedgerResult lcfg blk tickedLedgerSt + pure $! lrResult $ reapplyBlockLedgerResult OmitLedgerEvents lcfg blk tickedLedgerSt withFile :: Maybe FilePath -> (IO.Handle -> IO r) -> IO r withFile (Just outfile) = IO.withFile outfile IO.WriteMode @@ -707,7 +707,7 @@ getBlockApplicationMetrics (NumberOfBlocks nrBlocks) mOutFile env = do process :: IO.Handle -> ExtLedgerState blk -> blk -> IO (ExtLedgerState blk) process outFileHandle currLedgerSt blk = do - let nextLedgerSt = tickThenReapply (ExtLedgerCfg cfg) blk currLedgerSt + let nextLedgerSt = tickThenReapply OmitLedgerEvents (ExtLedgerCfg cfg) blk currLedgerSt when (unBlockNo (blockNo blk) `mod` nrBlocks == 0) $ do let blockApplication = HasAnalysis.WithLedgerState blk @@ -830,7 +830,7 @@ reproMempoolForge numBlks env = do do let slot = blockSlot blk (ticked, durTick, mutTick, gcTick) <- timed $ IOLike.evaluate $ - applyChainTick lCfg slot (ledgerState st) + applyChainTick OmitLedgerEvents lCfg slot (ledgerState st) ((), durSnap, mutSnap, gcSnap) <- timed $ IOLike.atomically $ do snap <- Mempool.getSnapshotFor mempool $ Mempool.ForgeInKnownSlot slot ticked @@ -858,7 +858,7 @@ reproMempoolForge numBlks env = do -- since it currently matches the call in the forging thread, which is -- the primary intention of this Analysis. Maybe GHC's CSE is already -- doing this sharing optimization? - IOLike.atomically $ IOLike.writeTVar ref $! tickThenReapply elCfg blk st + IOLike.atomically $ IOLike.writeTVar ref $! tickThenReapply OmitLedgerEvents elCfg blk st -- this flushes blk from the mempool, since every tx in it is now on the chain void $ Mempool.syncWithLedger mempool diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs index 341f0bcc08..9c34114211 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs @@ -33,11 +33,11 @@ import Cardano.Crypto.Raw (Raw) import qualified Cardano.Ledger.Api.Era as L import qualified Cardano.Ledger.Api.Transition as SL import Cardano.Ledger.Core (TxOut) -import Cardano.Ledger.Crypto import qualified Cardano.Ledger.Shelley.LedgerState as Shelley.LedgerState import qualified Cardano.Ledger.Shelley.UTxO as Shelley.UTxO import Cardano.Ledger.TxIn (TxIn) import Cardano.Node.Types (AdjustFilePaths (..)) +import Cardano.Protocol.Crypto import qualified Cardano.Tools.DBAnalyser.Block.Byron as BlockByron import Cardano.Tools.DBAnalyser.Block.Shelley () import Cardano.Tools.DBAnalyser.HasAnalysis @@ -58,7 +58,6 @@ import Ouroboros.Consensus.Byron.Ledger (ByronBlock) import qualified Ouroboros.Consensus.Byron.Ledger.Ledger as Byron.Ledger import Ouroboros.Consensus.Cardano import Ouroboros.Consensus.Cardano.Block (CardanoEras) -import qualified Ouroboros.Consensus.Cardano.Block as Cardano.Block import Ouroboros.Consensus.Cardano.Node (CardanoProtocolParams (..), protocolInfoCardano) import Ouroboros.Consensus.Config (emptyCheckpointsMap) @@ -66,7 +65,6 @@ import Ouroboros.Consensus.HardFork.Combinator (HardForkBlock (..), OneEraBlock (..), OneEraHash (..), getHardForkState, hardForkLedgerStatePerEra) import Ouroboros.Consensus.HardFork.Combinator.State (currentState) -import Ouroboros.Consensus.HeaderValidation (HasAnnTip) import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Shelley.HFEras () @@ -263,7 +261,7 @@ instance Aeson.FromJSON CardanoConfig where , cfgHardForkTriggers = CardanoHardForkTriggers triggers } -instance (HasAnnTip (CardanoBlock StandardCrypto), GetPrevHash (CardanoBlock StandardCrypto)) => HasAnalysis (CardanoBlock StandardCrypto) where +instance HasAnalysis (CardanoBlock StandardCrypto) where countTxOutputs = analyseBlock countTxOutputs blockTxSizes = analyseBlock blockTxSizes knownEBBs _ = @@ -339,7 +337,7 @@ getByronUtxo = Byron.UTxO.unUTxO . Byron.Ledger.byronLedgerState applyToShelleyBasedUtxo :: - (Map (TxIn (Cardano.Block.EraCrypto era)) (TxOut era) -> IO Builder) + (Map TxIn (TxOut era) -> IO Builder) -> LedgerState (ShelleyBlock proto era) -> IO Builder applyToShelleyBasedUtxo f st = do @@ -347,7 +345,7 @@ applyToShelleyBasedUtxo f st = do getShelleyBasedUtxo :: LedgerState (ShelleyBlock proto era) - -> Map (TxIn (Cardano.Block.EraCrypto era)) (TxOut era) + -> Map TxIn (TxOut era) getShelleyBasedUtxo = (\(Shelley.UTxO.UTxO xs)-> xs) . Shelley.LedgerState.utxosUtxo . Shelley.LedgerState.lsUTxOState @@ -361,7 +359,7 @@ type CardanoBlockArgs = Args (CardanoBlock StandardCrypto) mkCardanoProtocolInfo :: Byron.Genesis.Config -> Maybe PBftSignatureThreshold - -> SL.TransitionConfig (L.LatestKnownEra StandardCrypto) + -> SL.TransitionConfig L.LatestKnownEra -> Nonce -> CardanoHardForkTriggers -> ProtocolInfo (CardanoBlock StandardCrypto) @@ -382,7 +380,7 @@ mkCardanoProtocolInfo genesisByron signatureThreshold transitionConfig initialNo triggers transitionConfig emptyCheckpointsMap - (ProtVer (L.eraProtVerHigh @(L.LatestKnownEra StandardCrypto)) 0) + (ProtVer (L.eraProtVerHigh @L.LatestKnownEra) 0) ) where diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs index 0d90d64eb2..04c3c7d00c 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Shelley.hs @@ -22,7 +22,6 @@ import Cardano.Ledger.Babbage (BabbageEra) import qualified Cardano.Ledger.BaseTypes as CL (natVersion) import Cardano.Ledger.Conway (ConwayEra) import qualified Cardano.Ledger.Core as Core -import Cardano.Ledger.Crypto (Crypto) import Cardano.Ledger.Mary (MaryEra) import Cardano.Ledger.Shelley (ShelleyEra) import qualified Cardano.Ledger.Shelley.API as SL @@ -39,8 +38,7 @@ import Lens.Micro ((^.)) import Lens.Micro.Extras (view) import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.Protocol.TPraos (TPraos) -import Ouroboros.Consensus.Shelley.Eras (StandardCrypto, - StandardShelley) +import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import Ouroboros.Consensus.Shelley.HFEras () import Ouroboros.Consensus.Shelley.Ledger (ShelleyCompatible, shelleyLedgerState) @@ -106,31 +104,28 @@ instance ( ShelleyCompatible proto era class PerEraAnalysis era where txExUnitsSteps :: Maybe (Core.Tx era -> Word64) -instance PerEraAnalysis (ShelleyEra c) where txExUnitsSteps = Nothing -instance PerEraAnalysis (AllegraEra c) where txExUnitsSteps = Nothing -instance PerEraAnalysis (MaryEra c) where txExUnitsSteps = Nothing +instance PerEraAnalysis ShelleyEra where txExUnitsSteps = Nothing +instance PerEraAnalysis AllegraEra where txExUnitsSteps = Nothing +instance PerEraAnalysis MaryEra where txExUnitsSteps = Nothing -instance (Crypto c) - => PerEraAnalysis (AlonzoEra c) where +instance PerEraAnalysis AlonzoEra where txExUnitsSteps = Just $ \tx -> let (Alonzo.ExUnits _mem steps) = Alonzo.totExUnits tx in toEnum $ fromEnum steps -instance (Crypto c) - => PerEraAnalysis (BabbageEra c) where +instance PerEraAnalysis BabbageEra where txExUnitsSteps = Just $ \tx -> let (Alonzo.ExUnits _mem steps) = Alonzo.totExUnits tx in toEnum $ fromEnum steps -instance (Crypto c) - => PerEraAnalysis (ConwayEra c) where +instance PerEraAnalysis ConwayEra where txExUnitsSteps = Just $ \tx -> let (Alonzo.ExUnits _mem steps) = Alonzo.totExUnits tx in toEnum $ fromEnum steps -- | Shelley-era specific -instance HasProtocolInfo (ShelleyBlock (TPraos StandardCrypto) StandardShelley) where - data Args (ShelleyBlock (TPraos StandardCrypto) StandardShelley) = ShelleyBlockArgs { +instance HasProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) where + data Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) = ShelleyBlockArgs { configFileShelley :: FilePath , initialNonce :: Nonce } @@ -141,12 +136,12 @@ instance HasProtocolInfo (ShelleyBlock (TPraos StandardCrypto) StandardShelley) Aeson.eitherDecodeFileStrict' configFileShelley return $ mkShelleyProtocolInfo config initialNonce -type ShelleyBlockArgs = Args (ShelleyBlock (TPraos StandardCrypto) StandardShelley) +type ShelleyBlockArgs = Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) mkShelleyProtocolInfo :: - ShelleyGenesis StandardCrypto + ShelleyGenesis -> Nonce - -> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) StandardShelley) + -> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) mkShelleyProtocolInfo genesis initialNonce = fst $ protocolInfoShelley @IO genesis diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs index f49771ea4a..1b15158cb9 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs @@ -160,6 +160,7 @@ runForge epochSize_ nextSlot opts chainDB blockForging cfg genTxs = do let tickedLedgerState :: Ticked (LedgerState blk) tickedLedgerState = applyChainTick + OmitLedgerEvents (configLedger cfg) currentSlot (ledgerState unticked) diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Types.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Types.hs index 5a03317488..fff8dbd16b 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Types.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Types.hs @@ -1,6 +1,5 @@ module Cardano.Tools.DBSynthesizer.Types (module Cardano.Tools.DBSynthesizer.Types) where -import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Node.Types (ProtocolFilepaths) import Data.Aeson as Aeson (Value) import Data.Word (Word64) @@ -56,7 +55,7 @@ data DBSynthesizerConfig = DBSynthesizerConfig { confConfigStub :: NodeConfigStub , confOptions :: DBSynthesizerOptions , confProtocolCredentials :: ProtocolFilepaths - , confShelleyGenesis :: ShelleyGenesis StandardCrypto + , confShelleyGenesis :: ShelleyGenesis , confDbDir :: FilePath } deriving Show diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/Headers.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/Headers.hs index 3376c36563..471ba1ff4e 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/Headers.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/Headers.hs @@ -12,14 +12,15 @@ module Cardano.Tools.Headers ( ) where import Cardano.Crypto.DSIGN (deriveVerKeyDSIGN) -import Cardano.Crypto.VRF (VRFAlgorithm (deriveVerKeyVRF)) -import Cardano.Ledger.Api (ConwayEra, StandardCrypto) +import Cardano.Crypto.VRF.Class (deriveVerKeyVRF) +import Cardano.Ledger.Api (ConwayEra) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Compactible (toCompact) -import Cardano.Ledger.Keys (VKey (..), hashKey, hashVerKeyVRF) -import Cardano.Ledger.PoolDistr (IndividualPoolStake (..)) +import Cardano.Ledger.Keys (VKey (..), hashKey) +import Cardano.Ledger.State (IndividualPoolStake (..)) import Cardano.Prelude (ExitCode (..), exitWith, forM_, hPutStrLn, stderr) +import Cardano.Protocol.Crypto (StandardCrypto, hashVerKeyVRF) import Control.Monad.Except (runExcept) import qualified Data.Aeson as Json import qualified Data.ByteString.Lazy as LBS @@ -37,7 +38,7 @@ import Test.Ouroboros.Consensus.Protocol.Praos.Header Sample (..), expectedError, generateSamples, header, mutation) -type ConwayBlock = ShelleyBlock (Praos StandardCrypto) (ConwayEra StandardCrypto) +type ConwayBlock = ShelleyBlock (Praos StandardCrypto) ConwayEra -- * Running Generator data Options @@ -73,7 +74,7 @@ validate context MutatedHeader{header, mutation} = ownsAllStake vrfKey = IndividualPoolStake 1 (coin 1) vrfKey poolDistr = Map.fromList [(poolId, ownsAllStake hashVRFKey)] poolId = hashKey $ VKey $ deriveVerKeyDSIGN coldSignKey - hashVRFKey = hashVerKeyVRF $ deriveVerKeyVRF vrfSignKey + hashVRFKey = hashVerKeyVRF @StandardCrypto $ deriveVerKeyVRF vrfSignKey headerView = validateView @ConwayBlock undefined (mkShelleyHeader header) validateKES = doValidateKESSignature praosMaxKESEvo praosSlotsPerKESPeriod poolDistr ocertCounters headerView diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/ImmDBServer/MiniProtocols.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/ImmDBServer/MiniProtocols.hs index ce91cad39d..288be36eb0 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/ImmDBServer/MiniProtocols.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/ImmDBServer/MiniProtocols.hs @@ -105,18 +105,22 @@ immDBServer codecCfg encAddr decAddr immDB networkMagic = do where miniprotocols = [ mkMiniProtocol + Mux.StartOnDemandAny N2N.keepAliveMiniProtocolNum N2N.keepAliveProtocolLimits keepAliveProt , mkMiniProtocol + Mux.StartOnDemand N2N.chainSyncMiniProtocolNum N2N.chainSyncProtocolLimits chainSyncProt , mkMiniProtocol + Mux.StartOnDemand N2N.blockFetchMiniProtocolNum N2N.blockFetchProtocolLimits blockFetchProt , mkMiniProtocol + Mux.StartOnDemand N2N.txSubmissionMiniProtocolNum N2N.txSubmissionProtocolLimits txSubmissionProt @@ -149,10 +153,11 @@ immDBServer codecCfg encAddr decAddr immDB networkMagic = do -- never reply, there is no timeout MiniProtocolCb $ \_ctx _channel -> forever $ threadDelay 10 - mkMiniProtocol miniProtocolNum limits proto = MiniProtocol { + mkMiniProtocol miniProtocolStart miniProtocolNum limits proto = MiniProtocol { miniProtocolNum , miniProtocolLimits = limits N2N.defaultMiniProtocolParameters , miniProtocolRun = ResponderProtocolOnly proto + , miniProtocolStart } -- | The ChainSync specification requires sending a rollback instruction to the diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs index d503c33ee2..c8d7a10680 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs @@ -19,9 +19,14 @@ module Test.Consensus.Shelley.Examples ( , examplesShelley ) where + import qualified Cardano.Ledger.Block as SL -import Cardano.Ledger.Crypto (Crypto) +import Cardano.Ledger.Core +import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (StandardCrypto) import qualified Cardano.Protocol.TPraos.BHeader as SL +import Cardano.Slotting.EpochInfo (fixedEpochInfo) +import Cardano.Slotting.Time (mkSlotLength) import Data.Coerce (coerce) import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Set as Set @@ -29,20 +34,19 @@ import Ouroboros.Consensus.Block import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.SupportsMempool -import Ouroboros.Consensus.Protocol.Abstract (TranslateProto, - translateChainDepState) +import Ouroboros.Consensus.Protocol.Abstract (translateChainDepState) import Ouroboros.Consensus.Protocol.Praos (Praos) import Ouroboros.Consensus.Protocol.Praos.Header (HeaderBody (HeaderBody)) import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos import Ouroboros.Consensus.Protocol.TPraos (TPraos, TPraosState (TPraosState)) -import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.HFEras import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Ledger.Query.Types import Ouroboros.Consensus.Shelley.Protocol.TPraos () import Ouroboros.Consensus.Storage.Serialisation +import Ouroboros.Consensus.Util.Time (secondsToNominalDiffTime) import Ouroboros.Network.Block (Serialised (..)) import Ouroboros.Network.PeerSelection.LedgerPeers.Type import Ouroboros.Network.PeerSelection.RelayAccessPoint @@ -73,12 +77,13 @@ codecConfig :: CodecConfig StandardShelleyBlock codecConfig = ShelleyCodecConfig fromShelleyLedgerExamples :: - ShelleyCompatible (TPraos (EraCrypto era)) era + ShelleyCompatible (TPraos StandardCrypto) era => ShelleyLedgerExamples era - -> Examples (ShelleyBlock (TPraos (EraCrypto era)) era) -fromShelleyLedgerExamples ShelleyLedgerExamples { - sleResultExamples = ShelleyResultExamples{..} - , ..} = + -> Examples (ShelleyBlock (TPraos StandardCrypto) era) +fromShelleyLedgerExamples + ShelleyLedgerExamples + { sleResultExamples = ShelleyResultExamples{..} + , ..} = Examples { exampleBlock = unlabelled blk , exampleSerialisedBlock = unlabelled serialisedBlock @@ -95,6 +100,7 @@ fromShelleyLedgerExamples ShelleyLedgerExamples { , exampleChainDepState = unlabelled chainDepState , exampleExtLedgerState = unlabelled extLedgerState , exampleSlotNo = unlabelled slotNo + , exampleLedgerConfig = unlabelled ledgerConfig } where blk = mkShelleyBlock sleBlock @@ -108,7 +114,6 @@ fromShelleyLedgerExamples ShelleyLedgerExamples { ("GetLedgerTip", SomeSecond GetLedgerTip) , ("GetEpochNo", SomeSecond GetEpochNo) , ("GetCurrentPParams", SomeSecond GetCurrentPParams) - , ("GetProposedPParamsUpdates", SomeSecond GetProposedPParamsUpdates) , ("GetStakeDistribution", SomeSecond GetStakeDistribution) , ("GetNonMyopicMemberRewards", SomeSecond $ GetNonMyopicMemberRewards sleRewardsCredentials) , ("GetGenesisConfig", SomeSecond GetGenesisConfig) @@ -118,7 +123,6 @@ fromShelleyLedgerExamples ShelleyLedgerExamples { ("LedgerTip", SomeResult GetLedgerTip (blockPoint blk)) , ("EpochNo", SomeResult GetEpochNo 10) , ("EmptyPParams", SomeResult GetCurrentPParams srePParams) - , ("ProposedPParamsUpdates", SomeResult GetProposedPParamsUpdates sreProposedPPUpdates) , ("StakeDistribution", SomeResult GetStakeDistribution $ fromLedgerPoolDistr srePoolDistr) , ("NonMyopicMemberRewards", SomeResult (GetNonMyopicMemberRewards Set.empty) (NonMyopicMemberRewards $ sreNonMyopicRewards)) @@ -148,14 +152,14 @@ fromShelleyLedgerExamples ShelleyLedgerExamples { ledgerState (genesisHeaderState chainDepState) + ledgerConfig = exampleShelleyLedgerConfig sleTranslationContext + -- | TODO Factor this out into something nicer. fromShelleyLedgerExamplesPraos :: forall era. - ( ShelleyCompatible (Praos (EraCrypto era)) era, - TranslateProto (TPraos (EraCrypto era)) (Praos (EraCrypto era)) - ) + ShelleyCompatible (Praos StandardCrypto) era => ShelleyLedgerExamples era - -> Examples (ShelleyBlock (Praos (EraCrypto era)) era) + -> Examples (ShelleyBlock (Praos StandardCrypto) era) fromShelleyLedgerExamplesPraos ShelleyLedgerExamples { sleResultExamples = ShelleyResultExamples{..} , ..} = @@ -175,12 +179,14 @@ fromShelleyLedgerExamplesPraos ShelleyLedgerExamples { , exampleChainDepState = unlabelled chainDepState , exampleExtLedgerState = unlabelled extLedgerState , exampleSlotNo = unlabelled slotNo + , exampleLedgerConfig = unlabelled ledgerConfig } where - blk = mkShelleyBlock $ let - SL.Block hdr1 bdy = sleBlock in SL.Block (translateHeader hdr1) bdy + blk = mkShelleyBlock $ + let SL.Block hdr1 bdy = sleBlock + in SL.Block (translateHeader hdr1) bdy - translateHeader :: Crypto c => SL.BHeader c -> Praos.Header c + translateHeader :: SL.BHeader StandardCrypto -> Praos.Header StandardCrypto translateHeader (SL.BHeader bhBody bhSig) = Praos.Header hBody hSig where @@ -207,7 +213,6 @@ fromShelleyLedgerExamplesPraos ShelleyLedgerExamples { ("GetLedgerTip", SomeSecond GetLedgerTip) , ("GetEpochNo", SomeSecond GetEpochNo) , ("GetCurrentPParams", SomeSecond GetCurrentPParams) - , ("GetProposedPParamsUpdates", SomeSecond GetProposedPParamsUpdates) , ("GetStakeDistribution", SomeSecond GetStakeDistribution) , ("GetNonMyopicMemberRewards", SomeSecond $ GetNonMyopicMemberRewards sleRewardsCredentials) , ("GetGenesisConfig", SomeSecond GetGenesisConfig) @@ -216,7 +221,6 @@ fromShelleyLedgerExamplesPraos ShelleyLedgerExamples { ("LedgerTip", SomeResult GetLedgerTip (blockPoint blk)) , ("EpochNo", SomeResult GetEpochNo 10) , ("EmptyPParams", SomeResult GetCurrentPParams srePParams) - , ("ProposedPParamsUpdates", SomeResult GetProposedPParamsUpdates sreProposedPPUpdates) , ("StakeDistribution", SomeResult GetStakeDistribution $ fromLedgerPoolDistr srePoolDistr) , ("NonMyopicMemberRewards", SomeResult (GetNonMyopicMemberRewards Set.empty) (NonMyopicMemberRewards $ sreNonMyopicRewards)) @@ -236,13 +240,13 @@ fromShelleyLedgerExamplesPraos ShelleyLedgerExamples { , shelleyLedgerState = sleNewEpochState , shelleyLedgerTransition = ShelleyTransitionInfo {shelleyAfterVoting = 0} } - chainDepState = translateChainDepState (Proxy @(TPraos (EraCrypto era), Praos (EraCrypto era))) + chainDepState = translateChainDepState (Proxy @(TPraos StandardCrypto, Praos StandardCrypto)) $ TPraosState (NotOrigin 1) sleChainDepState extLedgerState = ExtLedgerState ledgerState (genesisHeaderState chainDepState) - + ledgerConfig = exampleShelleyLedgerConfig sleTranslationContext examplesShelley :: Examples StandardShelleyBlock examplesShelley = fromShelleyLedgerExamples ledgerExamplesShelley @@ -261,3 +265,15 @@ examplesBabbage = fromShelleyLedgerExamplesPraos ledgerExamplesBabbage examplesConway :: Examples StandardConwayBlock examplesConway = fromShelleyLedgerExamplesPraos ledgerExamplesConway + +exampleShelleyLedgerConfig :: TranslationContext era -> ShelleyLedgerConfig era +exampleShelleyLedgerConfig translationContext = ShelleyLedgerConfig { + shelleyLedgerCompactGenesis = compactGenesis testShelleyGenesis + , shelleyLedgerGlobals = SL.mkShelleyGlobals + testShelleyGenesis + epochInfo + , shelleyLedgerTranslationContext = translationContext + } + where + epochInfo = fixedEpochInfo (EpochSize 4) slotLength + slotLength = mkSlotLength (secondsToNominalDiffTime 7) 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 26fb068c45..1f617842c9 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 @@ -4,18 +4,21 @@ {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Test.Consensus.Shelley.Generators (SomeResult (..)) where -import Cardano.Ledger.Core (toTxSeq) -import Cardano.Ledger.Crypto (Crypto) +import Cardano.Ledger.Core (TranslationContext, toTxSeq) +import Cardano.Ledger.Genesis import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Ledger.Shelley.Translation +import Cardano.Protocol.Crypto (Crypto) import qualified Cardano.Protocol.TPraos.API as SL import qualified Cardano.Protocol.TPraos.BHeader as SL +import Cardano.Slotting.EpochInfo +import Control.Monad (replicateM) import Data.Coerce (coerce) import Generic.Random (genericArbitraryU) import Ouroboros.Consensus.Block @@ -26,8 +29,7 @@ import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Protocol.Praos (Praos) import qualified Ouroboros.Consensus.Protocol.Praos as Praos import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos -import Ouroboros.Consensus.Protocol.TPraos (PraosCrypto, TPraos, - TPraosState (..)) +import Ouroboros.Consensus.Protocol.TPraos (TPraos, TPraosState (..)) import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Ledger.Query.Types @@ -37,9 +39,9 @@ import Ouroboros.Network.Block (mkSerialised) import Test.Cardano.Ledger.AllegraEraGen () import Test.Cardano.Ledger.Alonzo.AlonzoEraGen () import Test.Cardano.Ledger.MaryEraGen () -import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes as SL -import Test.Cardano.Ledger.Shelley.Constants (defaultConstants) -import Test.Cardano.Ledger.Shelley.Generator.Presets (coreNodeKeys) +import Test.Cardano.Ledger.Shelley.Constants (defaultConstants, + numCoreNodes) +import Test.Cardano.Ledger.Shelley.Generator.Presets (genIssuerKeys) import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen () import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators (genCoherentBlock) @@ -63,34 +65,42 @@ import Test.Util.Serialisation.SomeResult (SomeResult (..)) -- | The upstream 'Arbitrary' instance for Shelley blocks does not generate -- coherent blocks, so neither does this. -instance (CanMock (TPraos crypto) era, crypto ~ EraCrypto era) +instance (CanMock (TPraos crypto) era) => Arbitrary (ShelleyBlock (TPraos crypto) era) where arbitrary = do - let allPoolKeys = map snd (coreNodeKeys defaultConstants) + allPoolKeys <- + replicateM (fromIntegral $ numCoreNodes defaultConstants) + $ genIssuerKeys defaultConstants mkShelleyBlock <$> genBlock allPoolKeys -instance (Praos.PraosCrypto crypto, CanMock (Praos crypto) era, crypto ~ EraCrypto era) +instance (Praos.PraosCrypto crypto, CanMock (Praos crypto) era) => Arbitrary (ShelleyBlock (Praos crypto) era) where arbitrary = mkShelleyBlock <$> blk where blk = SL.Block <$> arbitrary <*> (toTxSeq @era <$> arbitrary) -- | This uses a different upstream generator to ensure the header and block -- body relate as expected. -instance (CanMock (TPraos crypto) era, crypto ~ EraCrypto era) +instance (CanMock (TPraos crypto) era) => Arbitrary (Coherent (ShelleyBlock (TPraos crypto) era)) where arbitrary = do - let allPoolKeys = map snd (coreNodeKeys defaultConstants) + allPoolKeys <- + replicateM (fromIntegral $ numCoreNodes defaultConstants) + $ genIssuerKeys defaultConstants Coherent . mkShelleyBlock <$> genCoherentBlock allPoolKeys -- | Create a coherent Praos block -- -- TODO Establish a coherent block without doing this translation from a -- TPraos header. -instance (CanMock (Praos crypto) era, crypto ~ EraCrypto era) +instance (CanMock (Praos crypto) era) => Arbitrary (Coherent (ShelleyBlock (Praos crypto) era)) where - arbitrary = Coherent . mkBlk <$> genCoherentBlock allPoolKeys + arbitrary = do + allPoolKeys <- + replicateM (fromIntegral $ numCoreNodes defaultConstants) + $ genIssuerKeys defaultConstants + blk <- genCoherentBlock allPoolKeys + Coherent . mkBlk <$> pure blk where - allPoolKeys = map snd (coreNodeKeys defaultConstants) mkBlk sleBlock = mkShelleyBlock $ let SL.Block hdr1 bdy = sleBlock in SL.Block (translateHeader hdr1) bdy @@ -112,17 +122,17 @@ instance (CanMock (Praos crypto) era, crypto ~ EraCrypto era) } hSig = coerce bhSig -instance (CanMock (TPraos crypto) era, crypto ~ EraCrypto era) +instance (CanMock (TPraos crypto) era) => Arbitrary (Header (ShelleyBlock (TPraos crypto) era)) where arbitrary = getHeader <$> arbitrary -instance (CanMock (Praos crypto) era, crypto ~ EraCrypto era) +instance (CanMock (Praos crypto) era) => Arbitrary (Header (ShelleyBlock (Praos crypto) era)) where arbitrary = do hdr <- arbitrary pure $ ShelleyHeader hdr (ShelleyHash $ Praos.headerHash hdr) -instance SL.Mock c => Arbitrary (ShelleyHash c) where +instance Arbitrary ShelleyHash where arbitrary = ShelleyHash <$> arbitrary instance CanMock proto era => Arbitrary (GenTx (ShelleyBlock proto era)) where @@ -137,7 +147,6 @@ instance CanMock proto era => Arbitrary (SomeSecond BlockQuery (ShelleyBlock pro , pure $ SomeSecond GetEpochNo , SomeSecond . GetNonMyopicMemberRewards <$> arbitrary , pure $ SomeSecond GetCurrentPParams - , pure $ SomeSecond GetProposedPParamsUpdates , pure $ SomeSecond GetStakeDistribution , pure $ SomeSecond DebugEpochState , (\(SomeSecond q) -> SomeSecond (GetCBOR q)) <$> arbitrary @@ -152,7 +161,6 @@ instance CanMock proto era => Arbitrary (SomeResult (ShelleyBlock proto era)) wh , SomeResult GetEpochNo <$> arbitrary , SomeResult <$> (GetNonMyopicMemberRewards <$> arbitrary) <*> arbitrary , SomeResult GetCurrentPParams <$> arbitrary - , SomeResult GetProposedPParamsUpdates <$> arbitrary , SomeResult GetStakeDistribution . fromLedgerPoolDistr <$> arbitrary , SomeResult DebugEpochState <$> arbitrary , (\(SomeResult q r) -> @@ -163,13 +171,13 @@ instance CanMock proto era => Arbitrary (SomeResult (ShelleyBlock proto era)) wh , SomeResult DebugNewEpochState <$> arbitrary ] -instance PraosCrypto c => Arbitrary (NonMyopicMemberRewards c) where +instance Arbitrary NonMyopicMemberRewards where arbitrary = NonMyopicMemberRewards <$> arbitrary instance CanMock proto era => Arbitrary (Point (ShelleyBlock proto era)) where arbitrary = BlockPoint <$> arbitrary <*> arbitrary -instance PraosCrypto c => Arbitrary (TPraosState c) where +instance Arbitrary TPraosState where arbitrary = do lastSlot <- frequency [ (1, return Origin) @@ -208,11 +216,53 @@ instance ShelleyBasedEra era => Arbitrary (SomeSecond (NestedCtxt f) (ShelleyBlock proto era)) where arbitrary = return (SomeSecond indexIsTrivial) +{------------------------------------------------------------------------------- + Generators for shelley ledger config +-------------------------------------------------------------------------------} + +-- | Generate a 'ShelleyLedgerConfig' with a fixed 'EpochInfo' (see +-- 'arbitraryGlobalsWithFixedEpochInfo'). +instance ( Arbitrary (TranslationContext era) + ) => Arbitrary (ShelleyLedgerConfig era) where + arbitrary = ShelleyLedgerConfig + <$> arbitrary + <*> arbitraryGlobalsWithFixedEpochInfo + <*> arbitrary + +instance Arbitrary CompactGenesis where + arbitrary = compactGenesis <$> arbitrary + +-- | Generate 'Globals' with a fixed 'EpochInfo'. A fixed 'EpochInfo' is +-- comprehensive in the case of generating a 'ShelleyLedgerConfig' (see the +-- documentation for 'shelleyLedgerGlobals'). +arbitraryGlobalsWithFixedEpochInfo :: Gen SL.Globals +arbitraryGlobalsWithFixedEpochInfo = SL.Globals + <$> arbitraryFixedEpochInfo + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +arbitraryFixedEpochInfo :: Monad m => Gen (EpochInfo m) +arbitraryFixedEpochInfo = fixedEpochInfo <$> arbitrary <*> arbitrary + +instance Arbitrary (NoGenesis era) where + arbitrary = pure NoGenesis + +instance Arbitrary FromByronTranslationContext where + arbitrary = FromByronTranslationContext <$> arbitrary <*> arbitrary <*> arbitrary + {------------------------------------------------------------------------------- Generators for cardano-ledger-specs -------------------------------------------------------------------------------} -instance PraosCrypto c => Arbitrary (SL.ChainDepState c) where +instance Arbitrary SL.ChainDepState where arbitrary = genericArbitraryU shrink = genericShrink diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/MockCrypto.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/MockCrypto.hs index c438a4f38e..5713488d1e 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/MockCrypto.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/MockCrypto.hs @@ -6,32 +6,35 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE TypeOperators #-} module Test.Consensus.Shelley.MockCrypto ( Block , CanMock , MockCrypto - , MockShelley ) where -import Cardano.Crypto.DSIGN (MockDSIGN) -import Cardano.Crypto.Hash (HashAlgorithm) import Cardano.Crypto.KES (MockKES) +import qualified Cardano.Crypto.KES as KES (Signable) +import Cardano.Crypto.Util (SignableRepresentation) import Cardano.Crypto.VRF (MockVRF) -import Cardano.Ledger.Crypto (Crypto (..)) +import Cardano.Ledger.BaseTypes (Seed) import qualified Cardano.Ledger.Shelley.API as SL +import qualified Cardano.Ledger.State as SL import qualified Cardano.Ledger.Shelley.Core as Core import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses) +import Cardano.Protocol.Crypto (Crypto (..)) import qualified Cardano.Protocol.TPraos.API as SL +import qualified Cardano.Protocol.TPraos.BHeader as SL import Control.State.Transition.Extended (PredicateFailure) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) import qualified Ouroboros.Consensus.Protocol.Praos as Praos import Ouroboros.Consensus.Protocol.TPraos (TPraos) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto, ShelleyEra) +import Ouroboros.Consensus.Shelley.Eras (ShelleyEra) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, ShelleyCompatible) -import qualified Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes as SL (Mock) +import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Test.QuickCheck (Arbitrary) -- | A mock replacement for 'StandardCrypto' @@ -40,32 +43,33 @@ import Test.QuickCheck (Arbitrary) -- debug things. The code is parametric in the crypto, so it shouldn't make -- much of a difference. This also has the important advantage -- that we can reuse the generators from cardano-ledger-specs. -data MockCrypto h +data MockCrypto -instance HashAlgorithm h => Crypto (MockCrypto h) where - type ADDRHASH (MockCrypto h) = h - type DSIGN (MockCrypto h) = MockDSIGN - type HASH (MockCrypto h) = h - type KES (MockCrypto h) = MockKES 10 - type VRF (MockCrypto h) = MockVRF +instance Crypto MockCrypto where + type KES MockCrypto = MockKES 10 + type VRF MockCrypto = MockVRF -type MockShelley h = ShelleyEra (MockCrypto h) +instance SL.PraosCrypto MockCrypto +instance Praos.PraosCrypto MockCrypto -instance HashAlgorithm h => SL.PraosCrypto (MockCrypto h) -instance HashAlgorithm h => Praos.PraosCrypto (MockCrypto h) - -type Block h = ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h) +type Block = ShelleyBlock (TPraos MockCrypto) ShelleyEra -- | Cryptography that can easily be mocked type CanMock proto era = ( ShelleyCompatible proto era , LedgerSupportsProtocol (ShelleyBlock proto era) - , SL.Mock (EraCrypto era) - , Praos.PraosCrypto (EraCrypto era) + , Praos.PraosCrypto (ProtoCrypto proto) + , SL.PraosCrypto (ProtoCrypto proto) , Core.EraTx era + , SignableRepresentation Seed + , SignableRepresentation (SL.BHBody (ProtoCrypto proto)) + , KES.Signable (KES (ProtoCrypto proto)) ~ SignableRepresentation + , Eq (PredicateFailure (Core.EraRule "LEDGER" era)) + , Show (PredicateFailure (Core.EraRule "LEDGER" era)) , Arbitrary (Core.TxAuxData era) , Arbitrary (Core.PParams era) , Arbitrary (Core.PParamsUpdate era) + , Arbitrary (SL.InstantStake era) , Arbitrary (Core.Script era) , Arbitrary (Core.TxBody era) , Arbitrary (Core.Tx era) @@ -75,4 +79,5 @@ type CanMock proto era = , Arbitrary (Core.TxWits era) , Arbitrary (StashedAVVMAddresses era) , Arbitrary (Core.GovState era) + , Arbitrary (SL.CertState era) ) diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs index b67594b964..13f16e693a 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} @@ -35,24 +36,25 @@ module Test.ThreadNet.Infra.Shelley ( , tpraosSlotLength ) where -import Cardano.Crypto.DSIGN (DSIGNAlgorithm (..), seedSizeDSIGN) -import Cardano.Crypto.Hash (HashAlgorithm) -import Cardano.Crypto.KES (KESAlgorithm (..)) +import Cardano.Crypto.DSIGN (DSIGNAlgorithm (..), SignKeyDSIGN, + seedSizeDSIGN) +import Cardano.Crypto.KES (KESAlgorithm (..), UnsoundPureSignKeyKES, + seedSizeKES, unsoundPureDeriveVerKeyKES, + unsoundPureGenKeyKES) import Cardano.Crypto.Seed (mkSeedFromBytes) import qualified Cardano.Crypto.Seed as Cardano.Crypto import Cardano.Crypto.VRF (SignKeyVRF, deriveVerKeyVRF, genKeyVRF, seedSizeVRF) import qualified Cardano.Ledger.Allegra.Scripts as SL import Cardano.Ledger.Alonzo (AlonzoEra) -import Cardano.Ledger.BaseTypes (boundRational) -import Cardano.Ledger.Crypto (Crypto, DSIGN, HASH, KES, VRF) -import Cardano.Ledger.Hashes (EraIndependentTxBody) +import Cardano.Ledger.BaseTypes (boundRational, unNonZero) +import Cardano.Ledger.Hashes (EraIndependentTxBody, + HashAnnotated (..), SafeHash, hashAnnotated) import qualified Cardano.Ledger.Keys as LK import qualified Cardano.Ledger.Mary.Core as SL -import Cardano.Ledger.SafeHash (HashAnnotated (..), SafeHash, - hashAnnotated) import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Val as SL +import Cardano.Protocol.Crypto (Crypto, KES, VRF, hashVerKeyVRF) import Cardano.Protocol.TPraos.OCert (OCert (ocertKESPeriod, ocertN, ocertSigma, ocertVkHot)) import qualified Cardano.Protocol.TPraos.OCert as SL (KESPeriod, OCert (OCert), @@ -81,11 +83,12 @@ import Ouroboros.Consensus.Protocol.Praos.Common praosCanBeLeaderColdVerKey, praosCanBeLeaderOpCert, praosCanBeLeaderSignKeyVRF) import Ouroboros.Consensus.Protocol.TPraos -import Ouroboros.Consensus.Shelley.Eras (EraCrypto, ShelleyEra) +import Ouroboros.Consensus.Shelley.Eras (ShelleyEra) import Ouroboros.Consensus.Shelley.Ledger (GenTx (..), ShelleyBasedEra, ShelleyBlock, ShelleyCompatible, mkShelleyTx) import Ouroboros.Consensus.Shelley.Node +import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Ouroboros.Consensus.Util.Assert import Ouroboros.Consensus.Util.IOLike import Quiet (Quiet (..)) @@ -130,30 +133,30 @@ tpraosSlotLength = slotLengthFromSec 2 -------------------------------------------------------------------------------} data CoreNode c = CoreNode { - cnGenesisKey :: !(SL.SignKeyDSIGN c) - , cnDelegateKey :: !(SL.SignKeyDSIGN c) + cnGenesisKey :: !(SignKeyDSIGN LK.DSIGN) + , cnDelegateKey :: !(SignKeyDSIGN LK.DSIGN) -- ^ Cold delegate key. The hash of the corresponding verification -- (public) key will be used as the payment credential. - , cnStakingKey :: !(SL.SignKeyDSIGN c) + , cnStakingKey :: !(SignKeyDSIGN LK.DSIGN) -- ^ The hash of the corresponding verification (public) key will be -- used as the staking credential. - , cnVRF :: !(SL.SignKeyVRF c) - , cnKES :: !(SL.SignKeyKES c) + , cnVRF :: !(SignKeyVRF (VRF c)) + , cnKES :: !(UnsoundPureSignKeyKES (KES c)) , cnOCert :: !(SL.OCert c) } data CoreNodeKeyInfo c = CoreNodeKeyInfo { cnkiKeyPair - :: ( TL.KeyPair 'SL.Payment c - , TL.KeyPair 'SL.Staking c + :: ( TL.KeyPair 'SL.Payment + , TL.KeyPair 'SL.Staking ) , cnkiCoreNode :: - ( TL.KeyPair 'SL.Genesis c + ( TL.KeyPair 'SL.Genesis , Gen.AllIssuerKeys c 'SL.GenesisDelegate ) } -coreNodeKeys :: forall c. PraosCrypto c => CoreNode c -> CoreNodeKeyInfo c +coreNodeKeys :: CoreNode c -> CoreNodeKeyInfo c coreNodeKeys CoreNode{cnGenesisKey, cnDelegateKey, cnStakingKey} = CoreNodeKeyInfo { cnkiCoreNode = @@ -172,18 +175,18 @@ coreNodeKeys CoreNode{cnGenesisKey, cnDelegateKey, cnStakingKey} = } genCoreNode :: - forall c. PraosCrypto c + forall c. + Crypto c => SL.KESPeriod -> Gen (CoreNode c) genCoreNode startKESPeriod = do - genKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @(DSIGN c))) - delKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @(DSIGN c))) - stkKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @(DSIGN c))) - vrfKey <- genKeyVRF <$> genSeed (seedSizeVRF (Proxy @(VRF c))) - kesKey <- genKeyKES <$> genSeed (seedSizeKES (Proxy @(KES c))) - let kesPub = deriveVerKeyKES kesKey + genKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @LK.DSIGN)) + delKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @LK.DSIGN)) + stkKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @LK.DSIGN)) + vrfKey <- genKeyVRF <$> genSeed (seedSizeVRF (Proxy @(VRF c))) + kesKey <- unsoundPureGenKeyKES <$> genSeed (seedSizeKES (Proxy @(KES c))) + let kesPub = unsoundPureDeriveVerKeyKES kesKey sigma = LK.signedDSIGN - @c delKey (SL.OCertSignable kesPub certificateIssueNumber startKESPeriod) let ocert = SL.OCert { @@ -209,7 +212,7 @@ genCoreNode startKESPeriod = do genSeed :: Integral a => a -> Gen Cardano.Crypto.Seed genSeed = fmap mkSeedFromBytes . genBytes -mkLeaderCredentials :: PraosCrypto c => CoreNode c -> ShelleyLeaderCredentials c +mkLeaderCredentials :: CoreNode c -> ShelleyLeaderCredentials c mkLeaderCredentials CoreNode { cnDelegateKey, cnVRF, cnKES, cnOCert } = ShelleyLeaderCredentials { shelleyLeaderCredentialsInitSignKey = cnKES @@ -268,7 +271,7 @@ mkEpochSize (SecurityParam k) f = n = numerator f d = denominator f - (q, r) = quotRem (10 * k * fromInteger d) (fromInteger n) + (q, r) = quotRem (10 * unNonZero k * fromInteger d) (fromInteger n) -- | Note: a KES algorithm supports a particular max number of KES evolutions, -- but we can configure a potentially lower maximum for the ledger, that's why @@ -284,7 +287,7 @@ mkGenesisConfig :: -> SlotLength -> KesConfig -> [CoreNode c] - -> ShelleyGenesis c + -> ShelleyGenesis mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = assertWithMsg checkMaxLovelaceSupply $ ShelleyGenesis { @@ -324,7 +327,7 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = where nbCoreNodes = fromIntegral (length coreNodes) - pparams :: SL.PParams (ShelleyEra c) + pparams :: SL.PParams ShelleyEra pparams = SL.emptyPParams & SL.ppDL .~ unsafeBoundRational (decentralizationParamToRational d) @@ -333,22 +336,22 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = & SL.ppProtocolVersionL .~ pVer coreNodesToGenesisMapping :: - Map (SL.KeyHash 'SL.Genesis c) (SL.GenDelegPair c) + Map (SL.KeyHash 'SL.Genesis) SL.GenDelegPair coreNodesToGenesisMapping = Map.fromList [ let - gkh :: SL.KeyHash 'SL.Genesis c + gkh :: SL.KeyHash 'SL.Genesis gkh = SL.hashKey . SL.VKey $ deriveVerKeyDSIGN cnGenesisKey - gdpair :: SL.GenDelegPair c + gdpair :: SL.GenDelegPair gdpair = SL.GenDelegPair (SL.hashKey . SL.VKey $ deriveVerKeyDSIGN cnDelegateKey) - (SL.hashVerKeyVRF $ deriveVerKeyVRF cnVRF) + (hashVerKeyVRF @c $ deriveVerKeyVRF cnVRF) in (gkh, gdpair) | CoreNode { cnGenesisKey, cnDelegateKey, cnVRF } <- coreNodes ] - initialFunds :: Map (SL.Addr c) SL.Coin + initialFunds :: Map SL.Addr SL.Coin initialFunds = Map.fromList [ (addr, coin) | CoreNode { cnDelegateKey, cnStakingKey } <- coreNodes @@ -359,7 +362,7 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = ] -- In this initial stake, each core node delegates its stake to itself. - initialStake :: ShelleyGenesisStaking c + initialStake :: ShelleyGenesisStaking initialStake = ShelleyGenesisStaking { sgsPools = ListMap [ (pk, pp) @@ -377,7 +380,7 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = } where coreNodeToPoolMapping :: - Map (SL.KeyHash 'SL.StakePool c) (SL.PoolParams c) + Map (SL.KeyHash 'SL.StakePool) SL.PoolParams coreNodeToPoolMapping = Map.fromList [ ( SL.hashKey . SL.VKey . deriveVerKeyDSIGN $ cnStakingKey , SL.PoolParams @@ -400,18 +403,18 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes = -- use different hashing schemes , let poolHash = SL.hashKey . SL.VKey $ deriveVerKeyDSIGN cnDelegateKey , let poolOwnerHash = SL.hashKey . SL.VKey $ deriveVerKeyDSIGN cnDelegateKey - , let vrfHash = SL.hashVerKeyVRF $ deriveVerKeyVRF cnVRF + , let vrfHash = hashVerKeyVRF @c $ deriveVerKeyVRF cnVRF ] mkProtocolShelley :: forall m c. - (IOLike m, PraosCrypto c, ShelleyCompatible (TPraos c) (ShelleyEra c)) - => ShelleyGenesis c + (IOLike m, ShelleyCompatible (TPraos c) ShelleyEra) + => ShelleyGenesis -> SL.Nonce -> ProtVer -> CoreNode c - -> ( ProtocolInfo (ShelleyBlock (TPraos c) (ShelleyEra c)) - , m [BlockForging m (ShelleyBlock (TPraos c) (ShelleyEra c))] + -> ( ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra) + , m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)] ) mkProtocolShelley genesis initialNonce protVer coreNode = protocolInfoShelley @@ -429,12 +432,12 @@ incrementMinorProtVer :: SL.ProtVer -> SL.ProtVer incrementMinorProtVer (SL.ProtVer major minor) = SL.ProtVer major (succ minor) mkSetDecentralizationParamTxs :: - forall c. (ShelleyBasedEra (ShelleyEra c)) + forall c. (ShelleyBasedEra ShelleyEra) => [CoreNode c] -> ProtVer -- ^ The proposed protocol version -> SlotNo -- ^ The TTL -> DecentralizationParam -- ^ The new value - -> [GenTx (ShelleyBlock (TPraos c) (ShelleyEra c))] + -> [GenTx (ShelleyBlock (TPraos c) ShelleyEra)] mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = (:[]) $ mkShelleyTx $ @@ -446,12 +449,12 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = scheduledEpoch = EpochNo 0 - witnesses :: SL.TxWits (ShelleyEra c) + witnesses :: SL.TxWits ShelleyEra witnesses = SL.mkBasicTxWits & SL.addrTxWitsL .~ signatures -- Every node signs the transaction body, since it includes a " vote " from -- every node. - signatures :: Set (SL.WitVKey 'SL.Witness c) + signatures :: Set (SL.WitVKey 'SL.Witness) signatures = TL.mkWitnessesVKey (hashAnnotated body) @@ -463,7 +466,7 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = -- Nothing but the parameter update and the obligatory touching of an -- input. - body :: SL.TxBody (ShelleyEra c) + body :: SL.TxBody ShelleyEra body = SL.mkBasicTxBody & SL.inputsTxBodyL .~ Set.singleton (fst touchCoins) & SL.outputsTxBodyL .~ Seq.singleton (snd touchCoins) @@ -475,7 +478,7 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = -- We use the input of the first node, but we just put it all right back. -- -- ASSUMPTION: This transaction runs in the first slot. - touchCoins :: (SL.TxIn c, SL.TxOut (ShelleyEra c)) + touchCoins :: (SL.TxIn, SL.TxOut ShelleyEra) touchCoins = case coreNodes of [] -> error "no nodes!" cn:_ -> @@ -489,7 +492,7 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = coin = SL.Coin $ fromIntegral initialLovelacePerCoreNode -- One replicant of the parameter update per each node. - update :: SL.Update (ShelleyEra c) + update :: SL.Update ShelleyEra update = flip SL.Update scheduledEpoch $ SL.ProposedPPUpdates $ Map.fromList $ @@ -510,22 +513,20 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew = initialLovelacePerCoreNode :: Word64 initialLovelacePerCoreNode = 1000000 -mkCredential :: Crypto c => SL.SignKeyDSIGN c -> SL.Credential r c +mkCredential :: SignKeyDSIGN LK.DSIGN -> SL.Credential r mkCredential = SL.KeyHashObj . mkKeyHash -mkKeyHash :: Crypto c => SL.SignKeyDSIGN c -> SL.KeyHash r c +mkKeyHash :: SignKeyDSIGN LK.DSIGN -> SL.KeyHash r mkKeyHash = SL.hashKey . mkVerKey -mkVerKey :: Crypto c => SL.SignKeyDSIGN c -> SL.VKey r c +mkVerKey :: SignKeyDSIGN LK.DSIGN -> SL.VKey r mkVerKey = SL.VKey . deriveVerKeyDSIGN -mkKeyPair :: Crypto c => SL.SignKeyDSIGN c -> TL.KeyPair r c +mkKeyPair :: SignKeyDSIGN LK.DSIGN -> TL.KeyPair r mkKeyPair sk = TL.KeyPair { vKey = mkVerKey sk, sKey = sk } -mkKeyHashVrf :: Crypto c - => SignKeyVRF (VRF c) - -> LK.VRFVerKeyHash (r :: LK.KeyRoleVRF) c -mkKeyHashVrf = SL.hashVerKeyVRF . deriveVerKeyVRF +mkKeyHashVrf :: forall c r. Crypto c => SignKeyVRF (VRF c) -> LK.VRFVerKeyHash (r :: LK.KeyRoleVRF) +mkKeyHashVrf = hashVerKeyVRF @c . deriveVerKeyVRF networkId :: SL.Network networkId = SL.Testnet @@ -545,7 +546,7 @@ mkMASetDecentralizationParamTxs :: , SL.ShelleyEraTxBody era , SL.AtMostEra AlonzoEra era ) - => [CoreNode (EraCrypto era)] + => [CoreNode (ProtoCrypto proto)] -> ProtVer -- ^ The proposed protocol version -> SlotNo -- ^ The TTL -> DecentralizationParam -- ^ The new value @@ -565,7 +566,7 @@ mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew = -- Every node signs the transaction body, since it includes a " vote " from -- every node. - signatures :: Set (SL.WitVKey 'SL.Witness (EraCrypto era)) + signatures :: Set (SL.WitVKey 'SL.Witness) signatures = TL.mkWitnessesVKey (eraIndTxBodyHash' body) @@ -597,7 +598,7 @@ mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew = -- We use the input of the first node, but we just put it all right back. -- -- ASSUMPTION: This transaction runs in the first slot. - touchCoins :: (SL.TxIn (EraCrypto era), SL.TxOut era) + touchCoins :: (SL.TxIn, SL.TxOut era) touchCoins = case coreNodes of [] -> error "no nodes!" cn:_ -> @@ -626,12 +627,8 @@ mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew = ] eraIndTxBodyHash' :: - forall crypto body. - ( HashAlgorithm (Cardano.Ledger.Crypto.HASH crypto) - , HashAnnotated body EraIndependentTxBody crypto - ) + HashAnnotated body EraIndependentTxBody => body -> SafeHash - crypto EraIndependentTxBody eraIndTxBodyHash' = coerce . hashAnnotated diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/TxGen/Shelley.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/TxGen/Shelley.hs index 90d8dd5dad..2dc8effa7d 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/TxGen/Shelley.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/TxGen/Shelley.hs @@ -15,7 +15,6 @@ module Test.ThreadNet.TxGen.Shelley ( , mkGenEnv ) where -import Cardano.Crypto.Hash (HashAlgorithm) import qualified Cardano.Ledger.Shelley.API as SL import Control.Monad.Except (runExcept) import Ouroboros.Consensus.Block @@ -23,6 +22,7 @@ import Ouroboros.Consensus.Config import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Protocol.TPraos (TPraos) +import Ouroboros.Consensus.Shelley.Eras (ShelleyEra) import Ouroboros.Consensus.Shelley.HFEras () import Ouroboros.Consensus.Shelley.Ledger import qualified Test.Cardano.Ledger.Shelley.Constants as Gen @@ -32,21 +32,21 @@ import Test.Cardano.Ledger.Shelley.Generator.EraGen import qualified Test.Cardano.Ledger.Shelley.Generator.Presets as Gen.Presets import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen () import qualified Test.Cardano.Ledger.Shelley.Generator.Utxo as Gen -import Test.Consensus.Shelley.MockCrypto (MockCrypto, MockShelley) +import Test.Consensus.Shelley.MockCrypto (MockCrypto) import Test.QuickCheck import Test.ThreadNet.Infra.Shelley import Test.ThreadNet.TxGen (TxGen (..)) -data ShelleyTxGenExtra h = ShelleyTxGenExtra +data ShelleyTxGenExtra = ShelleyTxGenExtra { -- | Generator environment. - stgeGenEnv :: Gen.GenEnv (MockShelley h) + stgeGenEnv :: Gen.GenEnv MockCrypto ShelleyEra -- | Generate no transactions before this slot. , stgeStartAt :: SlotNo } -instance HashAlgorithm h => TxGen (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) where +instance TxGen (ShelleyBlock (TPraos MockCrypto) ShelleyEra) where - type TxGenExtra (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) = ShelleyTxGenExtra h + type TxGenExtra (ShelleyBlock (TPraos MockCrypto) ShelleyEra) = ShelleyTxGenExtra testGenTxs _coreNodeId _numCoreNodes curSlotNo cfg extra lst | stgeStartAt > curSlotNo = pure [] @@ -62,20 +62,20 @@ instance HashAlgorithm h => TxGen (ShelleyBlock (TPraos (MockCrypto h)) (MockShe then pure [] else do n <- choose (0, 20) - go [] n $ applyChainTick lcfg curSlotNo lst + go [] n $ applyChainTick OmitLedgerEvents lcfg curSlotNo lst where ShelleyTxGenExtra { stgeGenEnv , stgeStartAt } = extra - lcfg :: LedgerConfig (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) + lcfg :: LedgerConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra) lcfg = configLedger cfg - go :: [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))] -- ^ Accumulator + go :: [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)] -- ^ Accumulator -> Integer -- ^ Number of txs to still produce - -> TickedLedgerState (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) - -> Gen [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))] + -> TickedLedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) + -> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)] go acc 0 _ = return (reverse acc) go acc n st = do mbTx <- genTx cfg curSlotNo st stgeGenEnv @@ -87,38 +87,36 @@ instance HashAlgorithm h => TxGen (ShelleyBlock (TPraos (MockCrypto h)) (MockShe Right st' -> go (tx:acc) (n - 1) st' genTx :: - forall h. HashAlgorithm h - => TopLevelConfig (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) + TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> SlotNo - -> TickedLedgerState (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) - -> Gen.GenEnv (MockShelley h) - -> Gen (Maybe (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)))) + -> TickedLedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) + -> Gen.GenEnv MockCrypto ShelleyEra + -> Gen (Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra))) genTx _cfg slotNo TickedShelleyLedgerState { tickedShelleyLedgerState } genEnv = Just . mkShelleyTx <$> Gen.genTx genEnv ledgerEnv (SL.LedgerState utxoSt dpState) where - epochState :: SL.EpochState (MockShelley h) + epochState :: SL.EpochState ShelleyEra epochState = SL.nesEs tickedShelleyLedgerState - ledgerEnv :: SL.LedgerEnv (MockShelley h) + ledgerEnv :: SL.LedgerEnv ShelleyEra ledgerEnv = SL.LedgerEnv { ledgerEpochNo = Nothing , ledgerSlotNo = slotNo , ledgerIx = minBound , ledgerPp = getPParams tickedShelleyLedgerState , ledgerAccount = SL.esAccountState epochState - , ledgerMempool = True } - utxoSt :: SL.UTxOState (MockShelley h) + utxoSt :: SL.UTxOState ShelleyEra utxoSt = SL.lsUTxOState . SL.esLState $ epochState - dpState :: SL.CertState (MockShelley h) + dpState :: SL.CertState ShelleyEra dpState = SL.lsCertState . SL.esLState @@ -128,10 +126,9 @@ data WhetherToGeneratePPUs = DoNotGeneratePPUs | DoGeneratePPUs deriving (Show) mkGenEnv :: - forall h. HashAlgorithm h - => WhetherToGeneratePPUs - -> [CoreNode (MockCrypto h)] - -> Gen.GenEnv (MockShelley h) + WhetherToGeneratePPUs + -> [CoreNode MockCrypto] + -> Gen.GenEnv MockCrypto ShelleyEra mkGenEnv whetherPPUs coreNodes = Gen.GenEnv keySpace scriptSpace constants where -- Configuration of the transaction generator @@ -155,7 +152,7 @@ mkGenEnv whetherPPUs coreNodes = Gen.GenEnv keySpace scriptSpace constants DoGeneratePPUs -> cs DoNotGeneratePPUs -> cs{ Gen.frequencyTxUpdates = 0 } - keySpace :: Gen.KeySpace (MockShelley h) + keySpace :: Gen.KeySpace MockCrypto ShelleyEra keySpace = Gen.KeySpace (cnkiCoreNode <$> cn) @@ -171,10 +168,10 @@ mkGenEnv whetherPPUs coreNodes = Gen.GenEnv keySpace scriptSpace constants ksGenesisDelegates, ksStakePools } = - Gen.Presets.keySpace @(MockShelley h) constants + Gen.Presets.keySpace @ShelleyEra constants - scriptSpace :: Gen.ScriptSpace (MockShelley h) + scriptSpace :: Gen.ScriptSpace ShelleyEra scriptSpace = - Gen.Presets.scriptSpace @(MockShelley h) - (genEraTwoPhase3Arg @(MockShelley h)) - (genEraTwoPhase2Arg @(MockShelley h)) + Gen.Presets.scriptSpace @ShelleyEra + (genEraTwoPhase3Arg @ShelleyEra) + (genEraTwoPhase2Arg @ShelleyEra) diff --git a/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs b/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs index fb50268583..184ae9cf95 100644 --- a/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs +++ b/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/Byron.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -26,6 +27,8 @@ import Cardano.Chain.Slotting (EpochNumber (..), unEpochSlots) import qualified Cardano.Crypto as Crypto import qualified Cardano.Crypto.DSIGN as Crypto import Cardano.Crypto.Seed (mkSeedFromBytes) +import Cardano.Ledger.BaseTypes (knownNonZeroBounded, nonZero, + unNonZero) import Cardano.Ledger.Binary (byronProtVer, reAnnotate) import qualified Cardano.Ledger.Binary.Plain as Plain import Control.Monad (join) @@ -93,7 +96,7 @@ data TestSetup = TestSetup instance Arbitrary TestSetup where arbitrary = do -- TODO Issue #1566 will bring this to k>=0 - k <- SecurityParam <$> choose (1, 10) + k <- SecurityParam <$> choose (1, 10) `suchThatMap` nonZero join $ genTestSetup k <$> arbitrary <*> arbitrary <*> arbitrary @@ -148,7 +151,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 3 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 10 + , setupK = SecurityParam $ knownNonZeroBounded @10 , setupTestConfig = TestConfig { initSeed = Seed 0 , nodeTopology = meshNodeTopology ncn @@ -171,7 +174,7 @@ tests = testGroup "Byron" $ -- state is empty. prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 10 + , setupK = SecurityParam $ knownNonZeroBounded @10 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 2 @@ -190,7 +193,7 @@ tests = testGroup "Byron" $ -- node 1 tells it to rewind to the EBB. prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 10 + , setupK = SecurityParam $ knownNonZeroBounded @10 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 4 @@ -212,7 +215,7 @@ tests = testGroup "Byron" $ -- instead of only from the onset of the slot. prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 5 + , setupK = SecurityParam $ knownNonZeroBounded @5 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 7 @@ -235,7 +238,7 @@ tests = testGroup "Byron" $ -- resulting in a live lock. prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 5 + , setupK = SecurityParam $ knownNonZeroBounded @5 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 58 @@ -257,7 +260,7 @@ tests = testGroup "Byron" $ let ncn5 = NumCoreNodes 5 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 2 + , setupK = SecurityParam $ knownNonZeroBounded @2 , setupTestConfig = TestConfig { numCoreNodes = ncn5 -- Still fails if I increase numSlots. @@ -285,15 +288,14 @@ tests = testGroup "Byron" $ adjustQuickCheckTests (`div` 10) $ testProperty "re-delegation via NodeRekey" $ \seed w -> let ncn = NumCoreNodes 5 - k :: Num a => a - k = 5 -- small so that multiple epochs fit into a simulation + k = knownNonZeroBounded @5 -- small so that multiple epochs fit into a simulation window :: Num a => a window = 20 -- just for generality slotsPerEpoch :: Num a => a slotsPerEpoch = fromIntegral $ unEpochSlots $ - kEpochSlots $ coerce (k :: Word64) - slotsPerRekey :: Num a => a - slotsPerRekey = 2 * k -- delegations take effect 2k slots later + kEpochSlots $ coerce (unNonZero k :: Word64) + slotsPerRekey :: Word64 + slotsPerRekey = 2 * unNonZero k -- delegations take effect 2k slots later in prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs @@ -317,7 +319,7 @@ tests = testGroup "Byron" $ -- -- This failed with @Exception: the first block on the Byron chain -- must be an EBB@. - let k = SecurityParam 1 + let k = SecurityParam $ knownNonZeroBounded @1 ncn = NumCoreNodes 2 in prop_simple_real_pbft_convergence TestSetup @@ -343,7 +345,7 @@ tests = testGroup "Byron" $ let ncn4 = NumCoreNodes 4 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 3 + , setupK = SecurityParam $ knownNonZeroBounded @3 , setupTestConfig = TestConfig { numCoreNodes = ncn4 , numSlots = NumSlots 72 @@ -368,7 +370,7 @@ tests = testGroup "Byron" $ let ncn3 = NumCoreNodes 3 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 2 + , setupK = SecurityParam $ knownNonZeroBounded @2 , setupTestConfig = TestConfig { numCoreNodes = ncn3 , numSlots = NumSlots 84 @@ -423,7 +425,7 @@ tests = testGroup "Byron" $ -- > TraceLabelPeer (CoreId (CoreNodeId 0)) Send MsgReplyTxs [] prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 4 + , setupK = SecurityParam $ knownNonZeroBounded @4 , setupTestConfig = TestConfig { numCoreNodes = NumCoreNodes 3 , numSlots = NumSlots 96 @@ -466,7 +468,7 @@ tests = testGroup "Byron" $ once $ prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 2 + , setupK = SecurityParam $ knownNonZeroBounded @2 , setupTestConfig = TestConfig { numCoreNodes = ncn5 , numSlots = NumSlots 50 @@ -493,7 +495,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 3 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 2 + , setupK = SecurityParam $ knownNonZeroBounded @2 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 41 @@ -510,7 +512,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 2 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 7 + , setupK = SecurityParam $ knownNonZeroBounded @7 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 10 @@ -529,7 +531,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 3 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 9 + , setupK = SecurityParam $ knownNonZeroBounded @9 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 1 @@ -554,7 +556,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 4 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 8 + , setupK = SecurityParam $ knownNonZeroBounded @8 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 2 @@ -575,7 +577,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 4 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 5 + , setupK = SecurityParam $ knownNonZeroBounded @5 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 5 @@ -592,7 +594,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 5 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 10 + , setupK = SecurityParam $ knownNonZeroBounded @10 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 12 @@ -610,7 +612,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 5 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 10 + , setupK = SecurityParam $ knownNonZeroBounded @10 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 17 @@ -634,7 +636,7 @@ tests = testGroup "Byron" $ let ncn = NumCoreNodes 3 in prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 2 + , setupK = SecurityParam $ knownNonZeroBounded @2 , setupTestConfig = TestConfig { numCoreNodes = ncn , numSlots = NumSlots 21 @@ -673,7 +675,7 @@ tests = testGroup "Byron" $ -- non-mesh topologies. prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 10 + , setupK = SecurityParam $ knownNonZeroBounded @10 , setupTestConfig = TestConfig { numCoreNodes = NumCoreNodes 5 , numSlots = NumSlots 13 @@ -713,7 +715,7 @@ tests = testGroup "Byron" $ once $ prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 8 + , setupK = SecurityParam $ knownNonZeroBounded @8 , setupTestConfig = TestConfig { numCoreNodes = NumCoreNodes 3 , numSlots = NumSlots 81 @@ -731,7 +733,7 @@ tests = testGroup "Byron" $ once $ prop_simple_real_pbft_convergence TestSetup { setupEBBs = ProduceEBBs - , setupK = SecurityParam 2 + , setupK = SecurityParam $ knownNonZeroBounded @2 , setupTestConfig = TestConfig { numCoreNodes = NumCoreNodes 2 , numSlots = NumSlots 39 @@ -765,7 +767,7 @@ tests = testGroup "Byron" $ once $ prop_simple_real_pbft_convergence TestSetup { setupEBBs = NoEBBs - , setupK = SecurityParam 2 + , setupK = SecurityParam $ knownNonZeroBounded @2 , setupTestConfig = TestConfig { numCoreNodes = NumCoreNodes 3 , numSlots = NumSlots 21 @@ -843,7 +845,7 @@ latestPossibleDlgMaturation :: SecurityParam -> NumCoreNodes -> SlotNo -> SlotNo latestPossibleDlgMaturation (SecurityParam k) (NumCoreNodes n) (SlotNo rekeySlot) = - SlotNo $ rekeySlot + n + 2 * k + SlotNo $ rekeySlot + n + 2 * unNonZero k prop_simple_real_pbft_convergence :: TestSetup -> Property prop_simple_real_pbft_convergence TestSetup @@ -1097,7 +1099,7 @@ hasAllEBBs k produceEBBs outcomes (nid, c) = where hi :: Word64 hi = unSlotNo s `div` denom - denom = unEpochSlots $ kEpochSlots $ coerce k + denom = unEpochSlots $ kEpochSlots $ coerce (unNonZero (maxRollbacks k) :: Word64) actual = mapMaybe blockIsEBB $ Chain.toOldestFirst c @@ -1262,7 +1264,7 @@ genNodeRekeys params nodeJoinPlan nodeTopology numSlots@(NumSlots t) _ -> pure nodeRestarts where PBftParams{pbftSecurityParam} = params - k = maxRollbacks pbftSecurityParam + k = unNonZero $ maxRollbacks pbftSecurityParam sentinel = SlotNo t numCoreNodes = NumCoreNodes $ fromIntegral $ Map.size njp diff --git a/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/DualByron.hs b/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/DualByron.hs index d06d4ef4dc..f2b3f09e85 100644 --- a/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/DualByron.hs +++ b/ouroboros-consensus-cardano/test/byron-test/Test/ThreadNet/DualByron.hs @@ -15,6 +15,7 @@ import qualified Byron.Spec.Ledger.Core as Spec import qualified Byron.Spec.Ledger.UTxO as Spec import qualified Cardano.Chain.ProtocolConstants as Impl import qualified Cardano.Chain.UTxO as Impl +import Cardano.Ledger.BaseTypes (nonZeroOr) import Control.Monad.Except import qualified Control.State.Transition.Extended as Spec import Data.ByteString (ByteString) @@ -242,9 +243,10 @@ genSpecGenesis slotLen (NumSlots numSlots) = fmap fromEnv . hedgehog $ byronPBftParams :: ByronSpecGenesis -> PBftParams byronPBftParams ByronSpecGenesis{..} = - Byron.byronPBftParams (SecurityParam k) numCoreNodes + Byron.byronPBftParams (SecurityParam k') numCoreNodes where Spec.BlockCount k = byronSpecGenesisSecurityParam + k' = nonZeroOr k $ error "Got zero. Expected nonzero." numCoreNodes :: NumCoreNodes numCoreNodes = NumCoreNodes $ @@ -257,7 +259,7 @@ byronPBftParams ByronSpecGenesis{..} = instance TxGen DualByronBlock where testGenTxs _coreNodeId _numCoreNodes curSlotNo cfg () = \st -> do n <- choose (0, 20) - go [] n $ applyChainTick (configLedger cfg) curSlotNo st + go [] n $ applyChainTick OmitLedgerEvents (configLedger cfg) curSlotNo st where -- Attempt to produce @n@ transactions -- Stops when the transaction generator cannot produce more txs 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 215525865c..b89e7708ea 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 @@ -36,4 +36,5 @@ instance CardanoHardForkConstraints c CardanoNodeToClientVersion13 -> "CardanoNodeToClientVersion13" CardanoNodeToClientVersion14 -> "CardanoNodeToClientVersion14" CardanoNodeToClientVersion15 -> "CardanoNodeToClientVersion15" + CardanoNodeToClientVersion16 -> "CardanoNodeToClientVersion16" _ -> error $ "Unknown version: " <> show blockVersion diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/MiniProtocol/LocalTxSubmission/Server.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/MiniProtocol/LocalTxSubmission/Server.hs index 0c43672007..643eafa446 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/MiniProtocol/LocalTxSubmission/Server.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/MiniProtocol/LocalTxSubmission/Server.hs @@ -1,12 +1,15 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} -- | Test that we can submit transactions to the mempool using the local -- submission server, in different Cardano eras. -- module Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.Server (tests) where +import Cardano.Ledger.BaseTypes (knownNonZeroBounded) import Control.Monad (void) import Control.Tracer (Tracer, nullTracer, stdoutTracer) import Data.Functor.Contravariant ((>$<)) @@ -56,7 +59,7 @@ tests = pInfo :: ProtocolInfo (CardanoBlock StandardCrypto) pInfo = mkSimpleTestProtocolInfo (Shelley.DecentralizationParam 1) - (Consensus.SecurityParam 10) + (Consensus.SecurityParam $ knownNonZeroBounded @10) (ByronSlotLengthInSeconds 1) (ShelleySlotLengthInSeconds 1) protocolVersionZero 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 71e0b7a4a6..31a42feafe 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 @@ -18,8 +18,9 @@ import Ouroboros.Consensus.Shelley.Ledger import Ouroboros.Consensus.Shelley.Node () import Ouroboros.Consensus.Storage.Serialisation 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 (epochSlots) +import Test.Consensus.Cardano.Generators () import Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron) import Test.Tasty import Test.Tasty.QuickCheck (Property, testProperty, (===)) diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/SupportsSanityCheck.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/SupportsSanityCheck.hs index fa91ae7ac2..0a40b80e2f 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/SupportsSanityCheck.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/SupportsSanityCheck.hs @@ -1,6 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} module Test.Consensus.Cardano.SupportsSanityCheck (tests) where +import Cardano.Ledger.BaseTypes (nonZero, nonZeroOr, unNonZero) import Ouroboros.Consensus.Cardano (CardanoHardForkTriggers) import Ouroboros.Consensus.Cardano.Block import Ouroboros.Consensus.Config @@ -37,10 +38,10 @@ breakTopLevelConfig :: TopLevelConfig (CardanoBlock StandardCrypto) -> TopLevelC breakTopLevelConfig tlc = let TopLevelConfig{topLevelConfigProtocol} = tlc HardForkConsensusConfig{hardForkConsensusConfigK} = topLevelConfigProtocol - SecurityParam k = hardForkConsensusConfigK + k = unNonZero $ maxRollbacks hardForkConsensusConfigK in tlc { topLevelConfigProtocol = topLevelConfigProtocol - { hardForkConsensusConfigK = SecurityParam (succ k) + { hardForkConsensusConfigK = SecurityParam $ nonZeroOr (succ k) $ error "Impossible! In breakTopLevelConfig, found zero, expected a positive number." } } @@ -74,7 +75,7 @@ instance Arbitrary SimpleTestProtocolInfoSetup where <*> genHardForkTriggers where genSecurityParam = - SecurityParam <$> Gen.choose (8, 12) + SecurityParam <$> Gen.choose (8, 12) `suchThatMap` nonZero genByronSlotLength = ByronSlotLengthInSeconds <$> Gen.choose (1, 4) genShelleySlotLength = diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs index a0030d0320..84625dc6c8 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/AllegraMary.hs @@ -14,8 +14,8 @@ module Test.ThreadNet.AllegraMary (tests) where -import Cardano.Crypto.Hash (ShortHash) import qualified Cardano.Ledger.Api.Transition as L +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley.Core as SL import qualified Cardano.Protocol.TPraos.OCert as SL @@ -68,11 +68,8 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.TestEnv --- | No Byron era, so our crypto can be trivial. -type Crypto = MockCrypto ShortHash - type AllegraMaryBlock = - ShelleyBasedHardForkBlock (TPraos Crypto) (AllegraEra Crypto) (TPraos Crypto) (MaryEra Crypto) + ShelleyBasedHardForkBlock (TPraos MockCrypto) AllegraEra (TPraos MockCrypto) MaryEra -- | The varying data of this test -- @@ -102,7 +99,7 @@ instance Arbitrary TestSetup where -- Shelley epoch, since stake pools can only be created and -- delegated to via Shelley transactions. `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) - setupK <- SecurityParam <$> choose (8, 10) + setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero -- If k < 8, common prefix violations become too likely in -- Praos mode for thin overlay schedules (ie low d), even for -- f=0.2. @@ -261,12 +258,12 @@ prop_simple_allegraMary_convergence TestSetup } maxForkLength :: NumBlocks - maxForkLength = NumBlocks $ maxRollbacks setupK + maxForkLength = NumBlocks $ unNonZero $ maxRollbacks setupK initialKESPeriod :: SL.KESPeriod initialKESPeriod = SL.KESPeriod 0 - coreNodes :: [Shelley.CoreNode Crypto] + coreNodes :: [Shelley.CoreNode MockCrypto] coreNodes = runGen initSeed $ replicateM (fromIntegral n) $ Shelley.genCoreNode initialKESPeriod @@ -277,7 +274,7 @@ prop_simple_allegraMary_convergence TestSetup maxLovelaceSupply = fromIntegral (length coreNodes) * Shelley.initialLovelacePerCoreNode - genesisShelley :: ShelleyGenesis Crypto + genesisShelley :: ShelleyGenesis genesisShelley = Shelley.mkGenesisConfig (SL.ProtVer majorVersion1 0) @@ -286,7 +283,7 @@ prop_simple_allegraMary_convergence TestSetup setupD maxLovelaceSupply setupSlotLength - (Shelley.mkKesConfig (Proxy @Crypto) numSlots) + (Shelley.mkKesConfig (Proxy @MockCrypto) numSlots) coreNodes -- the Shelley ledger is designed to use a fixed epoch size, so this test @@ -355,7 +352,7 @@ prop_simple_allegraMary_convergence TestSetup show (nodeOutputFinalChain <$> testOutputNodes testOutput) ) $ counterexample "CP violation in final chains!" $ - property $ maxRollbacks setupK >= finalIntersectionDepth + property $ unNonZero (maxRollbacks setupK) >= finalIntersectionDepth {------------------------------------------------------------------------------- Constants diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs index f0dccc8304..0ca47c0583 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs @@ -18,6 +18,7 @@ import Cardano.Chain.Slotting (unEpochSlots) import qualified Cardano.Chain.Update as CC.Update import qualified Cardano.Chain.Update.Validation.Interface as CC import qualified Cardano.Ledger.Api.Era as L +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.Core as SL @@ -110,7 +111,7 @@ instance Arbitrary TestSetup where -- Shelley epoch, since stake pools can only be created and -- delegated to via Shelley transactions. `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) - setupK <- SecurityParam <$> choose (8, 10) + setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero -- If k < 8, common prefix violations become too likely in -- Praos mode for thin overlay schedules (ie low d), even for -- f=0.2. @@ -267,7 +268,7 @@ prop_simple_cardano_convergence TestSetup -- fails, we should figure out why not. Even with @k=2 ncn=5 d=0.1@ -- fixed the deepest fork I'm seeing is ~2.5% @k-1@ -- 'finalIntersectionDepth'. - maxRollbacks setupK + unNonZero $ maxRollbacks setupK else -- Recall that all nodes join ASAP, so the partition is the only -- potential cause for a fork during Byron. See the reasoning in @@ -316,7 +317,7 @@ prop_simple_cardano_convergence TestSetup maxLovelaceSupply :: Word64 maxLovelaceSupply = 45000000000000000 - genesisShelley :: ShelleyGenesis Crypto + genesisShelley :: ShelleyGenesis genesisShelley = Shelley.mkGenesisConfig (SL.ProtVer shelleyMajorVersion 0) @@ -396,7 +397,7 @@ prop_simple_cardano_convergence TestSetup TestOutput{testOutputNodes} = testOutput k :: Word64 - k = maxRollbacks setupK + k = unNonZero $ maxRollbacks setupK coeff :: SL.ActiveSlotCoeff coeff = SL.sgActiveSlotCoeff genesisShelley @@ -431,7 +432,7 @@ prop_simple_cardano_convergence TestSetup show (nodeOutputFinalChain <$> testOutputNodes testOutput) ) $ counterexample "CP violation in final chains!" $ - property $ maxRollbacks setupK >= finalIntersectionDepth + property $ unNonZero (maxRollbacks setupK) >= finalIntersectionDepth mkProtocolCardanoAndHardForkTxs :: forall c m. (IOLike m, c ~ StandardCrypto) @@ -442,7 +443,7 @@ mkProtocolCardanoAndHardForkTxs :: -> CC.Genesis.GeneratedSecrets -> CC.Update.ProtocolVersion -- Shelley - -> ShelleyGenesis c + -> ShelleyGenesis -> SL.Nonce -> Shelley.CoreNode c -> TestNodeInitialization m (CardanoBlock c) @@ -503,7 +504,7 @@ byronInitialMinorVersion = 0 -- | The (first) major protocol version of the Shelley era, as used by -- 'hardForkOnDefaultProtocolVersions'. shelleyMajorVersion :: SL.Version -shelleyMajorVersion = L.eraProtVerLow @(ShelleyEra StandardCrypto) +shelleyMajorVersion = L.eraProtVerLow @ShelleyEra {------------------------------------------------------------------------------- Miscellany @@ -511,7 +512,7 @@ shelleyMajorVersion = L.eraProtVerLow @(ShelleyEra StandardCrypto) byronEpochSize :: SecurityParam -> Word64 byronEpochSize (SecurityParam k) = - unEpochSlots $ kEpochSlots $ CC.Common.BlockCount k + unEpochSlots $ kEpochSlots $ CC.Common.BlockCount $ unNonZero k -- | By default, the initial major Byron protocol version is @0@, but we want to -- set it to 'byronMajorVersion'. diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs index f0a9cde48d..ac4116f72f 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/MaryAlonzo.hs @@ -12,9 +12,9 @@ module Test.ThreadNet.MaryAlonzo (tests) where -import Cardano.Crypto.Hash (ShortHash) import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis) import qualified Cardano.Ledger.Api.Transition as L +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import qualified Cardano.Ledger.BaseTypes as SL (Version, getVersion, natVersion) import qualified Cardano.Ledger.Shelley.API as SL @@ -70,11 +70,8 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.TestEnv --- | No Byron era, so our crypto can be trivial. -type Crypto = MockCrypto ShortHash - type MaryAlonzoBlock = - ShelleyBasedHardForkBlock (TPraos Crypto) (MaryEra Crypto) (TPraos Crypto) (AlonzoEra Crypto) + ShelleyBasedHardForkBlock (TPraos MockCrypto) MaryEra (TPraos MockCrypto) AlonzoEra -- | The varying data of this test -- @@ -104,7 +101,7 @@ instance Arbitrary TestSetup where -- Shelley epoch, since stake pools can only be created and -- delegated to via Shelley transactions. `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) - setupK <- SecurityParam <$> choose (8, 10) + setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero -- If k < 8, common prefix violations become too likely in -- Praos mode for thin overlay schedules (ie low d), even for -- f=0.2. @@ -268,12 +265,12 @@ prop_simple_allegraAlonzo_convergence TestSetup } maxForkLength :: NumBlocks - maxForkLength = NumBlocks $ maxRollbacks setupK + maxForkLength = NumBlocks $ unNonZero $ maxRollbacks setupK initialKESPeriod :: SL.KESPeriod initialKESPeriod = SL.KESPeriod 0 - coreNodes :: [Shelley.CoreNode Crypto] + coreNodes :: [Shelley.CoreNode MockCrypto] coreNodes = runGen initSeed $ replicateM (fromIntegral n) $ Shelley.genCoreNode initialKESPeriod @@ -284,7 +281,7 @@ prop_simple_allegraAlonzo_convergence TestSetup maxLovelaceSupply = fromIntegral (length coreNodes) * Shelley.initialLovelacePerCoreNode - shelleyGenesis :: ShelleyGenesis Crypto + shelleyGenesis :: ShelleyGenesis shelleyGenesis = Shelley.mkGenesisConfig (SL.ProtVer majorVersion1 0) @@ -293,7 +290,7 @@ prop_simple_allegraAlonzo_convergence TestSetup setupD maxLovelaceSupply setupSlotLength - (Shelley.mkKesConfig (Proxy @Crypto) numSlots) + (Shelley.mkKesConfig (Proxy @MockCrypto) numSlots) coreNodes alonzoGenesis :: AlonzoGenesis @@ -365,7 +362,7 @@ prop_simple_allegraAlonzo_convergence TestSetup show (nodeOutputFinalChain <$> testOutputNodes testOutput) ) $ counterexample "CP violation in final chains!" $ - property $ maxRollbacks setupK >= finalIntersectionDepth + property $ unNonZero (maxRollbacks setupK) >= finalIntersectionDepth {------------------------------------------------------------------------------- Constants diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs index 69d86e380f..cadeac97ca 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/ShelleyAllegra.hs @@ -14,8 +14,8 @@ module Test.ThreadNet.ShelleyAllegra (tests) where -import Cardano.Crypto.Hash (ShortHash) import qualified Cardano.Ledger.Api.Transition as L +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Shelley.Core as SL import qualified Cardano.Protocol.TPraos.OCert as SL @@ -68,11 +68,8 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.TestEnv --- | No Byron era, so our crypto can be trivial. -type Crypto = MockCrypto ShortHash - type ShelleyAllegraBlock = - ShelleyBasedHardForkBlock (TPraos Crypto) (ShelleyEra Crypto) (TPraos Crypto) (AllegraEra Crypto) + ShelleyBasedHardForkBlock (TPraos MockCrypto) ShelleyEra (TPraos MockCrypto) AllegraEra -- | The varying data of this test -- @@ -102,7 +99,7 @@ instance Arbitrary TestSetup where -- Shelley epoch, since stake pools can only be created and -- delegated to via Shelley transactions. `suchThat` ((/= 0) . Shelley.decentralizationParamToRational) - setupK <- SecurityParam <$> choose (8, 10) + setupK <- SecurityParam <$> choose (8, 10) `suchThatMap` nonZero -- If k < 8, common prefix violations become too likely in -- Praos mode for thin overlay schedules (ie low d), even for -- f=0.2. @@ -272,12 +269,12 @@ prop_simple_shelleyAllegra_convergence TestSetup } maxForkLength :: NumBlocks - maxForkLength = NumBlocks $ maxRollbacks setupK + maxForkLength = NumBlocks $ unNonZero $ maxRollbacks setupK initialKESPeriod :: SL.KESPeriod initialKESPeriod = SL.KESPeriod 0 - coreNodes :: [Shelley.CoreNode Crypto] + coreNodes :: [Shelley.CoreNode MockCrypto] coreNodes = runGen initSeed $ replicateM (fromIntegral n) $ Shelley.genCoreNode initialKESPeriod @@ -288,7 +285,7 @@ prop_simple_shelleyAllegra_convergence TestSetup maxLovelaceSupply = fromIntegral (length coreNodes) * Shelley.initialLovelacePerCoreNode - genesisShelley :: ShelleyGenesis Crypto + genesisShelley :: ShelleyGenesis genesisShelley = Shelley.mkGenesisConfig (SL.ProtVer majorVersion1 0) @@ -297,7 +294,7 @@ prop_simple_shelleyAllegra_convergence TestSetup setupD maxLovelaceSupply setupSlotLength - (Shelley.mkKesConfig (Proxy @Crypto) numSlots) + (Shelley.mkKesConfig (Proxy @MockCrypto) numSlots) coreNodes -- the Shelley ledger is designed to use a fixed epoch size, so this test @@ -366,7 +363,7 @@ prop_simple_shelleyAllegra_convergence TestSetup show (nodeOutputFinalChain <$> testOutputNodes testOutput) ) $ counterexample "CP violation in final chains!" $ - property $ maxRollbacks setupK >= finalIntersectionDepth + property $ unNonZero (maxRollbacks setupK) >= finalIntersectionDepth {------------------------------------------------------------------------------- Constants 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 8f7506f99c..a6bbbb2959 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 @@ -6,8 +6,11 @@ module Test.Consensus.Shelley.Golden (tests) where import Ouroboros.Consensus.Ledger.Query (QueryVersion) +import Ouroboros.Consensus.Shelley.HFEras () import Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion +import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.Node () +import Ouroboros.Consensus.Shelley.ShelleyHFC () import System.FilePath (()) import Test.Consensus.Shelley.Examples import Test.Tasty 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 6c5d325b74..251143266e 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 @@ -5,7 +5,6 @@ module Test.Consensus.Shelley.Serialisation (tests) where -import Cardano.Crypto.Hash (ShortHash) import qualified Codec.CBOR.Write as CBOR import qualified Data.ByteString.Lazy as Lazy import Data.Constraint @@ -19,6 +18,7 @@ import Ouroboros.Consensus.Shelley.Node () import Ouroboros.Consensus.Shelley.Node.Serialisation () import Ouroboros.Consensus.Shelley.Protocol.TPraos () import Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..)) +import Test.Consensus.Cardano.Generators () import Test.Consensus.Shelley.Generators () import Test.Consensus.Shelley.MockCrypto import Test.Tasty @@ -45,10 +45,10 @@ tests = testGroup "Shelley" ] ] where - pReal :: Proxy (Block ShortHash) + pReal :: Proxy Block pReal = Proxy - testCodecCfg :: CodecConfig (Block ShortHash) + testCodecCfg :: CodecConfig Block testCodecCfg = ShelleyCodecConfig dictNestedHdr :: @@ -60,7 +60,7 @@ tests = testGroup "Shelley" BinaryBlockInfo -------------------------------------------------------------------------------} -prop_shelleyBinaryBlockInfo :: Block ShortHash -> Property +prop_shelleyBinaryBlockInfo :: Block -> Property prop_shelleyBinaryBlockInfo blk = encodedHeader === extractedHeader where @@ -86,18 +86,18 @@ testTPraosSlotsPerKESPeriod :: Word64 testTPraosSlotsPerKESPeriod = maxBound -- | Test that the block we generate pass the 'verifyBlockIntegrity' check -prop_blockIntegrity :: Coherent (Block ShortHash) -> Bool +prop_blockIntegrity :: Coherent Block -> Bool prop_blockIntegrity = verifyBlockIntegrity testTPraosSlotsPerKESPeriod . getCoherent -- | Test that the block we generate pass the 'verifyHeaderIntegrity' check -prop_headerIntegrity :: Header (Block ShortHash) -> Bool +prop_headerIntegrity :: Header Block -> Bool prop_headerIntegrity = - verifyHeaderIntegrity @(TPraos (MockCrypto ShortHash)) testTPraosSlotsPerKESPeriod + verifyHeaderIntegrity @(TPraos MockCrypto) testTPraosSlotsPerKESPeriod . shelleyHeaderRaw -- | Test that we can detect random bitflips in blocks. -prop_detectCorruption_Block :: Coherent (Block ShortHash) -> Corruption -> Property +prop_detectCorruption_Block :: Coherent Block -> Corruption -> Property prop_detectCorruption_Block (Coherent blk) = detectCorruption encodeShelleyBlock @@ -106,10 +106,10 @@ prop_detectCorruption_Block (Coherent blk) = blk -- | Test that we can detect random bitflips in blocks. -prop_detectCorruption_Header :: Header (Block ShortHash) -> Corruption -> Property +prop_detectCorruption_Header :: Header Block -> Corruption -> Property prop_detectCorruption_Header = detectCorruption encodeShelleyHeader decodeShelleyHeader - (verifyHeaderIntegrity @(TPraos (MockCrypto ShortHash)) testTPraosSlotsPerKESPeriod + (verifyHeaderIntegrity @(TPraos MockCrypto) testTPraosSlotsPerKESPeriod . shelleyHeaderRaw) diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs index c75fb66f8f..0f4f371c35 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/ThreadNet/Shelley.hs @@ -4,9 +4,10 @@ module Test.ThreadNet.Shelley (tests) where -import Cardano.Crypto.Hash (ShortHash) +import Cardano.Ledger.BaseTypes (nonZero) import qualified Cardano.Ledger.BaseTypes as SL (UnitInterval, mkNonceFromNumber, shelleyProtVer, unboundRational) +import Cardano.Ledger.Shelley (ShelleyEra) import qualified Cardano.Ledger.Shelley.API as SL import qualified Cardano.Ledger.Shelley.Core as SL import qualified Cardano.Ledger.Shelley.Translation as SL @@ -25,12 +26,12 @@ import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.NodeId import Ouroboros.Consensus.Protocol.TPraos (TPraos) -import Ouroboros.Consensus.Shelley.Eras (EraCrypto) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.Node -import Test.Consensus.Shelley.MockCrypto (MockCrypto, MockShelley) +import Ouroboros.Consensus.Shelley.ShelleyHFC () +import Test.Consensus.Shelley.MockCrypto (MockCrypto) import Test.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck @@ -48,9 +49,6 @@ import Test.Util.Orphans.Arbitrary () import Test.Util.Slots (NumSlots (..)) import Test.Util.TestEnv -type Era = MockShelley ShortHash -type Proto = TPraos (MockCrypto ShortHash) - data TestSetup = TestSetup { setupD :: DecentralizationParam , setupD2 :: DecentralizationParam @@ -65,7 +63,7 @@ data TestSetup = TestSetup -- This test varies it too ensure it explores different leader schedules. , setupK :: SecurityParam , setupTestConfig :: TestConfig - , setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion (ShelleyBlock Proto Era)) + , setupVersion :: (NodeToNodeVersion, BlockNodeToNodeVersion (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) } deriving (Show) @@ -88,11 +86,11 @@ instance Arbitrary TestSetup where , (9, SL.mkNonceFromNumber <$> arbitrary) ] - setupK <- SecurityParam <$> choose (minK, maxK) + setupK <- SecurityParam <$> choose (minK, maxK) `suchThatMap` nonZero setupTestConfig <- arbitrary - setupVersion <- genVersion (Proxy @(ShelleyBlock Proto Era)) + setupVersion <- genVersion (Proxy @(ShelleyBlock (TPraos MockCrypto) ShelleyEra)) pure TestSetup { setupD @@ -197,7 +195,7 @@ prop_simple_real_tpraos_convergence TestSetup , numSlots } = setupTestConfig - testConfigB :: TestConfigB (ShelleyBlock Proto Era) + testConfigB :: TestConfigB (ShelleyBlock (TPraos MockCrypto) ShelleyEra) testConfigB = TestConfigB { forgeEbbEnv = Nothing , future = singleEraFuture tpraosSlotLength epochSize @@ -271,7 +269,7 @@ prop_simple_real_tpraos_convergence TestSetup initialKESPeriod :: SL.KESPeriod initialKESPeriod = SL.KESPeriod 0 - coreNodes :: [CoreNode (EraCrypto Era)] + coreNodes :: [CoreNode MockCrypto] coreNodes = runGen initSeed $ replicateM (fromIntegral n) $ genCoreNode initialKESPeriod @@ -282,7 +280,7 @@ prop_simple_real_tpraos_convergence TestSetup maxLovelaceSupply = fromIntegral (length coreNodes) * initialLovelacePerCoreNode - genesisConfig :: ShelleyGenesis (EraCrypto Era) + genesisConfig :: ShelleyGenesis genesisConfig = mkGenesisConfig genesisProtVer @@ -291,7 +289,7 @@ prop_simple_real_tpraos_convergence TestSetup setupD maxLovelaceSupply tpraosSlotLength - (mkKesConfig (Proxy @(EraCrypto Era)) numSlots) + (mkKesConfig (Proxy @MockCrypto) numSlots) coreNodes epochSize :: EpochSize @@ -314,7 +312,7 @@ prop_simple_real_tpraos_convergence TestSetup -- slots to reach the epoch transition but the last several -- slots end up empty. Shelley.tickedShelleyLedgerState $ - applyChainTick ledgerConfig sentinel lsUnticked + applyChainTick OmitLedgerEvents ledgerConfig sentinel lsUnticked msg = "The ticked final ledger state of " <> show nid <> @@ -352,11 +350,11 @@ prop_simple_real_tpraos_convergence TestSetup DoGeneratePPUs -> True DoNotGeneratePPUs -> False - finalLedgers :: [(NodeId, LedgerState (ShelleyBlock Proto Era))] + finalLedgers :: [(NodeId, LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))] finalLedgers = Map.toList $ nodeOutputFinalLedger <$> testOutputNodes testOutput - ledgerConfig :: LedgerConfig (ShelleyBlock Proto Era) + ledgerConfig :: LedgerConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ledgerConfig = Shelley.mkShelleyLedgerConfig genesisConfig (SL.toFromByronTranslationContext genesisConfig) -- trivial translation context diff --git a/ouroboros-consensus-diffusion/CHANGELOG.md b/ouroboros-consensus-diffusion/CHANGELOG.md index 99d17d2ffa..371de58b71 100644 --- a/ouroboros-consensus-diffusion/CHANGELOG.md +++ b/ouroboros-consensus-diffusion/CHANGELOG.md @@ -2,6 +2,20 @@ # Changelog entries + +## 0.20.0.0 — 2025-02-10 + +### Breaking + +- Updated to `ouroboros-network-0.19.0.2` & `ouroboros-network-framework-0.16`. +- `runWith` and `LowLevelRunNodeArgs` are no longer polymorphic in version + data. +- `NodeToNode.initiator`, `NodeToNode.initiatorAndResponder` take negotiated + `NodeToNodeVersionData` as an argument instead of `PeerSharing` (config + option). +- `NodeToClient.responder` take negotiated `NodeToClientVersionData` as an + argument. + ## 0.19.0.0 — 2025-01-08 diff --git a/ouroboros-consensus-diffusion/changelog.d/20250204_081411_coot_ouroboros_network_0_19_0_2.md b/ouroboros-consensus-diffusion/changelog.d/20250204_081411_coot_ouroboros_network_0_19_0_2.md deleted file mode 100644 index 8f89c9d3f4..0000000000 --- a/ouroboros-consensus-diffusion/changelog.d/20250204_081411_coot_ouroboros_network_0_19_0_2.md +++ /dev/null @@ -1,10 +0,0 @@ -### Breaking - -- Updated to `ouroboros-network-0.19.0.2` & `ouroboros-network-framework-0.16`. -- `runWith` and `LowLevelRunNodeArgs` are no longer polymorphic in version - data. -- `NodeToNode.initiator`, `NodeToNode.initiatorAndResponder` take negotiated - `NodeToNodeVersionData` as an argument instead of `PeerSharing` (config - option). -- `NodeToClient.respoinder` take negotiated `NodeToClientVersionData` as an - argument. diff --git a/ouroboros-consensus-diffusion/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md b/ouroboros-consensus-diffusion/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md new file mode 100644 index 0000000000..e69de29bb2 diff --git a/ouroboros-consensus-diffusion/changelog.d/20250214_122440_jasataco_sts.md b/ouroboros-consensus-diffusion/changelog.d/20250214_122440_jasataco_sts.md new file mode 100644 index 0000000000..204403fd5b --- /dev/null +++ b/ouroboros-consensus-diffusion/changelog.d/20250214_122440_jasataco_sts.md @@ -0,0 +1,22 @@ + + +### Patch + +- Use `OmitLedgerEvents` when ticking blocks in the forging loop + + + diff --git a/ouroboros-consensus-diffusion/changelog.d/20250304_135940_jasataco_release_10_3.md b/ouroboros-consensus-diffusion/changelog.d/20250304_135940_jasataco_release_10_3.md new file mode 100644 index 0000000000..e3c8299ccb --- /dev/null +++ b/ouroboros-consensus-diffusion/changelog.d/20250304_135940_jasataco_release_10_3.md @@ -0,0 +1,28 @@ + + + + +### Breaking + +- Update to latest `ouroboros-network` release: + | Package | Version | + |-----------------------------|---------| + | network-mux | 0.7 | + | ouroboros-network | 0.20 | + | ouroboros-network-api | 0.13 | + | ouroboros-network-framework | 0.17 | + | ouroboros-network-protocols | 0.14 | diff --git a/ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal b/ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal index a765dfacc7..f89a4e3d11 100644 --- a/ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal +++ b/ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ouroboros-consensus-diffusion -version: 0.19.0.0 +version: 0.20.0.0 synopsis: Integration for the Ouroboros Network layer description: Top level integration for consensus & network layers of the Ouroboros blockchain protocol. @@ -84,17 +84,18 @@ library containers >=0.5 && <0.8, contra-tracer, deepseq, + dns, filepath, fs-api ^>=0.3, hashable, io-classes ^>=1.5, mtl, - network-mux ^>=0.6, + network-mux ^>=0.7, ouroboros-consensus ^>=0.22, - ouroboros-network ^>=0.19.0.2, - ouroboros-network-api ^>=0.12, - ouroboros-network-framework ^>=0.16, - ouroboros-network-protocols ^>=0.13, + ouroboros-network ^>=0.20, + ouroboros-network-api ^>=0.13, + ouroboros-network-framework ^>=0.17, + ouroboros-network-protocols ^>=0.14, random, resource-registry ^>=0.1, safe-wild-cards ^>=1.0, @@ -133,6 +134,7 @@ library unstable-diffusion-testlib QuickCheck, base, bytestring, + cardano-ledger-core, cborg, containers, contra-tracer, @@ -174,11 +176,10 @@ library unstable-mock-testlib QuickCheck, base, bytestring, - cardano-crypto-class, - cardano-crypto-tests, + cardano-crypto-class ^>=2.2, + cardano-crypto-tests ^>=2.2, containers, ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib, unstable-mock-block}, - ouroboros-network-protocols:testlib, serialise, unstable-diffusion-testlib, @@ -190,6 +191,7 @@ test-suite infra-test other-modules: Test.ThreadNet.Util.Tests build-depends: base, + cardano-ledger-core, ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib}, tasty, tasty-quickcheck, @@ -211,6 +213,7 @@ test-suite mock-test QuickCheck, base, bytestring, + cardano-ledger-core, cborg, constraints, containers, @@ -281,7 +284,8 @@ test-suite consensus-test base, binary, bytestring, - cardano-crypto-class, + cardano-crypto-class ^>=2.2, + cardano-ledger-core, cardano-slotting:{cardano-slotting, testlib}, cardano-strict-containers, containers, diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs index 277c31eae4..94fcee04b1 100644 --- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs +++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToClient.hs @@ -217,6 +217,7 @@ defaultCodecs ccfg version networkVersion = Codecs { , cTxMonitorCodec = codecLocalTxMonitor + networkVersion enc dec enc dec enc dec @@ -277,6 +278,7 @@ clientCodecs ccfg version networkVersion = Codecs { , cTxMonitorCodec = codecLocalTxMonitor + networkVersion enc dec enc dec enc dec diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs index 3851c18d1d..923251d8a4 100644 --- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs +++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs @@ -60,11 +60,15 @@ module Ouroboros.Consensus.Node ( , openChainDB ) where +import Cardano.Network.PeerSelection.Bootstrap + (UseBootstrapPeers (..)) +import Cardano.Network.Types (LedgerStateJudgement (..)) import qualified Codec.CBOR.Decoding as CBOR import qualified Codec.CBOR.Encoding as CBOR import Codec.Serialise (DeserialiseFailure) import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM import Control.DeepSeq (NFData) +import Control.Exception (IOException) import Control.Monad (forM_, when) import Control.Monad.Class.MonadTime.SI (MonadTime) import Control.Monad.Class.MonadTimer.SI (MonadTimer) @@ -78,6 +82,11 @@ import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, isNothing) import Data.Time (NominalDiffTime) import Data.Typeable (Typeable) +import Network.DNS.Resolver (Resolver) +import Network.Mux.Types +import qualified Ouroboros.Cardano.Network.ArgumentsExtra as Cardano +import qualified Ouroboros.Cardano.Network.LedgerPeerConsensusInterface as Cardano +import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime hiding (getSystemStart) import Ouroboros.Consensus.Config @@ -116,11 +125,13 @@ import Ouroboros.Consensus.Util.Args import Ouroboros.Consensus.Util.IOLike import Ouroboros.Consensus.Util.Orphans () import Ouroboros.Consensus.Util.Time (secondsToNominalDiffTime) -import Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..)) +import Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..), + FetchMode) import qualified Ouroboros.Network.Diffusion as Diffusion +import qualified Ouroboros.Network.Diffusion.Common as Diffusion import qualified Ouroboros.Network.Diffusion.Configuration as Diffusion import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P -import qualified Ouroboros.Network.Diffusion.P2P as P2P +import qualified Ouroboros.Network.Diffusion.P2P as Diffusion.P2P import Ouroboros.Network.Magic import Ouroboros.Network.NodeToClient (ConnectionId, LocalAddress, LocalSocket, NodeToClientVersionData (..), combineVersions, @@ -129,14 +140,17 @@ import Ouroboros.Network.NodeToNode (DiffusionMode (..), ExceptionInHandler (..), MiniProtocolParameters, NodeToNodeVersionData (..), RemoteAddress, Socket, blockFetchPipeliningMax, defaultMiniProtocolParameters) -import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers) +import Ouroboros.Network.PeerSelection.Governor.Types + (PeerSelectionState, PublicPeerSelectionState) import Ouroboros.Network.PeerSelection.LedgerPeers - (LedgerPeersConsensusInterface (..)) + (LedgerPeersConsensusInterface (..), UseLedgerPeers (..)) import Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics, newPeerMetric, reportMetric) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing) import Ouroboros.Network.PeerSelection.PeerSharing.Codec (decodeRemoteAddress, encodeRemoteAddress) +import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers + (TracePublicRootPeers) import Ouroboros.Network.RethrowPolicy import qualified SafeWildCards import System.Exit (ExitCode (..)) @@ -212,7 +226,7 @@ data RunNodeArgs m addrNTN addrNTC blk (p2p :: Diffusion.P2P) = RunNodeArgs { -- abbreviation, which uses 'stdLowLevelRunNodeArgsIO' to indirectly specify -- these low-level values from the higher-level 'StdRunNodeArgs'. data LowLevelRunNodeArgs m addrNTN addrNTC blk - (p2p :: Diffusion.P2P) = + (p2p :: Diffusion.P2P) extraAPI = LowLevelRunNodeArgs { -- | An action that will receive a marker indicating whether the previous @@ -268,11 +282,12 @@ data LowLevelRunNodeArgs m addrNTN addrNTC blk -- -- 'run' will not return before this does. , llrnRunDataDiffusion :: - Diffusion.Applications + NodeKernel m addrNTN (ConnectionId addrNTC) blk + -> Diffusion.Applications addrNTN NodeToNodeVersion NodeToNodeVersionData addrNTC NodeToClientVersion NodeToClientVersionData - m NodeToNodeInitiatorResult - -> Diffusion.ExtraApplications p2p addrNTN m NodeToNodeInitiatorResult + extraAPI m NodeToNodeInitiatorResult + -> Diffusion.ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult -> m () , llrnVersionDataNTC :: NodeToClientVersionData @@ -292,7 +307,7 @@ data LowLevelRunNodeArgs m addrNTN addrNTC blk -- | Maximum clock skew , llrnMaxClockSkew :: InFutureCheck.ClockSkew - , llrnPublicPeerSelectionStateVar :: StrictSTM.StrictTVar m (Diffusion.PublicPeerSelectionState addrNTN) + , llrnPublicPeerSelectionStateVar :: StrictSTM.StrictTVar m (PublicPeerSelectionState addrNTN) } data NodeDatabasePaths = @@ -320,7 +335,7 @@ nonImmutableDbPath (MultipleDbPaths _ vol) = vol -- some usual assumptions for realistic use cases such as in @cardano-node@. -- -- See 'stdLowLevelRunNodeArgsIO'. -data StdRunNodeArgs m blk (p2p :: Diffusion.P2P) = StdRunNodeArgs +data StdRunNodeArgs m blk (p2p :: Diffusion.P2P) extraArgs extraState extraDebugState extraActions extraAPI extraPeers extraFlags extraChurnArgs extraCounters exception = StdRunNodeArgs { srnBfcMaxConcurrencyBulkSync :: Maybe Word , srnBfcMaxConcurrencyDeadline :: Maybe Word , srnChainDbValidateOverride :: Bool @@ -332,12 +347,41 @@ data StdRunNodeArgs m blk (p2p :: Diffusion.P2P) = StdRunNodeArgs IO Socket RemoteAddress LocalSocket LocalAddress - , srnDiffusionArgumentsExtra :: Diffusion.ExtraArguments p2p m + , srnDiffusionArgumentsExtra :: Diffusion.P2PDecision p2p (Tracer IO TracePublicRootPeers) () + -> Diffusion.P2PDecision p2p (STM IO FetchMode) () + -> Diffusion.P2PDecision p2p extraAPI () + -> Diffusion.ArgumentsExtra p2p + extraArgs extraState extraDebugState + extraFlags extraPeers extraAPI + extraChurnArgs extraCounters + exception RemoteAddress LocalAddress + Resolver IOException IO , srnDiffusionTracers :: Diffusion.Tracers RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO - , srnDiffusionTracersExtra :: Diffusion.ExtraTracers p2p + , srnDiffusionTracersExtra :: Diffusion.ExtraTracers p2p extraState extraDebugState extraFlags extraPeers extraCounters IO + , srnSigUSR1SignalHandler :: ( forall (mode :: Mode) x y. + Diffusion.ExtraTracers p2p + extraState + Cardano.DebugPeerSelectionState + extraFlags extraPeers extraCounters + IO + -> STM IO UseLedgerPeers + -> PeerSharing + -> STM IO UseBootstrapPeers + -> STM IO LedgerStateJudgement + -> Diffusion.P2P.NodeToNodeConnectionManager mode Socket + RemoteAddress NodeToNodeVersionData + NodeToNodeVersion IO x y + -> StrictSTM.StrictTVar IO + (PeerSelectionState extraState extraFlags extraPeers + RemoteAddress + (Diffusion.P2P.NodeToNodePeerConnectionHandle + mode RemoteAddress + NodeToNodeVersionData IO x y)) + -> PeerMetrics IO RemoteAddress + -> IO ()) , srnEnableInDevelopmentVersions :: Bool -- ^ If @False@, then the node will limit the negotiated NTN and NTC -- versions to the latest " official " release (as chosen by Network and @@ -366,10 +410,15 @@ deriving instance Show (NetworkP2PMode p2p) pure [] -- | Combination of 'runWith' and 'stdLowLevelRunArgsIO' -run :: forall blk p2p. - RunNode blk +run :: forall blk p2p extraState extraActions extraPeers extraFlags extraChurnArgs extraCounters exception. + ( RunNode blk + , Monoid extraPeers + , Eq extraCounters + , Eq extraFlags + , Exception exception + ) => RunNodeArgs IO RemoteAddress LocalAddress blk p2p - -> StdRunNodeArgs IO blk p2p + -> StdRunNodeArgs IO blk p2p (Cardano.ExtraArguments IO) extraState Cardano.DebugPeerSelectionState extraActions (Cardano.LedgerPeersConsensusInterface IO) extraPeers extraFlags extraChurnArgs extraCounters exception -> IO () run args stdArgs = stdLowLevelRunNodeArgsIO args stdArgs >>= runWith args encodeRemoteAddress decodeRemoteAddress @@ -406,7 +455,7 @@ runWith :: forall m addrNTN addrNTC blk p2p. => RunNodeArgs m addrNTN addrNTC blk p2p -> (NodeToNodeVersion -> addrNTN -> CBOR.Encoding) -> (NodeToNodeVersion -> forall s . CBOR.Decoder s addrNTN) - -> LowLevelRunNodeArgs m addrNTN addrNTC blk p2p + -> LowLevelRunNodeArgs m addrNTN addrNTC blk p2p (Cardano.LedgerPeersConsensusInterface m) -> m () runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} = @@ -519,15 +568,15 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} = peerMetrics <- newPeerMetric Diffusion.peerMetricsConfiguration let ntnApps = mkNodeToNodeApps nodeKernelArgs nodeKernel peerMetrics encAddrNtN decAddrNtN ntcApps = mkNodeToClientApps nodeKernelArgs nodeKernel - (apps, appsExtra) = mkDiffusionApplications - rnEnableP2P + (apps, appsExtra) = + mkDiffusionApplications rnEnableP2P (miniProtocolParameters nodeKernelArgs) ntnApps ntcApps nodeKernel peerMetrics - llrnRunDataDiffusion apps appsExtra + llrnRunDataDiffusion nodeKernel apps appsExtra where ProtocolInfo { pInfoConfig = cfg @@ -603,8 +652,9 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} = -> ( Diffusion.Applications addrNTN NodeToNodeVersion NodeToNodeVersionData addrNTC NodeToClientVersion NodeToClientVersionData + (Cardano.LedgerPeersConsensusInterface m) m NodeToNodeInitiatorResult - , Diffusion.ExtraApplications p2p addrNTN m NodeToNodeInitiatorResult + , Diffusion.ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult ) mkDiffusionApplications enP2P @@ -616,19 +666,18 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} = case enP2P of EnabledP2PMode -> ( apps - , Diffusion.P2PApplications - P2P.ApplicationsExtra { - P2P.daRethrowPolicy = consensusRethrowPolicy (Proxy @blk), - P2P.daReturnPolicy = returnPolicy, - P2P.daLocalRethrowPolicy = localRethrowPolicy, - P2P.daPeerMetrics = peerMetrics, - P2P.daBlockFetchMode = getFetchMode kernel, - P2P.daPeerSharingRegistry = getPeerSharingRegistry kernel + , Diffusion.P2PApplicationsExtra + Diffusion.P2P.ApplicationsExtra { + Diffusion.P2P.daRethrowPolicy = consensusRethrowPolicy (Proxy @blk), + Diffusion.P2P.daReturnPolicy = returnPolicy, + Diffusion.P2P.daLocalRethrowPolicy = localRethrowPolicy, + Diffusion.P2P.daPeerMetrics = peerMetrics, + Diffusion.P2P.daPeerSharingRegistry = getPeerSharingRegistry kernel } ) DisabledP2PMode -> ( apps - , Diffusion.NonP2PApplications + , Diffusion.NonP2PApplicationsExtra NonP2P.ApplicationsExtra { NonP2P.daErrorPolicies = consensusErrorPolicy (Proxy @blk) } @@ -670,12 +719,15 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} = LedgerPeersConsensusInterface { lpGetLatestSlot = getImmTipSlot kernel, lpGetLedgerPeers = fromMaybe [] <$> getPeersFromCurrentLedger kernel (const True), - lpGetLedgerStateJudgement = GSM.gsmStateToLedgerJudgement <$> getGsmState kernel - }, - Diffusion.daUpdateOutboundConnectionsState = - let varOcs = getOutboundConnectionsState kernel in \newOcs -> do - oldOcs <- readTVar varOcs - when (newOcs /= oldOcs) $ writeTVar varOcs newOcs + lpExtraAPI = + Cardano.LedgerPeersConsensusInterface { + Cardano.getLedgerStateJudgement = GSM.gsmStateToLedgerJudgement <$> getGsmState kernel + , Cardano.updateOutboundConnectionsState = + let varOcs = getOutboundConnectionsState kernel in \newOcs -> do + oldOcs <- readTVar varOcs + when (newOcs /= oldOcs) $ writeTVar varOcs newOcs + } + } } localRethrowPolicy :: RethrowPolicy @@ -755,7 +807,7 @@ mkNodeKernelArgs :: -> Maybe (GSM.WrapDurationUntilTooOld m blk) -> GSM.MarkerFileView m -> STM m UseBootstrapPeers - -> StrictSTM.StrictTVar m (Diffusion.PublicPeerSelectionState addrNTN) + -> StrictSTM.StrictTVar m (PublicPeerSelectionState addrNTN) -> GenesisNodeKernelArgs m blk -> DiffusionPipeliningSupport -> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk) @@ -869,41 +921,107 @@ stdVersionDataNTC networkMagic = NodeToClientVersionData , query = False } -stdRunDataDiffusion :: - Diffusion.Tracers - RemoteAddress NodeToNodeVersion - LocalAddress NodeToClientVersion - IO - -> Diffusion.ExtraTracers p2p +stdRunDataDiffusion + :: ( Monoid extraPeers + , Eq extraCounters + , Eq extraFlags + , Exception exception + ) + => ( forall (mode :: Mode) x y. + Diffusion.P2P.NodeToNodeConnectionManager + mode + Socket + RemoteAddress + NodeToNodeVersionData + NodeToNodeVersion + IO + x + y + -> StrictSTM.StrictTVar + IO + (PeerSelectionState + extraState + extraFlags + extraPeers + RemoteAddress + (Diffusion.P2P.NodeToNodePeerConnectionHandle + mode + RemoteAddress + NodeToNodeVersionData + IO + x + y) + ) + -> PeerMetrics IO RemoteAddress + -> IO () + ) -> Diffusion.Tracers + RemoteAddress + NodeToNodeVersion + LocalAddress + NodeToClientVersion + IO + -> Diffusion.ExtraTracers + p2p + extraState + extraDebugState + extraFlags + extraPeers + extraCounters + IO -> Diffusion.Arguments - IO - Socket RemoteAddress - LocalSocket LocalAddress - -> Diffusion.ExtraArguments p2p IO + IO + Socket + RemoteAddress + LocalSocket + LocalAddress + -> Diffusion.ArgumentsExtra + p2p + extraArgs + extraState + extraDebugState + extraFlags + extraPeers + extraAPI + extraChurnArgs + extraCounters + exception + RemoteAddress + LocalAddress + Resolver + IOException + IO -> Diffusion.Applications - RemoteAddress NodeToNodeVersion NodeToNodeVersionData - LocalAddress NodeToClientVersion NodeToClientVersionData - IO NodeToNodeInitiatorResult - -> Diffusion.ExtraApplications p2p RemoteAddress IO NodeToNodeInitiatorResult + RemoteAddress NodeToNodeVersion NodeToNodeVersionData + LocalAddress NodeToClientVersion NodeToClientVersionData + extraAPI IO a + -> Diffusion.ApplicationsExtra p2p RemoteAddress IO a -> IO () stdRunDataDiffusion = Diffusion.run -- | Conveniently packaged 'LowLevelRunNodeArgs' arguments from a standard -- non-testing invocation. -stdLowLevelRunNodeArgsIO :: - forall blk p2p. RunNode blk +stdLowLevelRunNodeArgsIO + :: forall blk p2p extraState extraActions extraPeers extraFlags extraChurnArgs extraCounters exception . + ( RunNode blk + , Monoid extraPeers + , Eq extraCounters + , Eq extraFlags + , Exception exception + ) => RunNodeArgs IO RemoteAddress LocalAddress blk p2p - -> StdRunNodeArgs IO blk p2p + -> StdRunNodeArgs IO blk p2p (Cardano.ExtraArguments IO) extraState Cardano.DebugPeerSelectionState extraActions (Cardano.LedgerPeersConsensusInterface IO) extraPeers extraFlags extraChurnArgs extraCounters exception -> IO (LowLevelRunNodeArgs IO RemoteAddress LocalAddress blk - p2p) + p2p + (Cardano.LedgerPeersConsensusInterface IO)) stdLowLevelRunNodeArgsIO RunNodeArgs{ rnProtocolInfo , rnEnableP2P , rnPeerSharing , rnGenesisConfig + , rnGetUseBootstrapPeers } $(SafeWildCards.fields 'StdRunNodeArgs) = do llrnBfcSalt <- stdBfcSaltIO @@ -922,12 +1040,46 @@ stdLowLevelRunNodeArgsIO RunNodeArgs{ rnProtocolInfo , llrnCustomiseChainDbArgs = id , llrnCustomiseNodeKernelArgs , llrnRunDataDiffusion = - \apps extraApps -> - stdRunDataDiffusion srnDiffusionTracers + \kernel apps extraApps -> do + case rnEnableP2P of + EnabledP2PMode -> + case srnDiffusionTracersExtra of + Diffusion.P2PTracers extraTracers -> do + let srnDiffusionArgumentsExtra' = + srnDiffusionArgumentsExtra (Diffusion.P2PDecision (Diffusion.P2P.dtTracePublicRootPeersTracer extraTracers)) + (Diffusion.P2PDecision (getFetchMode kernel)) + (Diffusion.P2PDecision (lpExtraAPI (Diffusion.daLedgerPeersCtx apps))) + case srnDiffusionArgumentsExtra' of + Diffusion.P2PArguments extraArgs -> + stdRunDataDiffusion + (srnSigUSR1SignalHandler srnDiffusionTracersExtra - srnDiffusionArguments - srnDiffusionArgumentsExtra - apps extraApps + (Diffusion.P2P.daReadUseLedgerPeers extraArgs) + rnPeerSharing + rnGetUseBootstrapPeers + (GSM.gsmStateToLedgerJudgement <$> getGsmState kernel)) + srnDiffusionTracers + srnDiffusionTracersExtra + srnDiffusionArguments + srnDiffusionArgumentsExtra' + apps extraApps + + DisabledP2PMode -> + stdRunDataDiffusion + (srnSigUSR1SignalHandler + (Diffusion.NonP2PTracers NonP2P.nullTracers) + (pure DontUseLedgerPeers) + rnPeerSharing + (pure DontUseBootstrapPeers) + (pure TooOld)) + srnDiffusionTracers + srnDiffusionTracersExtra + srnDiffusionArguments + (srnDiffusionArgumentsExtra + (Diffusion.NonP2PDecision ()) + (Diffusion.NonP2PDecision ()) + (Diffusion.NonP2PDecision ())) + apps extraApps , llrnVersionDataNTC = stdVersionDataNTC networkMagic , llrnVersionDataNTN = diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs index 129e15f0c5..d7e53e3ab2 100644 --- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs +++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM.hs @@ -28,6 +28,7 @@ module Ouroboros.Consensus.Node.GSM ( , module Ouroboros.Consensus.Node.GsmState ) where +import Cardano.Network.Types (LedgerStateJudgement (..)) import qualified Cardano.Slotting.Slot as Slot import qualified Control.Concurrent.Class.MonadSTM.TVar as LazySTM import Control.Monad (forever, join, unless) @@ -49,8 +50,6 @@ import Ouroboros.Consensus.Node.GsmState import Ouroboros.Consensus.Storage.ChainDB.API (ChainDB) import Ouroboros.Consensus.Util.NormalForm.StrictTVar (StrictTVar) import qualified Ouroboros.Consensus.Util.NormalForm.StrictTVar as StrictSTM -import Ouroboros.Network.PeerSelection.LedgerPeers.Type - (LedgerStateJudgement (..)) import System.FS.API (HasFS, createDirectoryIfMissing, doesFileExist, removeFile, withFile) import System.FS.API.Types (AllowExisting (..), FsPath, OpenMode (..), diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs index 4d645bdd54..8ddfc1534e 100644 --- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs +++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs @@ -27,6 +27,11 @@ module Ouroboros.Consensus.NodeKernel ( ) where +import Cardano.Network.ConsensusMode (ConsensusMode (..)) +import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers) +import Cardano.Network.PeerSelection.LocalRootPeers + (OutboundConnectionsState (..)) +import Cardano.Network.Types (LedgerStateJudgement (..)) import qualified Control.Concurrent.Class.MonadSTM as LazySTM import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM import Control.DeepSeq (force) @@ -95,15 +100,10 @@ import Ouroboros.Network.AnchoredFragment (AnchoredFragment, import qualified Ouroboros.Network.AnchoredFragment as AF import Ouroboros.Network.Block (castTip, tipFromHeader) import Ouroboros.Network.BlockFetch -import Ouroboros.Network.ConsensusMode (ConsensusMode (..)) -import Ouroboros.Network.Diffusion (PublicPeerSelectionState) import Ouroboros.Network.NodeToNode (ConnectionId, MiniProtocolParameters (..)) -import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type - (LedgerStateJudgement (..)) -import Ouroboros.Network.PeerSelection.LocalRootPeers - (OutboundConnectionsState (..)) +import Ouroboros.Network.PeerSelection.Governor.Types + (PublicPeerSelectionState) import Ouroboros.Network.PeerSharing (PeerSharingAPI, PeerSharingRegistry, newPeerSharingAPI, newPeerSharingRegistry, ps_POLICY_PEER_SHARE_MAX_PEERS, @@ -541,6 +541,7 @@ forkBlockForging IS{..} blockForging = let tickedLedgerState :: Ticked (LedgerState blk) tickedLedgerState = applyChainTick + OmitLedgerEvents (configLedger cfg) currentSlot (ledgerState unticked) @@ -765,9 +766,9 @@ getMempoolReader mempool = MempoolReader.TxSubmissionMempoolReader { mempoolTxIdsAfter = \idx -> [ ( txId (txForgetValidated tx) , idx' - , SizeInBytes $ unByteSize32 byteSize + , SizeInBytes $ unByteSize32 $ txMeasureByteSize msr ) - | (tx, idx', byteSize) <- snapshotTxsAfter idx + | (tx, idx', msr) <- snapshotTxsAfter idx ] , mempoolLookupTx = snapshotLookupTx , mempoolHasTx = snapshotHasTx diff --git a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs index d7dd9e75cc..a7df5a3173 100644 --- a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs +++ b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs @@ -36,6 +36,8 @@ module Test.ThreadNet.Network ( , TestOutput (..) ) where +import Cardano.Network.PeerSelection.Bootstrap + (UseBootstrapPeers (..)) import Codec.CBOR.Read (DeserialiseFailure) import qualified Control.Concurrent.Class.MonadSTM as MonadSTM import Control.Concurrent.Class.MonadSTM.Strict (newTMVar) @@ -110,8 +112,6 @@ import Ouroboros.Network.Mock.Chain (Chain (Genesis)) import Ouroboros.Network.NodeToNode (ConnectionId (..), ExpandedInitiatorContext (..), IsBigLedgerPeer (..), MiniProtocolParameters (..), ResponderContext (..)) -import Ouroboros.Network.PeerSelection.Bootstrap - (UseBootstrapPeers (..)) import Ouroboros.Network.PeerSelection.Governor (makePublicPeerSelectionStateVar) import Ouroboros.Network.PeerSelection.PeerMetric (nullMetric) @@ -622,11 +622,11 @@ runThreadNetwork systemTime ThreadNetworkArgs snap1 <- getSnapshotFor mempool $ -- This node would include these crucial txs if it leads in -- this slot. - ForgeInKnownSlot slot $ applyChainTick lcfg slot ledger + ForgeInKnownSlot slot $ applyChainTick OmitLedgerEvents lcfg slot ledger snap2 <- getSnapshotFor mempool $ -- Other nodes might include these crucial txs when leading -- in the next slot. - ForgeInKnownSlot (succ slot) $ applyChainTick lcfg (succ slot) ledger + ForgeInKnownSlot (succ slot) $ applyChainTick OmitLedgerEvents lcfg (succ slot) ledger -- This loop will repeat for the next slot, so we only need to -- check for this one and the next. pure (snap1, snap2) @@ -887,10 +887,10 @@ runThreadNetwork systemTime ThreadNetworkArgs -- fail if the EBB is invalid -- if it is valid, we retick to the /same/ slot - let apply = applyLedgerBlock (configLedger pInfoConfig) + let apply = applyLedgerBlock OmitLedgerEvents (configLedger pInfoConfig) tickedLdgSt' <- case Exc.runExcept $ apply ebb tickedLdgSt of Left e -> Exn.throw $ JitEbbError @blk e - Right st -> pure $ applyChainTick + Right st -> pure $ applyChainTick OmitLedgerEvents (configLedger pInfoConfig) currentSlot st diff --git a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Ref/PBFT.hs b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Ref/PBFT.hs index 35e42785dd..027253a862 100644 --- a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Ref/PBFT.hs +++ b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Ref/PBFT.hs @@ -24,6 +24,7 @@ module Test.ThreadNet.Ref.PBFT ( , viable ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) import Control.Monad (guard) @@ -50,11 +51,11 @@ import Test.Util.Slots (NumSlots (..)) oneK :: Num a => PBftParams -> a oneK PBftParams{pbftSecurityParam} = - fromIntegral (maxRollbacks pbftSecurityParam) + fromIntegral $ unNonZero $ maxRollbacks pbftSecurityParam twoK :: Num a => PBftParams -> a twoK PBftParams{pbftSecurityParam} = - 2 * fromIntegral (maxRollbacks pbftSecurityParam) + 2 * fromIntegral (unNonZero $ maxRollbacks pbftSecurityParam) oneN :: Num a => PBftParams -> a oneN PBftParams{pbftNumNodes = NumCoreNodes n} = fromIntegral n @@ -572,7 +573,7 @@ definitelyEnoughBlocks params = \case in go 0 $ zip exits enters where PBftParams{pbftSecurityParam} = params - k = maxRollbacks pbftSecurityParam + k = unNonZero $ maxRollbacks pbftSecurityParam tick :: Outcome -> Word64 tick Nominal = 0 diff --git a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util.hs b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util.hs index 7ee9efef8a..8f6e67ef5c 100644 --- a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util.hs +++ b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util.hs @@ -19,6 +19,7 @@ module Test.ThreadNet.Util ( , module Test.ThreadNet.Util.Expectations ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Data.Graph.Inductive.Graph import Data.Graph.Inductive.PatriciaTree import Data.GraphViz @@ -232,7 +233,7 @@ consensusExpected :: -> LeaderSchedule -> Bool consensusExpected k nodeJoinPlan schedule = - maxForkLength <= maxRollbacks k + maxForkLength <= unNonZero (maxRollbacks k) where NumBlocks maxForkLength = determineForkLength k nodeJoinPlan schedule diff --git a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util/Expectations.hs b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util/Expectations.hs index d49b1e0cd2..6d605b61a0 100644 --- a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util/Expectations.hs +++ b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Util/Expectations.hs @@ -5,6 +5,7 @@ module Test.ThreadNet.Util.Expectations ( , determineForkLength ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Data.Foldable as Foldable (foldl') import qualified Data.Map.Strict as Map import Data.Word (Word64) @@ -121,7 +122,7 @@ determineForkLength k (NodeJoinPlan joinPlan) (LeaderSchedule sched) = update -- too late to reach consensus, so further diverge - | maxForkLength > maxRollbacks k = grow + | maxForkLength > unNonZero (maxRollbacks k) = grow -- assume (common) worst-case: each leader creates a unique longer -- chain diff --git a/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/Consensus/Ledger/Mock/Generators.hs b/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/Consensus/Ledger/Mock/Generators.hs index 72ab653d1b..df10e92f5c 100644 --- a/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/Consensus/Ledger/Mock/Generators.hs +++ b/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/Consensus/Ledger/Mock/Generators.hs @@ -25,7 +25,6 @@ import qualified Ouroboros.Consensus.Mock.Ledger.State as L import qualified Ouroboros.Consensus.Mock.Ledger.UTxO as L import Ouroboros.Consensus.Mock.Node.Serialisation () import Ouroboros.Consensus.Protocol.BFT -import Test.ChainGenerators () import Test.Crypto.Hash () import Test.QuickCheck import Test.Util.Orphans.Arbitrary () @@ -108,6 +107,16 @@ instance (SimpleCrypto c, Typeable ext) => Arbitrary (SomeResult (SimpleBlock c instance Arbitrary (LedgerState (SimpleBlock c ext)) where arbitrary = SimpleLedgerState <$> arbitrary +instance Arbitrary ByteSize32 where + arbitrary = ByteSize32 <$> arbitrary + +instance Arbitrary L.MockConfig where + arbitrary = L.MockConfig <$> arbitrary + +instance ( Arbitrary (MockLedgerConfig c ext) + ) => Arbitrary (SimpleLedgerConfig c ext) where + arbitrary = SimpleLedgerConfig <$> arbitrary <*> arbitrary <*> arbitrary + instance HashAlgorithm (SimpleHash c) => Arbitrary (AnnTip (SimpleBlock c ext)) where arbitrary = do annTipSlotNo <- SlotNo <$> arbitrary diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs index bb60bd77c6..59cf2e810f 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM.hs @@ -3,6 +3,7 @@ module Test.Consensus.GSM (tests) where +import Cardano.Network.Types (LedgerStateJudgement (..)) import Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked import Control.Monad (replicateM_) import Control.Monad.Class.MonadAsync (poll, withAsync) @@ -17,8 +18,6 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Ouroboros.Consensus.Node.GSM as GSM import Ouroboros.Consensus.Util.IOLike (IOLike) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type - (LedgerStateJudgement (..)) import Test.Consensus.GSM.Model import Test.Consensus.IOSimQSM.Test.StateMachine.Sequential (runCommands') diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM/Model.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM/Model.hs index f83ee6d679..f9cdc6f175 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM/Model.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/GSM/Model.hs @@ -13,6 +13,7 @@ module Test.Consensus.GSM.Model (module Test.Consensus.GSM.Model) where +import Cardano.Network.Types (LedgerStateJudgement (..)) import qualified Control.Monad.Class.MonadTime.SI as SI import Data.Kind (Type) import Data.List ((\\)) @@ -22,8 +23,6 @@ import Data.Time (diffTimeToPicoseconds) import qualified Data.TreeDiff as TD import GHC.Generics (Generic, Generic1) import qualified Ouroboros.Consensus.Node.GSM as GSM -import Ouroboros.Network.PeerSelection.LedgerPeers.Type - (LedgerStateJudgement (..)) import qualified Test.QuickCheck as QC import Test.QuickCheck (choose, elements, shrink) import qualified Test.StateMachine as QSM diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/Classifiers.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/Classifiers.hs index 9edc0a262c..9965c59f44 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/Classifiers.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/Classifiers.hs @@ -14,6 +14,7 @@ module Test.Consensus.Genesis.Setup.Classifiers ( , simpleHash ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Cardano.Slotting.Slot (WithOrigin (..)) import Data.List (sortOn, tails) import qualified Data.List.NonEmpty as NonEmpty @@ -102,7 +103,7 @@ classifiers GenesisTest {gtBlockTree, gtSecurityParam = SecurityParam k, gtGenes allAdversariesSelectable = all isSelectable branches - isSelectable bt = AF.length (btbSuffix bt) > fromIntegral k + isSelectable bt = AF.length (btbSuffix bt) > fromIntegral (unNonZero k) allAdversariesForecastable = all isForecastable branches @@ -125,7 +126,7 @@ classifiers GenesisTest {gtBlockTree, gtSecurityParam = SecurityParam k, gtGenes -- Distinguish `scg` vs. `sgen` vs. `sfor` and use the latter here. let forecastSlot = succWithOrigin (anchorToSlotNo $ anchor btbSuffix) + SlotNo scg forecastBlocks = AF.takeWhileOldest (\b -> blockSlot b < forecastSlot) btbSuffix - in AF.length forecastBlocks >= fromIntegral k + 1 + in AF.length forecastBlocks >= fromIntegral (unNonZero k) + 1 SlotNo goodTipSlot = withOrigin 0 id (headSlot goodChain) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/GenChains.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/GenChains.hs index e6ec79b721..02b813c45e 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/GenChains.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/GenChains.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NamedFieldPuns #-} @@ -10,6 +11,7 @@ module Test.Consensus.Genesis.Setup.GenChains ( , genChainsWithExtraHonestPeers ) where +import Cardano.Ledger.BaseTypes (nonZeroOr) import Cardano.Slotting.Time (slotLengthFromSec) import Control.Monad (replicateM) import qualified Control.Monad.Except as Exn @@ -123,7 +125,10 @@ genChainsWithExtraHonestPeers genNumExtraHonest genNumForks = do gtExtraHonestPeers <- genNumExtraHonest alternativeChainSchemas <- replicateM (fromIntegral numForks) (genAlternativeChainSchema (honestRecipe, honestChainSchema)) pure $ GenesisTest { - gtSecurityParam = SecurityParam (fromIntegral kcp), + gtSecurityParam = + SecurityParam $ + -- As long as `genKSD` generates a `k` that is > 0, this won't lead to an ErrorCall. + nonZeroOr (fromIntegral kcp) $ error "Generated Kcp was zero. Cannot construct a NonZero value for the SecurityParam.", gtGenesisWindow = GenesisWindow (fromIntegral scg), gtForecastRange = ForecastRange (fromIntegral scg), -- REVIEW: Do we want to generate those randomly? gtDelay = delta, diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs index bb87438891..4c0aea9eb0 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs @@ -6,6 +6,7 @@ module Test.Consensus.Genesis.Tests.DensityDisconnect (tests) where +import Cardano.Ledger.BaseTypes (unNonZero) import Cardano.Slotting.Slot (SlotNo (unSlotNo), WithOrigin (..)) import Control.Exception (fromException) import Control.Monad.Class.MonadTime.SI (Time (..)) @@ -116,7 +117,7 @@ staticCandidates GenesisTest {gtSecurityParam, gtGenesisWindow, gtBlockTree} = selections = selection <$> branches selection branch = - AF.takeOldest (AF.length (btbPrefix branch) + fromIntegral (maxRollbacks gtSecurityParam)) (btbFull branch) + AF.takeOldest (AF.length (btbPrefix branch) + fromIntegral (unNonZero $ maxRollbacks gtSecurityParam)) (btbFull branch) tips = branchTip <$> Map.fromList candidates @@ -402,7 +403,7 @@ evolveBranches EvolvingPeers {k, sgen, peers = initialPeers, fullTree} = -- Take k blocks after the immutable tip on the first fork. selection imm Peer {value = EvolvingPeer {candidate}} = case AF.splitAfterPoint candidate imm of - Just (_, s) -> AF.takeOldest (fromIntegral k') s + Just (_, s) -> AF.takeOldest (fromIntegral $ unNonZero k') s Nothing -> error "immutable tip not on candidate" ids = toList (getPeerIds ps) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs index c59f9b27ba..00c387547d 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs @@ -16,6 +16,7 @@ module Test.Consensus.HardFork.Combinator (tests) where +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import qualified Data.Map.Strict as Map import Data.SOP.Counting import Data.SOP.InPairs (RequiringBoth (..)) @@ -94,7 +95,7 @@ data TestSetup = TestSetup { instance Arbitrary TestSetup where arbitrary = do testSetupEpochSize <- abM $ EpochSize <$> choose (1, 10) - testSetupK <- SecurityParam <$> choose (2, 10) + testSetupK <- SecurityParam <$> choose (2, 10) `suchThatMap` nonZero -- TODO why does k=1 cause the nodes to only forge in the first epoch? testSetupTxSlot <- SlotNo <$> choose (0, 9) @@ -147,7 +148,7 @@ prop_simple_hfc_convergence testSetup@TestSetup{..} = <*> testSetupSlotLength <*> AB (History.StandardSafeZone (safeFromTipA k)) (safeZoneB k) - <*> pure (GenesisWindow ((maxRollbacks k) * 2)) + <*> pure (GenesisWindow ((unNonZero $ maxRollbacks k) * 2)) shape :: History.Shape '[BlockA, BlockB] shape = History.Shape $ exactlyTwo eraParamsA eraParamsB diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs index 4aa3b65074..eac9077de8 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs @@ -38,15 +38,15 @@ module Test.Consensus.HardFork.Combinator.A ( , TxId (..) ) where +import Cardano.Ledger.BaseTypes.NonZero import Cardano.Slotting.EpochInfo import Codec.Serialise import Control.Monad (guard) -import Control.Monad.Except (runExcept) import qualified Data.Binary as B import Data.ByteString as Strict import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Short as SBS -import Data.Functor.Identity (Identity) +import Data.Functor.Identity import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Set (Set) @@ -81,7 +81,7 @@ import Ouroboros.Consensus.Node.Serialisation import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo) import Ouroboros.Consensus.Storage.Serialisation -import Ouroboros.Consensus.Util (repeatedlyM, (..:), (.:)) +import Ouroboros.Consensus.Util (repeatedlyM, (.:)) import Ouroboros.Consensus.Util.Condense import Ouroboros.Consensus.Util.Orphans () import Ouroboros.Network.Block (Serialised, unwrapCBORinCBOR, @@ -197,6 +197,17 @@ data PartialLedgerConfigA = LCfgA { , lcfgA_forgeTxs :: Map SlotNo [GenTx BlockA] } deriving NoThunks via OnlyCheckWhnfNamed "LCfgA" PartialLedgerConfigA + deriving Generic + deriving Serialise + +deriving newtype instance Serialise SecurityParam +instance (HasZero a, Serialise a) => Serialise (NonZero a) where + encode = encode . unNonZero + decode = do + a <- decode + case nonZero a of + Nothing -> fail "Expected non zero but found zero!" + Just a' -> pure a' type instance LedgerCfg (LedgerState BlockA) = (EpochInfo Identity, PartialLedgerConfigA) @@ -213,10 +224,10 @@ instance IsLedger (LedgerState BlockA) where type AuxLedgerEvent (LedgerState BlockA) = VoidLedgerEvent (LedgerState BlockA) - applyChainTickLedgerResult _ _ = pureLedgerResult . TickedLedgerStateA + applyChainTickLedgerResult _ _ _ = pureLedgerResult . TickedLedgerStateA instance ApplyBlock (LedgerState BlockA) BlockA where - applyBlockLedgerResult cfg blk = + applyBlockLedgerResultWithValidation _ _ cfg blk = fmap (pureLedgerResult . setTip) . repeatedlyM (fmap fst .: applyTx cfg DoNotIntervene (blockSlot blk)) @@ -225,13 +236,9 @@ instance ApplyBlock (LedgerState BlockA) BlockA where setTip :: TickedLedgerState BlockA -> LedgerState BlockA setTip (TickedLedgerStateA st) = st { lgrA_tip = blockPoint blk } + applyBlockLedgerResult = defaultApplyBlockLedgerResult reapplyBlockLedgerResult = - dontExpectError ..: applyBlockLedgerResult - where - dontExpectError :: Except a b -> b - dontExpectError mb = case runExcept mb of - Left _ -> error "reapplyBlockLedgerResult: unexpected error" - Right b -> b + defaultReapplyBlockLedgerResult absurd instance UpdateLedger BlockA @@ -296,13 +303,13 @@ blockForgingA = BlockForging { -- | See 'Ouroboros.Consensus.HardFork.History.EraParams.safeFromTip' safeFromTipA :: SecurityParam -> Word64 -safeFromTipA (SecurityParam k) = k +safeFromTipA (SecurityParam k) = unNonZero k -- | This mock ledger assumes that every node is honest and online, every slot -- has a single leader, and ever message arrives before the next slot. So a run -- of @k@ slots is guaranteed to extend the chain by @k@ blocks. stabilityWindowA :: SecurityParam -> Word64 -stabilityWindowA (SecurityParam k) = k +stabilityWindowA (SecurityParam k) = unNonZero k data instance GenTx BlockA = TxA { txA_id :: TxId (GenTx BlockA) @@ -519,6 +526,17 @@ instance HasBinaryBlockInfo BlockA where } +instance SerialiseNodeToClient BlockA PartialLedgerConfigA + +-- NOTE: we will never use BlockA as a SingleEraBlock, however in order to fulfill the +-- constraints we need to be able to provide this instance. +-- +-- We could follow what is done for Shelley and serialise a fixed EpochInfo, but it is +-- not worth the effort, we will never call these methods. +instance SerialiseNodeToClient BlockA (EpochInfo Identity, PartialLedgerConfigA) where + encodeNodeToClient = error "BlockA being used as a SingleEraBlock" + decodeNodeToClient = error "BlockA being used as a SingleEraBlock" + instance SerialiseConstraintsHFC BlockA instance SerialiseDiskConstraints BlockA instance SerialiseNodeToClientConstraints BlockA diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs index 7c45c64137..4791ffe8dd 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs @@ -34,6 +34,7 @@ module Test.Consensus.HardFork.Combinator.B ( , TxId (..) ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Codec.Serialise import qualified Data.Binary as B import qualified Data.ByteString as Strict @@ -166,7 +167,9 @@ data instance LedgerState BlockB = LgrB { deriving (Show, Eq, Generic, Serialise) deriving NoThunks via OnlyCheckWhnfNamed "LgrB" (LedgerState BlockB) -type instance LedgerCfg (LedgerState BlockB) = () +type PartialLedgerCfgB = () + +type instance LedgerCfg (LedgerState BlockB) = PartialLedgerCfgB -- | Ticking has no state on the B ledger state newtype instance Ticked (LedgerState BlockB) = TickedLedgerStateB { @@ -186,11 +189,12 @@ instance IsLedger (LedgerState BlockB) where type AuxLedgerEvent (LedgerState BlockB) = VoidLedgerEvent (LedgerState BlockB) - applyChainTickLedgerResult _ _ = pureLedgerResult . TickedLedgerStateB + applyChainTickLedgerResult _ _ _ = pureLedgerResult . TickedLedgerStateB instance ApplyBlock (LedgerState BlockB) BlockB where - applyBlockLedgerResult = \_ b _ -> return $ pureLedgerResult $ LgrB (blockPoint b) - reapplyBlockLedgerResult = \_ b _ -> pureLedgerResult $ LgrB (blockPoint b) + applyBlockLedgerResultWithValidation = \_ _ _ b _ -> return $ pureLedgerResult $ LgrB (blockPoint b) + applyBlockLedgerResult = defaultApplyBlockLedgerResult + reapplyBlockLedgerResult = defaultReapplyBlockLedgerResult absurd instance UpdateLedger BlockB @@ -248,7 +252,7 @@ blockForgingB = BlockForging { -- safezone. However, we give it a default one anyway, since that makes the -- test more realistic. safeZoneB :: SecurityParam -> History.SafeZone -safeZoneB (SecurityParam k) = History.StandardSafeZone k +safeZoneB (SecurityParam k) = History.StandardSafeZone $ unNonZero k data instance GenTx BlockB deriving (Show, Eq, Generic, NoThunks, Serialise) @@ -434,6 +438,10 @@ instance SerialiseNodeToClient BlockB (GenTx BlockB) instance SerialiseNodeToClient BlockB (GenTxId BlockB) instance SerialiseNodeToClient BlockB SlotNo +instance SerialiseNodeToClient BlockB PartialLedgerCfgB where + encodeNodeToClient _ _ = encode + decodeNodeToClient _ _ = decode + instance SerialiseNodeToClient BlockB Void where encodeNodeToClient _ _ = absurd decodeNodeToClient _ _ = fail "no ApplyTxErr to be decoded" diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Tests/Rollback.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Tests/Rollback.hs index b45ef7447f..c75732ecce 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Tests/Rollback.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Tests/Rollback.hs @@ -5,6 +5,7 @@ module Test.Consensus.PeerSimulator.Tests.Rollback (tests) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Monad.Class.MonadTime.SI (Time (Time)) import Ouroboros.Consensus.Block (ChainHash (..), Header) import Ouroboros.Consensus.Config.SecurityParam @@ -52,7 +53,7 @@ prop_rollback = do -- TODO: Trim block tree, the rollback schedule does not use all of it let cls = classifiers gt if allAdversariesForecastable cls && allAdversariesKPlus1InForecast cls - then pure gt {gtSchedule = rollbackSchedule (fromIntegral (maxRollbacks gtSecurityParam)) gtBlockTree} + then pure gt {gtSchedule = rollbackSchedule (fromIntegral (unNonZero $ maxRollbacks gtSecurityParam)) gtBlockTree} else discard) defaultSchedulerConfig @@ -70,7 +71,7 @@ prop_cannotRollback = forAllGenesisTest (do gt@GenesisTest{gtSecurityParam, gtBlockTree} <- genChains (pure 1) - pure gt {gtSchedule = rollbackSchedule (fromIntegral (maxRollbacks gtSecurityParam + 1)) gtBlockTree}) + pure gt {gtSchedule = rollbackSchedule (fromIntegral (unNonZero $ maxRollbacks gtSecurityParam) + 1) gtBlockTree}) defaultSchedulerConfig diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PointSchedule.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PointSchedule.hs index 179efa1f3b..399d9a3397 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PointSchedule.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PointSchedule.hs @@ -47,6 +47,7 @@ module Test.Consensus.PointSchedule ( , uniformPoints ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Cardano.Slotting.Time (SlotLength) import Control.Monad (replicateM) import Control.Monad.Class.MonadTime.SI (Time (Time), addTime, @@ -408,7 +409,7 @@ uniformPointsWithExtraHonestPeersAndDowntime g = do let - kSlot = withOrigin 0 (fromIntegral . unSlotNo) (AF.headSlot (AF.takeOldest (fromIntegral k) btTrunk)) + kSlot = withOrigin 0 (fromIntegral . unSlotNo) (AF.headSlot (AF.takeOldest (fromIntegral $ unNonZero k) btTrunk)) midSlot = (AF.length btTrunk) `div` 2 lowerBound = max kSlot midSlot pauseSlot <- SlotNo . fromIntegral <$> Random.uniformRM (lowerBound, AF.length btTrunk - 1) g diff --git a/ouroboros-consensus-diffusion/test/infra-test/Test/ThreadNet/Util/Tests.hs b/ouroboros-consensus-diffusion/test/infra-test/Test/ThreadNet/Util/Tests.hs index 90f8afeec5..3ed0408a26 100644 --- a/ouroboros-consensus-diffusion/test/infra-test/Test/ThreadNet/Util/Tests.hs +++ b/ouroboros-consensus-diffusion/test/infra-test/Test/ThreadNet/Util/Tests.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} module Test.ThreadNet.Util.Tests (tests) where +import Cardano.Ledger.BaseTypes (knownNonZeroBounded) import Ouroboros.Consensus.Config.SecurityParam import Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..)) import Test.Tasty @@ -15,7 +18,7 @@ tests = testGroup "Test.ThreadNet.Util.Tests" $ prop_roundRobin_forkLength securityParam ] where - securityParam = SecurityParam 5 + securityParam = SecurityParam $ knownNonZeroBounded @5 -- | A round-robin schedule should reach consensus prop_roundRobin_forkLength :: 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 efabbbf3f1..3fffdc5ba2 100644 --- a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs +++ b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs @@ -5,6 +5,7 @@ module Test.ThreadNet.BFT (tests) where +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import Data.Constraint import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime @@ -40,7 +41,7 @@ data TestSetup = TestSetup instance Arbitrary TestSetup where arbitrary = do -- TODO k > 1 as a workaround for Issue #1511. - k <- SecurityParam <$> choose (2, 10) + k <- SecurityParam <$> choose (2, 10) `suchThatMap` nonZero testConfig <- arbitrary let TestConfig{numCoreNodes, numSlots} = testConfig @@ -87,7 +88,7 @@ prop_simple_bft_convergence TestSetup { forgeEbbEnv = Nothing , future = singleEraFuture slotLength - (EpochSize $ maxRollbacks k * 10) + (EpochSize $ unNonZero (maxRollbacks k) * 10) -- The mock ledger doesn't really care, and neither does BFT. We -- stick with the common @k * 10@ size for now. , messageDelay = noCalcMessageDelay diff --git a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/LeaderSchedule.hs b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/LeaderSchedule.hs index ea64122cbb..1d325347cb 100644 --- a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/LeaderSchedule.hs +++ b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/LeaderSchedule.hs @@ -3,6 +3,7 @@ module Test.ThreadNet.LeaderSchedule (tests) where +import Cardano.Ledger.BaseTypes (nonZero) import Control.Monad (replicateM) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -47,7 +48,7 @@ data TestSetup = TestSetup instance Arbitrary TestSetup where arbitrary = do -- TODO k > 1 as a workaround for Issue #1511. - k <- SecurityParam <$> choose (2, 10) + k <- SecurityParam <$> choose (2, 10) `suchThatMap` nonZero epochSize <- EpochSize <$> choose (1, 10) slotLength <- arbitrary diff --git a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/PBFT.hs b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/PBFT.hs index f96de2ea98..4d8a4aa5ee 100644 --- a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/PBFT.hs +++ b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/PBFT.hs @@ -4,6 +4,7 @@ module Test.ThreadNet.PBFT (tests) where +import Cardano.Ledger.BaseTypes (nonZero, unNonZero) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Ouroboros.Consensus.Block @@ -46,7 +47,7 @@ data TestSetup = TestSetup instance Arbitrary TestSetup where arbitrary = do - k <- SecurityParam <$> choose (1, 10) + k <- SecurityParam <$> choose (1, 10) `suchThatMap` nonZero testConfig <- arbitrary let TestConfig{numCoreNodes, numSlots} = testConfig @@ -93,7 +94,7 @@ prop_simple_pbft_convergence TestSetup { forgeEbbEnv = Nothing , future = singleEraFuture slotLength - (EpochSize $ maxRollbacks k * 10) + (EpochSize $ unNonZero (maxRollbacks k) * 10) -- The mock ledger doesn't really care, and neither does PBFT. We -- stick with the common @k * 10@ size for now. , messageDelay = noCalcMessageDelay diff --git a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/Praos.hs b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/Praos.hs index d65cddcc3a..eec86b15ff 100644 --- a/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/Praos.hs +++ b/ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/Praos.hs @@ -3,6 +3,7 @@ module Test.ThreadNet.Praos (tests) where +import Cardano.Ledger.BaseTypes (nonZero) import Control.Monad (replicateM) import qualified Data.Map.Strict as Map import Data.Word (Word64) @@ -68,7 +69,7 @@ genEvolvingStake epochSize TestConfig {numSlots, numCoreNodes} = do instance Arbitrary TestSetup where arbitrary = do -- TODO k > 1 as a workaround for Issue #1511. - k <- SecurityParam <$> choose (2, 10) + k <- SecurityParam <$> choose (2, 10) `suchThatMap` nonZero epochSize <- EpochSize <$> choose (1, 10) slotLength <- arbitrary diff --git a/ouroboros-consensus-protocol/changelog.d/20250304_135501_jasataco_release_10_3.md b/ouroboros-consensus-protocol/changelog.d/20250304_135501_jasataco_release_10_3.md new file mode 100644 index 0000000000..0002d40343 --- /dev/null +++ b/ouroboros-consensus-protocol/changelog.d/20250304_135501_jasataco_release_10_3.md @@ -0,0 +1,23 @@ + + + + +### Breaking + +- Adapt to Ledger's Crypto monomorphization. Many types and fields have lost their `c/crypto` type variable as now `StandardCrypto` is used by the Ledger everywhere. +- `KESKey` now uses `UnsoundPureSignKeyKES` in preparation of the `kes-agent` feature. + diff --git a/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal b/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal index 9725c76e0b..46cf4d92d3 100644 --- a/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal +++ b/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal @@ -66,7 +66,7 @@ library base >=4.14 && <4.21, bytestring, cardano-binary, - cardano-crypto-class, + cardano-crypto-class ^>=2.2, cardano-ledger-binary, cardano-ledger-core, cardano-ledger-shelley, @@ -94,9 +94,9 @@ library unstable-protocol-testlib base, base16-bytestring, bytestring, - cardano-crypto-class, - cardano-crypto-praos, - cardano-crypto-tests, + cardano-crypto-class ^>=2.2, + cardano-crypto-praos ^>=2.2, + cardano-crypto-tests ^>=2.2, cardano-ledger-binary, cardano-ledger-core, cardano-ledger-shelley-test, @@ -117,9 +117,10 @@ test-suite protocol-test build-depends: QuickCheck, base, - cardano-crypto-class, + cardano-crypto-class ^>=2.2, cardano-ledger-binary:testlib, - cardano-ledger-core ^>=1.16, + cardano-ledger-core ^>=1.17, + cardano-protocol-tpraos ^>=1.4, containers, ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib}, ouroboros-consensus-protocol, diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Ledger/HotKey.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Ledger/HotKey.hs index 8a46088450..eb29d58b9d 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Ledger/HotKey.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Ledger/HotKey.hs @@ -24,9 +24,9 @@ module Ouroboros.Consensus.Protocol.Ledger.HotKey ( , sign ) where +import qualified Cardano.Crypto.KES as KES import qualified Cardano.Crypto.KES as Relative (Period) -import Cardano.Ledger.Crypto (Crypto) -import qualified Cardano.Ledger.Keys as SL +import Cardano.Protocol.Crypto (Crypto (..)) import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..)) import Data.Word (Word64) import GHC.Generics (Generic) @@ -135,20 +135,20 @@ data HotKey c m = HotKey { -- PRECONDITION: the key is not poisoned. -- -- POSTCONDITION: the signature is in normal form. - , sign_ :: forall toSign. (SL.KESignable c toSign, HasCallStack) - => toSign -> m (SL.SignedKES c toSign) + , sign_ :: forall toSign. (KES.Signable (KES c) toSign, HasCallStack) + => toSign -> m (KES.SignedKES (KES c) toSign) } sign :: - (SL.KESignable c toSign, HasCallStack) + (KES.Signable (KES c) toSign, HasCallStack) => HotKey c m - -> toSign -> m (SL.SignedKES c toSign) + -> toSign -> m (KES.SignedKES (KES c) toSign) sign = sign_ -- | The actual KES key, unless it expired, in which case it is replaced by -- \"poison\". data KESKey c = - KESKey !(SL.SignKeyKES c) + KESKey !(KES.UnsoundPureSignKeyKES (KES c)) | KESKeyPoisoned deriving (Generic) @@ -168,7 +168,7 @@ instance Crypto c => NoThunks (KESState c) mkHotKey :: forall m c. (Crypto c, IOLike m) - => SL.SignKeyKES c + => KES.UnsoundPureSignKeyKES (KES c) -> Absolute.KESPeriod -- ^ Start period -> Word64 -- ^ Max KES evolutions -> m (HotKey c m) @@ -184,7 +184,7 @@ mkHotKey initKey startPeriod@(Absolute.KESPeriod start) maxKESEvolutions = do KESKeyPoisoned -> error "trying to sign with a poisoned key" KESKey key -> do let evolution = kesEvolution kesStateInfo - signed = SL.signedKES () evolution toSign key + signed = KES.unsoundPureSignedKES () evolution toSign key -- Force the signature to WHNF (for 'SignedKES', WHNF implies -- NF) so that we don't have any thunks holding on to a key that -- might be destructively updated when evolved. @@ -260,17 +260,18 @@ evolveKey varKESState targetPeriod = modifyMVar varKESState $ \kesState -> do -- | PRECONDITION: -- -- > targetEvolution >= curEvolution - go :: KESEvolution -> KESInfo -> SL.SignKeyKES c -> m (KESState c) + go :: KESEvolution -> KESInfo -> KES.UnsoundPureSignKeyKES (KES c) -> m (KESState c) go targetEvolution info key | targetEvolution <= curEvolution = return $ KESState { kesStateInfo = info, kesStateKey = KESKey key } | otherwise - = case SL.updateKES () key curEvolution of + = case KES.unsoundPureUpdateKES () key curEvolution of -- This cannot happen Nothing -> error "Could not update KES key" Just !key' -> do -- Clear the memory associated with the old key - forgetSignKeyKES key + -- FIXME: Here we want to forget, but it was never implemented + -- forgetSignKeyKES key let info' = info { kesEvolution = curEvolution + 1 } go targetEvolution info' key' where diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs index ce8bcdb08e..9198fa982e 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs @@ -10,7 +10,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} {-# LANGUAGE ViewPatterns #-} @@ -36,20 +35,19 @@ module Ouroboros.Consensus.Protocol.Praos ( import Cardano.Binary (FromCBOR (..), ToCBOR (..), enforceSize) import qualified Cardano.Crypto.DSIGN as DSIGN +import qualified Cardano.Crypto.Hash as Hash import qualified Cardano.Crypto.KES as KES import qualified Cardano.Crypto.VRF as VRF import Cardano.Ledger.BaseTypes (ActiveSlotCoeff, Nonce, (⭒)) import qualified Cardano.Ledger.BaseTypes as SL import qualified Cardano.Ledger.Chain as SL -import Cardano.Ledger.Crypto (Crypto, DSIGN, KES, StandardCrypto, VRF) -import Cardano.Ledger.Hashes (EraIndependentTxBody) -import Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer), +import Cardano.Ledger.Hashes (HASH) +import Cardano.Ledger.Keys (DSIGN, KeyHash, KeyRole (BlockIssuer), VKey (VKey), coerceKeyRole, hashKey) import qualified Cardano.Ledger.Keys as SL -import Cardano.Ledger.PoolDistr - (IndividualPoolStake (IndividualPoolStake)) -import qualified Cardano.Ledger.PoolDistr as SL import Cardano.Ledger.Slot (Duration (Duration), (+*)) +import qualified Cardano.Ledger.State as SL +import Cardano.Protocol.Crypto (Crypto, KES, StandardCrypto, VRF) import qualified Cardano.Protocol.TPraos.API as SL import Cardano.Protocol.TPraos.BHeader (BoundedNatural (bvValue), checkLeaderNatValue, prevHashToNonce) @@ -100,8 +98,7 @@ data Praos c class ( Crypto c, - DSIGN.Signable (DSIGN c) (OCertSignable c), - DSIGN.Signable (DSIGN c) (SL.Hash c EraIndependentTxBody), + DSIGN.Signable DSIGN (OCertSignable c), KES.Signable (KES c) (HeaderBody c), VRF.Signable (VRF c) InputVRF ) => @@ -114,7 +111,7 @@ instance PraosCrypto StandardCrypto -------------------------------------------------------------------------------} data PraosFields c toSign = PraosFields - { praosSignature :: SL.SignedKES c toSign, + { praosSignature :: KES.SignedKES (KES c) toSign, praosToSign :: toSign } deriving (Generic) @@ -131,11 +128,11 @@ deriving instance -- the block signature. data PraosToSign c = PraosToSign { -- | Verification key for the issuer of this block. - praosToSignIssuerVK :: SL.VKey 'SL.BlockIssuer c, - praosToSignVrfVK :: SL.VerKeyVRF c, + praosToSignIssuerVK :: SL.VKey 'SL.BlockIssuer, + praosToSignVrfVK :: VRF.VerKeyVRF (VRF c), -- | Verifiable random value. This is used both to prove the issuer is -- eligible to issue a block, and to contribute to the evolving nonce. - praosToSignVrfRes :: SL.CertifiedVRF c InputVRF, + praosToSignVrfRes :: VRF.CertifiedVRF (VRF c) InputVRF, -- | Lightweight delegation certificate mapping the cold (DSIGN) key to -- the online KES key. praosToSignOCert :: OCert.OCert c @@ -148,7 +145,7 @@ deriving instance PraosCrypto c => Show (PraosToSign c) forgePraosFields :: ( PraosCrypto c, - SL.KESignable c toSign, + KES.Signable (KES c) toSign, Monad m ) => HotKey c m -> @@ -214,7 +211,7 @@ data PraosParams = PraosParams -- | Assembled proof that the issuer has the right to issue a block in the -- selected slot. newtype PraosIsLeader c = PraosIsLeader - { praosIsLeaderVrfRes :: SL.CertifiedVRF c InputVRF + { praosIsLeaderVrfRes :: VRF.CertifiedVRF (VRF c) InputVRF } deriving (Generic) @@ -243,10 +240,10 @@ type PraosValidateView c = Views.HeaderView c -- We track the last slot and the counters for operational certificates, as well -- as a series of nonces which get updated in different ways over the course of -- an epoch. -data PraosState c = PraosState +data PraosState = PraosState { praosStateLastSlot :: !(WithOrigin SlotNo), -- | Operation Certificate counters - praosStateOCertCounters :: !(Map (KeyHash 'BlockIssuer c) Word64), + praosStateOCertCounters :: !(Map (KeyHash 'BlockIssuer) Word64), -- | Evolving nonce praosStateEvolvingNonce :: !Nonce, -- | Candidate nonce @@ -261,15 +258,15 @@ data PraosState c = PraosState } deriving (Generic, Show, Eq) -instance PraosCrypto c => NoThunks (PraosState c) +instance NoThunks PraosState -instance PraosCrypto c => ToCBOR (PraosState c) where +instance ToCBOR PraosState where toCBOR = encode -instance PraosCrypto c => FromCBOR (PraosState c) where +instance FromCBOR PraosState where fromCBOR = decode -instance PraosCrypto c => Serialise (PraosState c) where +instance Serialise PraosState where encode PraosState { praosStateLastSlot, @@ -307,19 +304,19 @@ instance PraosCrypto c => Serialise (PraosState c) where <*> fromCBOR <*> fromCBOR -data instance Ticked (PraosState c) = TickedPraosState - { tickedPraosStateChainDepState :: PraosState c, - tickedPraosStateLedgerView :: Views.LedgerView c +data instance Ticked PraosState = TickedPraosState + { tickedPraosStateChainDepState :: PraosState, + tickedPraosStateLedgerView :: Views.LedgerView } -- | Errors which we might encounter data PraosValidationErr c = VRFKeyUnknown - !(KeyHash SL.StakePool c) -- unknown VRF keyhash (not registered) + !(KeyHash SL.StakePool) -- unknown VRF keyhash (not registered) | VRFKeyWrongVRFKey - !(KeyHash SL.StakePool c) -- KeyHash of block issuer - !(SL.Hash c (SL.VerKeyVRF c)) -- VRF KeyHash registered with stake pool - !(SL.Hash c (SL.VerKeyVRF c)) -- VRF KeyHash from Header + !(KeyHash SL.StakePool) -- KeyHash of block issuer + !(Hash.Hash HASH (VRF.VerKeyVRF (VRF c))) -- VRF KeyHash registered with stake pool + !(Hash.Hash HASH (VRF.VerKeyVRF (VRF c))) -- VRF KeyHash from Header | VRFKeyBadProof !SlotNo -- Slot used for VRF calculation !Nonce -- Epoch nonce used for VRF calculation @@ -350,7 +347,7 @@ data PraosValidationErr c !Word64 -- max KES evolutions !String -- error message given by Consensus Layer | NoCounterForKeyHashOCERT - !(KeyHash 'BlockIssuer c) -- stake pool key hash + !(KeyHash 'BlockIssuer) -- stake pool key hash deriving (Generic) deriving instance PraosCrypto c => Eq (PraosValidationErr c) @@ -360,11 +357,11 @@ deriving instance PraosCrypto c => NoThunks (PraosValidationErr c) deriving instance PraosCrypto c => Show (PraosValidationErr c) instance PraosCrypto c => ConsensusProtocol (Praos c) where - type ChainDepState (Praos c) = PraosState c + type ChainDepState (Praos c) = PraosState type IsLeader (Praos c) = PraosIsLeader c type CanBeLeader (Praos c) = PraosCanBeLeader c type SelectView (Praos c) = PraosChainSelectView c - type LedgerView (Praos c) = Views.LedgerView c + type LedgerView (Praos c) = Views.LedgerView type ValidationErr (Praos c) = PraosValidationErr c type ValidateView (Praos c) = PraosValidateView c @@ -500,10 +497,9 @@ instance PraosCrypto c => ConsensusProtocol (Praos c) where -- | Check whether this node meets the leader threshold to issue a block. meetsLeaderThreshold :: forall c. - PraosCrypto c => ConsensusConfig (Praos c) -> LedgerView (Praos c) -> - SL.KeyHash 'SL.StakePool c -> + SL.KeyHash 'SL.StakePool -> VRF.CertifiedVRF (VRF c) InputVRF -> Bool meetsLeaderThreshold @@ -526,7 +522,7 @@ validateVRFSignature :: ( PraosCrypto c ) => Nonce -> - Views.LedgerView c -> + Views.LedgerView -> ActiveSlotCoeff -> Views.HeaderView c -> Except (PraosValidationErr c) () @@ -539,14 +535,14 @@ doValidateVRFSignature :: forall c. PraosCrypto c => Nonce -> - Map (KeyHash SL.StakePool c) (IndividualPoolStake c) -> + Map (KeyHash SL.StakePool) SL.IndividualPoolStake -> ActiveSlotCoeff -> Views.HeaderView c -> Except (PraosValidationErr c) () doValidateVRFSignature eta0 pd f b = do case Map.lookup hk pd of Nothing -> throwError $ VRFKeyUnknown hk - Just (IndividualPoolStake sigma _totalPoolStake vrfHK) -> do + Just (SL.IndividualPoolStake sigma _totalPoolStake vrfHK) -> do let vrfHKStake = SL.fromVRFVerKeyHash vrfHK vrfHKBlock = VRF.hashVerKeyVRF vrfK vrfHKStake == vrfHKBlock @@ -570,7 +566,7 @@ validateKESSignature :: PraosCrypto c => ConsensusConfig (Praos c) -> LedgerView (Praos c) -> - Map (KeyHash 'BlockIssuer c) Word64 -> + Map (KeyHash 'BlockIssuer) Word64 -> Views.HeaderView c -> Except (PraosValidationErr c) () validateKESSignature @@ -588,8 +584,8 @@ doValidateKESSignature :: PraosCrypto c => Word64 -> Word64 -> - Map (KeyHash SL.StakePool c) (IndividualPoolStake c) -> - Map (KeyHash BlockIssuer c) Word64 -> + Map (KeyHash SL.StakePool) SL.IndividualPoolStake -> + Map (KeyHash BlockIssuer) Word64 -> Views.HeaderView c -> Except (PraosValidationErr c) () doValidateKESSignature praosMaxKESEvo praosSlotsPerKESPeriod stakeDistribution ocertCounters b = @@ -718,25 +714,15 @@ instance PraosCrypto c => PraosProtocolSupportsNode (Praos c) where -- - They share the same DSIGN verification keys -- - They share the same VRF verification keys instance - ( c1 ~ c2 ) => - TranslateProto (TPraos c1) (Praos c2) + TranslateProto (TPraos c) (Praos c) where translateLedgerView _ SL.LedgerView {SL.lvPoolDistr, SL.lvChainChecks} = Views.LedgerView - { Views.lvPoolDistr = coercePoolDistr lvPoolDistr, + { Views.lvPoolDistr = lvPoolDistr, Views.lvMaxHeaderSize = SL.ccMaxBHSize lvChainChecks, Views.lvMaxBodySize = SL.ccMaxBBSize lvChainChecks, Views.lvProtocolVersion = SL.ccProtocolVersion lvChainChecks } - where - coercePoolDistr :: SL.PoolDistr c1 -> SL.PoolDistr c2 - coercePoolDistr (SL.PoolDistr m totalActiveStake) = - SL.PoolDistr - (Map.mapKeysMonotonic coerce (Map.map coerceIndividualPoolStake m)) - totalActiveStake - coerceIndividualPoolStake :: SL.IndividualPoolStake c1 -> SL.IndividualPoolStake c2 - coerceIndividualPoolStake (SL.IndividualPoolStake stake totalStake vrf) = - SL.IndividualPoolStake stake totalStake (coerce vrf) translateChainDepState _ tpState = PraosState diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs index 94241bc6c1..210457ea89 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs @@ -20,9 +20,9 @@ module Ouroboros.Consensus.Protocol.Praos.Common ( import qualified Cardano.Crypto.VRF as VRF import Cardano.Ledger.BaseTypes (Nonce) import qualified Cardano.Ledger.BaseTypes as SL -import Cardano.Ledger.Crypto (Crypto, VRF) import Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer)) import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (Crypto, VRF) import qualified Cardano.Protocol.TPraos.OCert as OCert import Cardano.Slotting.Block (BlockNo) import Cardano.Slotting.Slot (SlotNo) @@ -64,7 +64,7 @@ newtype MaxMajorProtVer = MaxMajorProtVer data PraosChainSelectView c = PraosChainSelectView { csvChainLength :: BlockNo, csvSlotNo :: SlotNo, - csvIssuer :: SL.VKey 'SL.BlockIssuer c, + csvIssuer :: SL.VKey 'SL.BlockIssuer, csvIssueNo :: Word64, csvTieBreakVRF :: VRF.OutputVRF (VRF c) } @@ -100,8 +100,7 @@ data VRFTiebreakerFlavor = -- Used to implement the 'Ord' and 'ChainOrder' instances for Praos. comparePraos :: - Crypto c - => VRFTiebreakerFlavor + VRFTiebreakerFlavor -> PraosChainSelectView c -> PraosChainSelectView c -> Ordering @@ -249,8 +248,8 @@ data PraosCanBeLeader c = PraosCanBeLeader -- genesis stakeholder delegate cold key) to the online KES key. praosCanBeLeaderOpCert :: !(OCert.OCert c), -- | Stake pool cold key or genesis stakeholder delegate cold key. - praosCanBeLeaderColdVerKey :: !(SL.VKey 'SL.BlockIssuer c), - praosCanBeLeaderSignKeyVRF :: !(SL.SignKeyVRF c) + praosCanBeLeaderColdVerKey :: !(SL.VKey 'SL.BlockIssuer), + praosCanBeLeaderSignKeyVRF :: !(VRF.SignKeyVRF (VRF c)) } deriving (Generic) @@ -279,4 +278,4 @@ class ConsensusProtocol p => PraosProtocolSupportsNode p where getPraosNonces :: proxy p -> ChainDepState p -> PraosNonces - getOpCertCounters :: proxy p -> ChainDepState p -> Map (KeyHash 'BlockIssuer (PraosProtocolSupportsNodeCrypto p)) Word64 + getOpCertCounters :: proxy p -> ChainDepState p -> Map (KeyHash 'BlockIssuer) Word64 diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Header.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Header.hs index 8210821e3f..3d50903958 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Header.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Header.hs @@ -31,18 +31,19 @@ import qualified Cardano.Crypto.Hash as Hash import qualified Cardano.Crypto.KES as KES import Cardano.Crypto.Util (SignableRepresentation (getSignableRepresentation)) +import qualified Cardano.Crypto.VRF as VRF import Cardano.Ledger.BaseTypes (ProtVer (pvMajor)) import Cardano.Ledger.Binary (Annotator (..), CBORGroup (unCBORGroup), DecCBOR (decCBOR), EncCBOR (..), ToCBOR (..), encodedSigKESSizeExpr, serialize', withSlice) import Cardano.Ledger.Binary.Coders +import Cardano.Ledger.Binary.Crypto (decodeSignedKES, decodeVerKeyVRF, + encodeSignedKES, encodeVerKeyVRF) import qualified Cardano.Ledger.Binary.Plain as Plain -import Cardano.Ledger.Crypto (Crypto (HASH)) import Cardano.Ledger.Hashes (EraIndependentBlockBody, - EraIndependentBlockHeader) -import Cardano.Ledger.Keys (CertifiedVRF, Hash, KeyRole (BlockIssuer), - SignedKES, VKey, VerKeyVRF, decodeSignedKES, - decodeVerKeyVRF, encodeSignedKES, encodeVerKeyVRF) + EraIndependentBlockHeader, HASH) +import Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey) +import Cardano.Protocol.Crypto (Crypto, KES, VRF) import Cardano.Protocol.TPraos.BHeader (PrevHash) import Cardano.Protocol.TPraos.OCert (OCert) import Cardano.Slotting.Block (BlockNo) @@ -62,17 +63,17 @@ data HeaderBody crypto = HeaderBody -- | block slot hbSlotNo :: !SlotNo, -- | Hash of the previous block header - hbPrev :: !(PrevHash crypto), + hbPrev :: !PrevHash, -- | verification key of block issuer - hbVk :: !(VKey 'BlockIssuer crypto), + hbVk :: !(VKey 'BlockIssuer), -- | VRF verification key for block issuer - hbVrfVk :: !(VerKeyVRF crypto), + hbVrfVk :: !(VRF.VerKeyVRF (VRF crypto)), -- | Certified VRF value - hbVrfRes :: !(CertifiedVRF crypto InputVRF), + hbVrfRes :: !(VRF.CertifiedVRF (VRF crypto) InputVRF), -- | Size of the block body hbBodySize :: !Word32, -- | Hash of block body - hbBodyHash :: !(Hash crypto EraIndependentBlockBody), + hbBodyHash :: !(Hash.Hash HASH EraIndependentBlockBody), -- | operational certificate hbOCert :: !(OCert crypto), -- | protocol version @@ -96,7 +97,7 @@ instance data HeaderRaw crypto = HeaderRaw { headerRawBody :: !(HeaderBody crypto), - headerRawSig :: !(SignedKES crypto (HeaderBody crypto)) + headerRawSig :: !(KES.SignedKES (KES crypto) (HeaderBody crypto)) } deriving (Show, Generic) @@ -124,7 +125,7 @@ data Header crypto = HeaderConstr pattern Header :: Crypto crypto => HeaderBody crypto -> - SignedKES crypto (HeaderBody crypto) -> + KES.SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto pattern Header {headerBody, headerSig} <- HeaderConstr { @@ -155,7 +156,7 @@ headerSize (HeaderConstr _ bytes) = BS.length bytes headerHash :: Crypto crypto => Header crypto -> - Hash.Hash (HASH crypto) EraIndependentBlockHeader + Hash.Hash HASH EraIndependentBlockHeader headerHash = Hash.castHash . Hash.hashWithSerialiser toCBOR -------------------------------------------------------------------------------- @@ -201,7 +202,7 @@ instance Crypto crypto => DecCBOR (HeaderBody crypto) where From) + proxy c -> SVRFUsage v -> CertifiedVRF (VRF c) InputVRF -> - Hash (HASH c) (VRFResult v) + Hash HASH (VRFResult v) hashVRF _ use certVRF = let vrfOutputAsBytes = getOutputVRFBytes $ certifiedOutput certVRF in case use of @@ -101,20 +101,18 @@ hashVRF _ use certVRF = -- hash. See section 4.1 of the linked paper for details. vrfLeaderValue :: forall c proxy. - Crypto c => proxy c -> CertifiedVRF (VRF c) InputVRF -> BoundedNatural vrfLeaderValue p cvrf = assertBoundedNatural - ((2 :: Natural) ^ (8 * sizeHash (Proxy @(HASH c)))) + ((2 :: Natural) ^ (8 * sizeHash (Proxy @HASH))) (bytesToNatural . hashToBytes $ hashVRF p SVRFLeader cvrf) -- | Range-extend a VRF output to be used for the evolving nonce. See section -- 4.1 of the linked paper for details. vrfNonceValue :: forall c proxy. - Crypto c => proxy c -> CertifiedVRF (VRF c) InputVRF -> Nonce diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Views.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Views.hs index a28960bb30..e2d75f595b 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Views.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Views.hs @@ -8,9 +8,9 @@ module Ouroboros.Consensus.Protocol.Praos.Views ( import Cardano.Crypto.KES (SignedKES) import Cardano.Crypto.VRF (CertifiedVRF, VRFAlgorithm (VerKeyVRF)) import Cardano.Ledger.BaseTypes (ProtVer) -import Cardano.Ledger.Crypto (KES, VRF) import Cardano.Ledger.Keys (KeyRole (BlockIssuer), VKey) import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (KES, VRF) import Cardano.Protocol.TPraos.BHeader (PrevHash) import Cardano.Protocol.TPraos.OCert (OCert) import Cardano.Slotting.Slot (SlotNo) @@ -21,9 +21,9 @@ import Ouroboros.Consensus.Protocol.Praos.VRF (InputVRF) -- | View of the block header required by the Praos protocol. data HeaderView crypto = HeaderView { -- | Hash of the previous block - hvPrevHash :: !(PrevHash crypto), + hvPrevHash :: !PrevHash, -- | verification key of block issuer - hvVK :: !(VKey 'BlockIssuer crypto), + hvVK :: !(VKey 'BlockIssuer), -- | VRF verification key for block issuer hvVrfVK :: !(VerKeyVRF (VRF crypto)), -- | VRF result @@ -38,9 +38,9 @@ data HeaderView crypto = HeaderView hvSignature :: !(SignedKES (KES crypto) (HeaderBody crypto)) } -data LedgerView crypto = LedgerView +data LedgerView = LedgerView { -- | Stake distribution - lvPoolDistr :: SL.PoolDistr crypto, + lvPoolDistr :: SL.PoolDistr, -- | Maximum header size lvMaxHeaderSize :: !Word16, -- | Maximum block body size diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs index 43529217bc..fab03fedc1 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs @@ -39,11 +39,15 @@ module Ouroboros.Consensus.Protocol.TPraos ( ) where import Cardano.Binary (FromCBOR (..), ToCBOR (..), enforceSize) +import qualified Cardano.Crypto.Hash as Hash +import qualified Cardano.Crypto.KES as KES import qualified Cardano.Crypto.VRF as VRF import qualified Cardano.Ledger.BaseTypes as SL (ActiveSlotCoeff, Seed) -import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.BaseTypes.NonZero (nonZeroOr, unNonZero) +import Cardano.Ledger.Hashes (HASH) import qualified Cardano.Ledger.Keys as SL import qualified Cardano.Ledger.Shelley.API as SL +import Cardano.Protocol.Crypto (KES, StandardCrypto, VRF) import qualified Cardano.Protocol.TPraos.API as SL import qualified Cardano.Protocol.TPraos.BHeader as SL import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..)) @@ -80,7 +84,7 @@ import Ouroboros.Consensus.Util.Versioned -------------------------------------------------------------------------------} data TPraosFields c toSign = TPraosFields { - tpraosSignature :: SL.SignedKES c toSign + tpraosSignature :: KES.SignedKES (KES c) toSign , tpraosToSign :: toSign } deriving (Generic) @@ -98,17 +102,17 @@ data TPraosToSign c = TPraosToSign { -- Note that unlike in Classic/BFT where we have a key for the genesis -- delegate on whose behalf we are issuing this block, this key -- corresponds to the stake pool/core node actually forging the block. - tpraosToSignIssuerVK :: SL.VKey 'SL.BlockIssuer c - , tpraosToSignVrfVK :: SL.VerKeyVRF c + tpraosToSignIssuerVK :: SL.VKey 'SL.BlockIssuer + , tpraosToSignVrfVK :: VRF.VerKeyVRF (VRF c) -- | Verifiable result containing the updated nonce value. - , tpraosToSignEta :: SL.CertifiedVRF c SL.Nonce + , tpraosToSignEta :: VRF.CertifiedVRF (VRF c) SL.Nonce -- | Verifiable proof of the leader value, used to determine whether the -- node has the right to issue a block in this slot. -- -- We include a value here even for blocks forged under the BFT -- schedule. It is not required that such a value be verifiable (though -- by default it will be verifiably correct, but unused.) - , tpraosToSignLeader :: SL.CertifiedVRF c Natural + , tpraosToSignLeader :: VRF.CertifiedVRF (VRF c) Natural -- | Lightweight delegation certificate mapping the cold (DSIGN) key to -- the online KES key. , tpraosToSignOCert :: SL.OCert c @@ -120,7 +124,7 @@ deriving instance SL.PraosCrypto c => Show (TPraosToSign c) forgeTPraosFields :: ( SL.PraosCrypto c - , SL.KESignable c toSign + , KES.Signable (KES c) toSign , Monad m ) => HotKey c m @@ -196,7 +200,7 @@ data TPraosParams = TPraosParams { mkTPraosParams :: MaxMajorProtVer -> SL.Nonce -- ^ Initial nonce - -> SL.ShelleyGenesis era + -> SL.ShelleyGenesis -> TPraosParams mkTPraosParams maxMajorPV initialNonce genesis = TPraosParams { tpraosSlotsPerKESPeriod = SL.sgSlotsPerKESPeriod genesis @@ -217,11 +221,11 @@ mkTPraosParams maxMajorPV initialNonce genesis = TPraosParams { -- | Assembled proof that the issuer has the right to issue a block in the -- selected slot. data TPraosIsLeader c = TPraosIsLeader { - tpraosIsLeaderEta :: SL.CertifiedVRF c SL.Nonce - , tpraosIsLeaderProof :: SL.CertifiedVRF c Natural + tpraosIsLeaderEta :: VRF.CertifiedVRF (VRF c) SL.Nonce + , tpraosIsLeaderProof :: VRF.CertifiedVRF (VRF c) Natural -- | When in the overlay schedule (otherwise 'Nothing'), return the hash -- of the VRF verification key in the overlay schedule - , tpraosIsLeaderGenVRFHash :: Maybe (SL.Hash c (SL.VerKeyVRF c)) + , tpraosIsLeaderGenVRFHash :: Maybe (Hash.Hash HASH (VRF.VerKeyVRF (VRF c))) } deriving (Generic) @@ -245,25 +249,25 @@ instance SL.PraosCrypto c => NoThunks (ConsensusConfig (TPraos c)) -- -- In addition to the 'ChainDepState' provided by the ledger, we track the slot -- number of the last applied header. -data TPraosState c = TPraosState { +data TPraosState = TPraosState { tpraosStateLastSlot :: !(WithOrigin SlotNo) - , tpraosStateChainDepState :: !(SL.ChainDepState c) + , tpraosStateChainDepState :: !SL.ChainDepState } deriving (Generic, Show, Eq) -instance SL.PraosCrypto c => NoThunks (TPraosState c) +instance NoThunks TPraosState -- | Version 0 supported rollback, removed in #2575. serialisationFormatVersion1 :: VersionNumber serialisationFormatVersion1 = 1 -instance SL.PraosCrypto c => ToCBOR (TPraosState c) where +instance ToCBOR TPraosState where toCBOR = encode -instance SL.PraosCrypto c => FromCBOR (TPraosState c) where +instance FromCBOR TPraosState where fromCBOR = decode -instance SL.PraosCrypto c => Serialise (TPraosState c) where +instance Serialise TPraosState where encode (TPraosState slot chainDepState) = encodeVersion serialisationFormatVersion1 $ mconcat [ CBOR.encodeListLen 2 @@ -278,17 +282,17 @@ instance SL.PraosCrypto c => Serialise (TPraosState c) where enforceSize "TPraosState" 2 TPraosState <$> fromCBOR <*> fromCBOR -data instance Ticked (TPraosState c) = TickedChainDepState { - tickedTPraosStateChainDepState :: SL.ChainDepState c - , tickedTPraosStateLedgerView :: LedgerView (TPraos c) +data instance Ticked TPraosState = TickedChainDepState { + tickedTPraosStateChainDepState :: SL.ChainDepState + , tickedTPraosStateLedgerView :: SL.LedgerView } instance SL.PraosCrypto c => ConsensusProtocol (TPraos c) where - type ChainDepState (TPraos c) = TPraosState c + type ChainDepState (TPraos c) = TPraosState type IsLeader (TPraos c) = TPraosIsLeader c type CanBeLeader (TPraos c) = PraosCanBeLeader c type SelectView (TPraos c) = PraosChainSelectView c - type LedgerView (TPraos c) = SL.LedgerView c + type LedgerView (TPraos c) = SL.LedgerView type ValidationErr (TPraos c) = SL.ChainTransitionError c type ValidateView (TPraos c) = TPraosValidateView c @@ -392,7 +396,7 @@ mkShelleyGlobals TPraosConfig{..} = SL.Globals { , slotsPerKESPeriod = tpraosSlotsPerKESPeriod , stabilityWindow = SL.computeStabilityWindow k tpraosLeaderF , randomnessStabilisationWindow = SL.computeRandomnessStabilisationWindow k tpraosLeaderF - , securityParameter = k + , securityParameter = nonZeroOr k $ error "The security parameter cannot be zero." , maxKESEvo = tpraosMaxKESEvo , quorum = tpraosQuorum , maxLovelaceSupply = tpraosMaxLovelaceSupply @@ -401,7 +405,7 @@ mkShelleyGlobals TPraosConfig{..} = SL.Globals { , systemStart = tpraosSystemStart } where - SecurityParam k = tpraosSecurityParam + k = unNonZero $ maxRollbacks tpraosSecurityParam TPraosParams{..} = tpraosParams -- | Check whether this node meets the leader threshold to issue a block. @@ -409,8 +413,8 @@ meetsLeaderThreshold :: forall c. SL.PraosCrypto c => ConsensusConfig (TPraos c) -> LedgerView (TPraos c) - -> SL.KeyHash 'SL.StakePool c - -> SL.CertifiedVRF c SL.Seed + -> SL.KeyHash 'SL.StakePool + -> VRF.CertifiedVRF (VRF c) SL.Seed -> Bool meetsLeaderThreshold TPraosConfig { tpraosParams } SL.LedgerView { lvPoolDistr } @@ -449,15 +453,15 @@ data TPraosCannotForge c = -- | We are a genesis delegate, but our VRF key (second argument) does not -- match the registered key for that delegate (first argument). | TPraosCannotForgeWrongVRF - !(SL.Hash c (SL.VerKeyVRF c)) - !(SL.Hash c (SL.VerKeyVRF c)) + !(Hash.Hash HASH (VRF.VerKeyVRF (VRF c))) + !(Hash.Hash HASH (VRF.VerKeyVRF (VRF c))) deriving (Generic) deriving instance SL.PraosCrypto c => Show (TPraosCannotForge c) tpraosCheckCanForge :: ConsensusConfig (TPraos c) - -> SL.Hash c (SL.VerKeyVRF c) + -> Hash.Hash HASH (VRF.VerKeyVRF (VRF c)) -- ^ Precomputed hash of the VRF verification key -> SlotNo -> IsLeader (TPraos c) diff --git a/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Consensus/Protocol/Serialisation/Generators.hs b/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Consensus/Protocol/Serialisation/Generators.hs index 7686d00a04..eb9b7a27ca 100644 --- a/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Consensus/Protocol/Serialisation/Generators.hs +++ b/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Consensus/Protocol/Serialisation/Generators.hs @@ -6,7 +6,7 @@ -- to be semantically correct at all, only structurally correct. module Test.Consensus.Protocol.Serialisation.Generators () where -import Cardano.Crypto.KES (signedKES) +import Cardano.Crypto.KES (unsoundPureSignedKES) import Cardano.Crypto.VRF (evalCertified) import Cardano.Protocol.TPraos.BHeader (HashHeader, PrevHash (..)) import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod), @@ -45,7 +45,7 @@ instance Praos.PraosCrypto c => Arbitrary (HeaderBody c) where <*> (SlotNo <$> choose (1, 10)) <*> oneof [ pure GenesisHash, - BlockHash <$> (arbitrary :: Gen (HashHeader c)) + BlockHash <$> (arbitrary :: Gen HashHeader) ] <*> arbitrary <*> arbitrary @@ -60,10 +60,10 @@ instance Praos.PraosCrypto c => Arbitrary (Header c) where hBody <- arbitrary period <- arbitrary sKey <- arbitrary - let hSig = signedKES () period hBody sKey + let hSig = unsoundPureSignedKES () period hBody sKey pure $ Header hBody hSig -instance Praos.PraosCrypto c => Arbitrary (PraosState c) where +instance Arbitrary PraosState where arbitrary = PraosState <$> oneof [ pure Origin, diff --git a/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Ouroboros/Consensus/Protocol/Praos/Header.hs b/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Ouroboros/Consensus/Protocol/Praos/Header.hs index 09c9f65c6e..c7d38ff6bd 100644 --- a/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Ouroboros/Consensus/Protocol/Praos/Header.hs +++ b/ouroboros-consensus-protocol/src/unstable-protocol-testlib/Test/Ouroboros/Consensus/Protocol/Praos/Header.hs @@ -27,8 +27,6 @@ import Cardano.Crypto.DSIGN import Cardano.Crypto.Hash (Blake2b_256, Hash, hashFromBytes, hashToBytes, hashWith) import qualified Cardano.Crypto.KES as KES -import Cardano.Crypto.KES.Class (genKeyKES, rawDeserialiseSignKeyKES, - rawSerialiseSignKeyKES) import Cardano.Crypto.Seed (mkSeedFromBytes) import Cardano.Crypto.VRF (deriveVerKeyVRF, hashVerKeyVRF, rawDeserialiseSignKeyVRF, rawSerialiseSignKeyVRF) @@ -115,14 +113,14 @@ mutate context header mutation = let Header body _ = header newKESSignKey <- newKESSigningKey <$> gen32Bytes KESPeriod kesPeriod <- genValidKESPeriod (hbSlotNo body) praosSlotsPerKESPeriod - let sig' = KES.signKES () kesPeriod body newKESSignKey + let sig' = KES.unsoundPureSignKES () kesPeriod body newKESSignKey pure (context, Header body (KES.SignedKES sig')) MutateColdKey -> do let Header body _ = header newColdSignKey <- genKeyDSIGN . mkSeedFromBytes <$> gen32Bytes (hbOCert, KESPeriod kesPeriod) <- genCert (hbSlotNo body) context{coldSignKey = newColdSignKey} let newBody = body{hbOCert} - let sig' = KES.signKES () kesPeriod newBody kesSignKey + let sig' = KES.unsoundPureSignKES () kesPeriod newBody kesSignKey pure (context, Header newBody (KES.SignedKES sig')) MutateKESPeriod -> do let Header body _ = header @@ -134,10 +132,10 @@ mutate context header mutation = { hbOCert = oldOCert { ocertKESPeriod = newKESPeriod - , ocertSigma = signedDSIGN @StandardCrypto coldSignKey (OCertSignable ocertVkHot ocertN newKESPeriod) + , ocertSigma = signedDSIGN coldSignKey $ OCertSignable ocertVkHot ocertN newKESPeriod } } - let sig' = KES.signKES () kesPeriod' newBody kesSignKey + let sig' = KES.unsoundPureSignKES () kesPeriod' newBody kesSignKey pure (context, Header newBody (KES.SignedKES sig')) MutateKESPeriodBefore -> do let Header body _ = header @@ -147,7 +145,7 @@ mutate context header mutation = period' = unSlotNo newSlotNo `div` praosSlotsPerKESPeriod hbVrfRes = VRF.evalCertified () rho' vrfSignKey newBody = body{hbSlotNo = newSlotNo, hbVrfRes} - sig' = KES.signKES () (fromIntegral period' - kesPeriod) newBody kesSignKey + sig' = KES.unsoundPureSignKES () (fromIntegral period' - kesPeriod) newBody kesSignKey pure (context, Header newBody (KES.SignedKES sig')) MutateCounterOver1 -> do let poolId = coerce $ hashKey $ VKey $ deriveVerKeyDSIGN coldSignKey @@ -255,23 +253,23 @@ instance Json.FromJSON MutatedHeader where either (fail . show) pure $ decodeFullAnnotator @(Header StandardCrypto) testVersion "Header" decCBOR $ LBS.fromStrict headerBytes -- * Generators -type KESKey = KES.SignKeyKES (KES.Sum6KES Ed25519DSIGN Blake2b_256) +type KESKey = KES.UnsoundPureSignKeyKES (KES.Sum6KES Ed25519DSIGN Blake2b_256) newVRFSigningKey :: ByteString -> (VRF.SignKeyVRF VRF.PraosVRF, VRF.VerKeyVRF VRF.PraosVRF) newVRFSigningKey = VRF.genKeyPairVRF . mkSeedFromBytes newKESSigningKey :: ByteString -> KESKey -newKESSigningKey = genKeyKES . mkSeedFromBytes +newKESSigningKey = KES.unsoundPureGenKeyKES . mkSeedFromBytes data GeneratorContext = GeneratorContext { praosSlotsPerKESPeriod :: !Word64 - , praosMaxKESEvo :: !Word64 - , kesSignKey :: !KESKey - , coldSignKey :: !(SignKeyDSIGN Ed25519DSIGN) - , vrfSignKey :: !(VRF.SignKeyVRF VRF.PraosVRF) - , nonce :: !Nonce - , ocertCounters :: !(Map.Map (KeyHash BlockIssuer StandardCrypto) Word64) - , activeSlotCoeff :: !ActiveSlotCoeff + , praosMaxKESEvo :: !Word64 + , kesSignKey :: !KESKey + , coldSignKey :: !(SignKeyDSIGN Ed25519DSIGN) + , vrfSignKey :: !(VRF.SignKeyVRF VRF.PraosVRF) + , nonce :: !Nonce + , ocertCounters :: !(Map.Map (KeyHash BlockIssuer) Word64) + , activeSlotCoeff :: !ActiveSlotCoeff } deriving (Show) @@ -279,7 +277,8 @@ instance Eq GeneratorContext where a == b = praosSlotsPerKESPeriod a == praosSlotsPerKESPeriod b && praosMaxKESEvo a == praosMaxKESEvo b - && serialize' testVersion (kesSignKey a) == serialize' testVersion (kesSignKey b) + && serialize' testVersion (KES.encodeUnsoundPureSignKeyKES (kesSignKey a)) == + serialize' testVersion (KES.encodeUnsoundPureSignKeyKES (kesSignKey b)) && coldSignKey a == coldSignKey b && vrfSignKey a == vrfSignKey b && nonce a == nonce b @@ -298,7 +297,7 @@ instance Json.ToJSON GeneratorContext where , "activeSlotCoeff" .= activeSlotVal activeSlotCoeff ] where - rawKesSignKey = decodeUtf8 . Base16.encode $ rawSerialiseSignKeyKES kesSignKey + rawKesSignKey = decodeUtf8 . Base16.encode $ KES.rawSerialiseUnsoundPureSignKeyKES kesSignKey rawColdSignKey = decodeUtf8 . Base16.encode $ rawSerialiseSignKeyDSIGN coldSignKey rawVrfSignKey = decodeUtf8 . Base16.encode $ rawSerialiseSignKeyVRF $ skToBatchCompat vrfSignKey rawVrVKeyHash = decodeUtf8 . Base16.encode $ hashToBytes $ hashVerKeyVRF @_ @Blake2b_256 $ deriveVerKeyVRF vrfSignKey @@ -337,7 +336,7 @@ instance Json.FromJSON GeneratorContext where case Base16.decode (encodeUtf8 rawKey) of Left err -> fail err Right keyBytes -> - case rawDeserialiseSignKeyKES keyBytes of + case KES.rawDeserialiseUnsoundPureSignKeyKES keyBytes of Nothing -> fail $ "Invalid KES key bytes: " <> show rawKey Just key -> pure key parseVrfSignKey rawKey = do @@ -376,7 +375,7 @@ generated for the purpose of producing the header are returned. genHeader :: GeneratorContext -> Gen (Header StandardCrypto) genHeader context = do (body, KESPeriod kesPeriod) <- genHeaderBody context - let sign = KES.SignedKES $ KES.signKES () kesPeriod body kesSignKey + let sign = KES.SignedKES $ KES.unsoundPureSignKES () kesPeriod body kesSignKey pure $ (Header body sign) where GeneratorContext{kesSignKey} = context @@ -420,11 +419,11 @@ protocolVersionZero = ProtVer versionZero 0 genCert :: SlotNo -> GeneratorContext -> Gen (OCert StandardCrypto, KESPeriod) genCert slotNo context = do - let ocertVkHot = KES.deriveVerKeyKES kesSignKey + let ocertVkHot = KES.unsoundPureDeriveVerKeyKES kesSignKey poolId = coerce $ hashKey $ VKey $ deriveVerKeyDSIGN coldSignKey ocertN = fromMaybe 0 $ Map.lookup poolId ocertCounters ocertKESPeriod <- genValidKESPeriod slotNo praosSlotsPerKESPeriod - let ocertSigma = signedDSIGN @StandardCrypto coldSignKey (OCertSignable ocertVkHot ocertN ocertKESPeriod) + let ocertSigma = signedDSIGN coldSignKey $ OCertSignable ocertVkHot ocertN ocertKESPeriod pure (OCert{..}, ocertKESPeriod) where GeneratorContext{kesSignKey, praosSlotsPerKESPeriod, coldSignKey, ocertCounters} = context diff --git a/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs b/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs index 50b849ecd8..1a4d66762c 100644 --- a/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs +++ b/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs @@ -12,8 +12,8 @@ module Test.Consensus.Protocol.Praos.SelectView (tests) where import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Util as Crypto import Cardano.Crypto.VRF (OutputVRF, mkTestOutputVRF) -import Cardano.Ledger.Crypto (Crypto (..), StandardCrypto) import qualified Cardano.Ledger.Keys as SL +import Cardano.Protocol.Crypto (Crypto (..), StandardCrypto) import Codec.Serialise (encode) import Control.Monad import Data.Containers.ListUtils (nubOrdOn) @@ -55,7 +55,7 @@ instance Crypto c => Arbitrary (PraosChainSelectView c) where -- We want to draw from the same small set of issuer identities in order to -- have a chance to explore cases where the issuers of two 'SelectView's -- are identical. - knownIssuers :: [SL.VKey SL.BlockIssuer c] + knownIssuers :: [SL.VKey SL.BlockIssuer] knownIssuers = nubOrdOn SL.hashKey $ unGen (replicateM numIssuers (SL.VKey <$> arbitrary)) randomSeed 100 @@ -66,7 +66,7 @@ instance Crypto c => Arbitrary (PraosChainSelectView c) where -- The header VRF is a deterministic function of the issuer VRF key, the -- slot and the epoch nonce. Additionally, for any particular chain, the -- slot determines the epoch nonce. - mkVRFFor :: SL.VKey SL.BlockIssuer c -> SlotNo -> OutputVRF (VRF c) + mkVRFFor :: SL.VKey SL.BlockIssuer -> SlotNo -> OutputVRF (VRF c) mkVRFFor issuer slot = mkTestOutputVRF $ Crypto.bytesToNatural diff --git a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs index 62facd2089..8d15b99448 100644 --- a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs +++ b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} -- | This is a comparative benchmark that can be used to spot regressions in the -- Chain Sync Client. It is not a benchmark intended to provide an absolute @@ -9,6 +11,7 @@ module Main (main) where import Bench.Consensus.ChainSyncClient.Driver (mainWith) import Cardano.Crypto.DSIGN.Mock +import Cardano.Ledger.BaseTypes (knownNonZeroBounded) import Control.Monad (void) import Control.ResourceRegistry import Control.Tracer (contramap, debugTracer, nullTracer) @@ -214,7 +217,7 @@ kInt :: Int kInt = 5 securityParam :: SecurityParam -securityParam = SecurityParam $ fromIntegral kInt +securityParam = SecurityParam $ knownNonZeroBounded @5 initialChain :: NE.NonEmpty B initialChain = diff --git a/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs b/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs index 2d865028bb..926b601807 100644 --- a/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs +++ b/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} @@ -5,6 +6,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -22,6 +24,7 @@ module Bench.Consensus.Mempool.TestBlock ( , txSize ) where +import Cardano.Ledger.BaseTypes (knownNonZeroBounded) import qualified Cardano.Slotting.Time as Time import Codec.Serialise (Serialise) import Control.DeepSeq (NFData) @@ -73,7 +76,7 @@ initialLedgerState = TestLedger { sampleLedgerConfig :: Ledger.LedgerConfig TestBlock sampleLedgerConfig = testBlockLedgerConfigFrom $ - HardFork.defaultEraParams (Consensus.SecurityParam 10) (Time.slotLengthFromSec 2) + HardFork.defaultEraParams (Consensus.SecurityParam $ knownNonZeroBounded @10) (Time.slotLengthFromSec 2) {------------------------------------------------------------------------------- Payload semantics diff --git a/ouroboros-consensus/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md b/ouroboros-consensus/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md new file mode 100644 index 0000000000..8ff853f6dc --- /dev/null +++ b/ouroboros-consensus/changelog.d/20250213_115925_fraser.murray_localtxmonitor_measures.md @@ -0,0 +1,4 @@ +### Breaking + +- Add `TxMeasureMetrics (TxMeasure blk)` constraint to `CanHardFork` + diff --git a/ouroboros-consensus/changelog.d/20250214_122203_jasataco_sts.md b/ouroboros-consensus/changelog.d/20250214_122203_jasataco_sts.md new file mode 100644 index 0000000000..f4172839f7 --- /dev/null +++ b/ouroboros-consensus/changelog.d/20250214_122203_jasataco_sts.md @@ -0,0 +1,24 @@ + + + + + +### Breaking + +- Expose `ValidationPolicy` and `ComputeLedgerEvents` when calling + ledger rules for block application and ticking. This allows the user + to choose any validation policy form the `small-steps` package. diff --git a/ouroboros-consensus/changelog.d/20250304_135259_jasataco_release_10_3.md b/ouroboros-consensus/changelog.d/20250304_135259_jasataco_release_10_3.md new file mode 100644 index 0000000000..e817b01bce --- /dev/null +++ b/ouroboros-consensus/changelog.d/20250304_135259_jasataco_release_10_3.md @@ -0,0 +1,22 @@ + + + + +### Breaking + +- `SecurityParam` is now `NonZero` as needed by Ledger. + diff --git a/ouroboros-consensus/changelog.d/jasagredo-ntc20.md b/ouroboros-consensus/changelog.d/jasagredo-ntc20.md new file mode 100644 index 0000000000..a78d5576db --- /dev/null +++ b/ouroboros-consensus/changelog.d/jasagredo-ntc20.md @@ -0,0 +1,3 @@ +### Non-Breaking + +* Use new `NodeToClientV_20`. diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal index 27552f9e20..b5ee9cce57 100644 --- a/ouroboros-consensus/ouroboros-consensus.cabal +++ b/ouroboros-consensus/ouroboros-consensus.cabal @@ -278,7 +278,7 @@ library bytestring >=0.10 && <0.13, cardano-binary, cardano-crypto-class, - cardano-ledger-core ^>=1.16, + cardano-ledger-core ^>=1.17, cardano-prelude, cardano-slotting, cardano-strict-containers, @@ -294,9 +294,9 @@ library mtl, multiset ^>=0.3, nothunks ^>=0.2, - ouroboros-network-api ^>=0.12, + ouroboros-network-api ^>=0.13, ouroboros-network-mock ^>=0.1, - ouroboros-network-protocols ^>=0.13, + ouroboros-network-protocols ^>=0.14, primitive, psqueues ^>=0.2.3, quiet ^>=0.2, @@ -305,6 +305,7 @@ library semialign >=1.1, serialise ^>=0.2, si-timers ^>=1.5, + small-steps ^>=1.1, sop-core ^>=0.5, sop-extras ^>=0.2, streaming, @@ -390,6 +391,8 @@ library unstable-consensus-testlib bytestring, cardano-binary:testlib, cardano-crypto-class, + cardano-ledger-binary:testlib, + cardano-ledger-core, cardano-prelude, cardano-slotting:testlib, cardano-strict-containers, @@ -470,6 +473,7 @@ library unstable-mock-block bytestring, cardano-binary, cardano-crypto-class, + cardano-ledger-core, cardano-slotting:{cardano-slotting, testlib}, cborg, containers, @@ -507,6 +511,7 @@ library unstable-tutorials build-depends: base, + cardano-ledger-core, containers, hashable, mtl, @@ -542,8 +547,9 @@ test-suite consensus-test base, base-deriving-via, cardano-binary, - cardano-crypto-class, - cardano-crypto-tests, + cardano-crypto-class ^>=2.2, + cardano-crypto-tests ^>=2.2, + cardano-ledger-core:{cardano-ledger-core, testlib}, cardano-slotting:{cardano-slotting, testlib}, cborg, containers, @@ -600,6 +606,7 @@ test-suite infra-test build-depends: QuickCheck, base, + cardano-ledger-core, io-classes, io-sim, mtl, @@ -651,7 +658,8 @@ test-suite storage-test bifunctors, binary, bytestring, - cardano-crypto-class, + cardano-crypto-class ^>=2.2, + cardano-ledger-core:{cardano-ledger-core, testlib}, cardano-slotting:{cardano-slotting, testlib}, cborg, containers, @@ -696,6 +704,7 @@ benchmark mempool-bench aeson, base, bytestring, + cardano-ledger-core, cardano-slotting, cassava, containers, @@ -724,6 +733,7 @@ benchmark ChainSync-client-bench array, base, cardano-crypto-class, + cardano-ledger-core, containers, contra-tracer, ouroboros-consensus, diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs index 087b5869c7..64adf86045 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Config/SecurityParam.hs @@ -2,8 +2,12 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} + module Ouroboros.Consensus.Config.SecurityParam (SecurityParam (..)) where +import Cardano.Binary +import Cardano.Ledger.BaseTypes.NonZero import Data.Word import GHC.Generics (Generic) import NoThunks.Class (NoThunks) @@ -18,6 +22,16 @@ import Quiet -- -- NOTE: This talks about the number of /blocks/ we can roll back, not -- the number of /slots/. -newtype SecurityParam = SecurityParam { maxRollbacks :: Word64 } - deriving (Eq, Generic, NoThunks) +newtype SecurityParam = SecurityParam { maxRollbacks :: NonZero Word64 } + deriving (Eq, Generic, NoThunks, ToCBOR, FromCBOR) deriving Show via Quiet SecurityParam + +instance ToCBOR a => ToCBOR (NonZero a) where + toCBOR = toCBOR . unNonZero + +instance (HasZero a, FromCBOR a) => FromCBOR (NonZero a) where + fromCBOR = do + a <- fromCBOR + case nonZero a of + Nothing -> fail "Non zero expected but zero found!" + Just a' -> pure a' diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs index c6c47b2e46..547d8cf55c 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs @@ -33,6 +33,7 @@ module Ouroboros.Consensus.Genesis.Governor ( , sharedCandidatePrefix ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Monad (guard, void, when) import Control.Tracer (Tracer, traceWith) import Data.Bifunctor (second) @@ -380,7 +381,7 @@ densityDisconnect (GenesisWindow sgen) (SecurityParam k) states candidateSuffixe -- Does the peer have more than k known blocks in _total_ after the intersection? -- If not, it is not qualified to compete by density (yet). - offersMoreThanK = totalBlockCount > k + offersMoreThanK = totalBlockCount > unNonZero k pure (peer, DensityBounds {clippedFragment, offersMoreThanK, lowerBound, upperBound, hasBlockAfter, latestSlot, idling}) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs index 2f1ba44142..ad32f2d5d1 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs @@ -35,6 +35,7 @@ class ( All SingleEraBlock xs , HasByteSize (HardForkTxMeasure xs) , NoThunks (HardForkTxMeasure xs) , Show (HardForkTxMeasure xs) + , TxMeasureMetrics (HardForkTxMeasure xs) ) => CanHardFork xs where -- | A measure that can accurately represent the 'TxMeasure' of any era. -- diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs index ce8e9a1bf8..e024b4dad3 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs @@ -45,6 +45,7 @@ import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Ledger.SupportsPeerSelection import Ouroboros.Consensus.Ledger.SupportsProtocol import Ouroboros.Consensus.Node.InitStorage +import Ouroboros.Consensus.Node.Serialisation import Ouroboros.Consensus.Storage.Serialisation import Ouroboros.Consensus.Util.Condense @@ -68,6 +69,7 @@ class ( LedgerSupportsProtocol blk , NodeInitStorage blk , BlockSupportsDiffusionPipelining blk , BlockSupportsMetrics blk + , SerialiseNodeToClient blk (PartialLedgerConfig blk) -- Instances required to support testing , Eq (GenTx blk) , Eq (Validated (GenTx blk)) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Nary.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Nary.hs index f35ecaaffc..eb1f93e2f6 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Nary.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Nary.hs @@ -164,6 +164,9 @@ injectHardForkState iidx x = instance Inject I where inject = injectNS' (Proxy @I) . forgetInjectionIndex +instance Inject (K a) where + inject _ (K a) = K a + instance Inject Header where inject = injectNS' (Proxy @Header) . forgetInjectionIndex diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs index aaa001f0b8..9b6cbf6b78 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs @@ -30,6 +30,7 @@ module Ouroboros.Consensus.HardFork.Combinator.Ledger ( import Control.Monad (guard) import Control.Monad.Except (throwError, withExcept) +import qualified Control.State.Transition.Extended as STS import Data.Functor ((<&>)) import Data.Functor.Product import Data.Proxy @@ -117,9 +118,13 @@ instance CanHardFork xs => IsLedger (LedgerState (HardForkBlock xs)) where type AuxLedgerEvent (LedgerState (HardForkBlock xs)) = OneEraLedgerEvent xs - applyChainTickLedgerResult cfg@HardForkLedgerConfig{..} slot (HardForkLedgerState st) = + applyChainTickLedgerResult evs cfg@HardForkLedgerConfig{..} slot (HardForkLedgerState st) = sequenceHardForkState - (hcizipWith proxySingle (tickOne ei slot) cfgs extended) <&> \l' -> + (hcizipWith + proxySingle + (tickOne ei slot evs) + cfgs + extended) <&> \l' -> TickedHardForkLedgerState { tickedHardForkLedgerStateTransition = -- We are bundling a 'TransitionInfo' with a /ticked/ ledger state, @@ -155,15 +160,16 @@ instance CanHardFork xs => IsLedger (LedgerState (HardForkBlock xs)) where tickOne :: SingleEraBlock blk => EpochInfo (Except PastHorizonException) -> SlotNo + -> ComputeLedgerEvents -> Index xs blk -> WrapPartialLedgerConfig blk -> LedgerState blk -> ( LedgerResult (LedgerState (HardForkBlock xs)) :.: (Ticked :.: LedgerState) ) blk -tickOne ei slot index pcfg st = Comp $ fmap Comp $ +tickOne ei slot evs index pcfg st = Comp $ fmap Comp $ embedLedgerResult (injectLedgerEvent index) - $ applyChainTickLedgerResult (completeLedgerConfig' ei pcfg) slot st + $ applyChainTickLedgerResult evs (completeLedgerConfig' ei pcfg) slot st {------------------------------------------------------------------------------- ApplyBlock @@ -172,7 +178,7 @@ tickOne ei slot index pcfg st = Comp $ fmap Comp $ instance CanHardFork xs => ApplyBlock (LedgerState (HardForkBlock xs)) (HardForkBlock xs) where - applyBlockLedgerResult cfg + applyBlockLedgerResultWithValidation doValidate opts cfg (HardForkBlock (OneEraBlock block)) (TickedHardForkLedgerState transition st) = case State.match block st of @@ -185,7 +191,7 @@ instance CanHardFork xs Right matched -> fmap (fmap HardForkLedgerState . sequenceHardForkState) $ hsequence' - $ hcizipWith proxySingle apply cfgs matched + $ hcizipWith proxySingle (apply doValidate opts) cfgs matched where cfgs = distribLedgerConfig ei cfg ei = State.epochInfoPrecomputedTransitionInfo @@ -193,50 +199,29 @@ instance CanHardFork xs transition st - reapplyBlockLedgerResult cfg - (HardForkBlock (OneEraBlock block)) - (TickedHardForkLedgerState transition st) = - case State.match block st of - Left _mismatch -> - -- We already applied this block to this ledger state, - -- so it can't be from the wrong era - error "reapplyBlockLedgerResult: can't be from other era" - Right matched -> - fmap HardForkLedgerState - $ sequenceHardForkState - $ hcizipWith proxySingle reapply cfgs matched - where - cfgs = distribLedgerConfig ei cfg - ei = State.epochInfoPrecomputedTransitionInfo - (hardForkLedgerConfigShape cfg) - transition - st + applyBlockLedgerResult = defaultApplyBlockLedgerResult + + reapplyBlockLedgerResult = defaultReapplyBlockLedgerResult (\_ -> + -- We already applied this block to this ledger state, + -- so it can't be from the wrong era + error "reapplyBlockLedgerResult: can't be from other era" + ) apply :: SingleEraBlock blk - => Index xs blk + => STS.ValidationPolicy + -> ComputeLedgerEvents + -> Index xs blk -> WrapLedgerConfig blk -> Product I (Ticked :.: LedgerState) blk -> ( Except (HardForkLedgerError xs) :.: LedgerResult (LedgerState (HardForkBlock xs)) :.: LedgerState ) blk -apply index (WrapLedgerConfig cfg) (Pair (I block) (Comp st)) = +apply doValidate opts index (WrapLedgerConfig cfg) (Pair (I block) (Comp st)) = Comp $ withExcept (injectLedgerError index) $ fmap (Comp . embedLedgerResult (injectLedgerEvent index)) - $ applyBlockLedgerResult cfg block st - -reapply :: SingleEraBlock blk - => Index xs blk - -> WrapLedgerConfig blk - -> Product I (Ticked :.: LedgerState) blk - -> ( LedgerResult (LedgerState (HardForkBlock xs)) - :.: LedgerState - ) blk -reapply index (WrapLedgerConfig cfg) (Pair (I block) (Comp st)) = - Comp - $ embedLedgerResult (injectLedgerEvent index) - $ reapplyBlockLedgerResult cfg block st + $ applyBlockLedgerResultWithValidation doValidate opts cfg block st {------------------------------------------------------------------------------- UpdateLedger diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/PartialConfig.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/PartialConfig.hs index afd94a151e..2b2dc78b5a 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/PartialConfig.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/PartialConfig.hs @@ -1,6 +1,9 @@ {-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -25,6 +28,7 @@ import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block import Ouroboros.Consensus.HardFork.History.Qry (PastHorizonException) import Ouroboros.Consensus.Ledger.Abstract +import Ouroboros.Consensus.Node.Serialisation import Ouroboros.Consensus.Protocol.Abstract -- | Partial consensus config @@ -94,3 +98,6 @@ newtype WrapPartialConsensusConfig blk = WrapPartialConsensusConfig { unwrapPart deriving instance NoThunks (PartialLedgerConfig blk) => NoThunks (WrapPartialLedgerConfig blk) deriving instance NoThunks (PartialConsensusConfig (BlockProtocol blk)) => NoThunks (WrapPartialConsensusConfig blk) + +deriving newtype instance SerialiseNodeToClient blk (PartialLedgerConfig blk) + => SerialiseNodeToClient blk (WrapPartialLedgerConfig blk) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs index ca6e7b7986..4800c51c27 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs @@ -19,16 +19,20 @@ module Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseNodeToClie import Cardano.Binary (enforceSize) import Codec.CBOR.Decoding (Decoder) import qualified Codec.CBOR.Decoding as Dec -import Codec.CBOR.Encoding (Encoding) +import Codec.CBOR.Encoding (Encoding, encodeListLen) import qualified Codec.CBOR.Encoding as Enc import qualified Codec.Serialise as Serialise import Control.Exception (throw) +import Data.Maybe (catMaybes) import Data.Proxy import Data.SOP.BasicFunctors import Data.SOP.Constraint +import Data.SOP.Counting import Data.SOP.NonEmpty (ProofNonEmpty (..), checkIsNonEmpty, isNonEmpty) +import Data.SOP.Sing (lengthSList) import Data.SOP.Strict +import qualified Data.Text as T import Ouroboros.Consensus.Block import Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock import Ouroboros.Consensus.HardFork.Combinator.AcrossEras @@ -37,6 +41,7 @@ import Ouroboros.Consensus.HardFork.Combinator.Ledger.Query import Ouroboros.Consensus.HardFork.Combinator.Mempool import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common import Ouroboros.Consensus.HardFork.Combinator.Serialisation.SerialiseDisk () +import qualified Ouroboros.Consensus.HardFork.History as History import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId) import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.Run @@ -45,8 +50,157 @@ import Ouroboros.Consensus.Util ((.:)) import Ouroboros.Network.Block (Serialised, unwrapCBORinCBOR, wrapCBORinCBOR) +{------------------------------------------------------------------------------- + Serialisation of products +-------------------------------------------------------------------------------} + +-- | Encoding of @NP f xs@ while filtering out the components for disabled eras +-- as indicated by the 'HardForkNodeToClientVersion xs'. Disabled eras imply +-- that the protocol version does not support those eras. Hence, omitting the +-- corresponding elements is the correct behavior. +encodeNodeToClientNP :: + forall f xs. SerialiseHFC xs + => ( forall x. SerialiseConstraintsHFC x + => CodecConfig x + -> BlockNodeToClientVersion x + -> f x + -> Encoding + ) + -- ^ The encoding of the individual elements (assuming era `x` is enabled). + -> CodecConfig (HardForkBlock xs) + -> HardForkNodeToClientVersion xs + -> NP f xs + -> Encoding +encodeNodeToClientNP + encodeElement + (HardForkCodecConfig (PerEraCodecConfig ccfgs)) + version + xs + | Just err <- validateHardForkNodeToClientVersion version + = error err + | otherwise + = case version of + HardForkNodeToClientDisabled versionX -> case ccfgs of + ccfg :* _ -> case xs of + x :* _ -> encodeElement ccfg versionX x + HardForkNodeToClientEnabled _ subVersions -> + let components :: [Encoding] + components = catMaybes + $ hcollapse + $ hczipWith3 + (Proxy @SerialiseConstraintsHFC) + (\ccfg subVersionMay x -> K $ case subVersionMay of + EraNodeToClientEnabled subVersion -> Just (encodeElement ccfg subVersion x) + -- Omit disabled eras + EraNodeToClientDisabled -> Nothing + ) + ccfgs + subVersions + xs + listLen = fromIntegral (length components) + in Enc.encodeListLen listLen <> mconcat components + +-- | Decoding of `NP f xs`. If any eras are disabled in the version and hence +-- missing in the serialisation, then this throws an exception. In effect, +-- deserialisation of product types is only supported when the sender uses an +-- equal or superset of eras. +decodeNodeToClientNP :: + forall f xs. SerialiseHFC xs + => ( forall x. SerialiseConstraintsHFC x + => CodecConfig x + -> BlockNodeToClientVersion x + -> (forall s. Decoder s (f x)) + ) + -- ^ The decoding of the individual elements (assuming era `x` is enabled). + -> CodecConfig (HardForkBlock xs) + -> HardForkNodeToClientVersion xs + -> (forall s. Decoder s (NP f xs)) +decodeNodeToClientNP + decodeElement + (HardForkCodecConfig (PerEraCodecConfig ccfgs)) + version + | Just err <- validateHardForkNodeToClientVersion version + = error err + | otherwise + = case version of + HardForkNodeToClientDisabled versionX -> case ccfgs of + (ccfg :* Nil) -> do + singleElement <- decodeElement ccfg versionX + return (singleElement :* Nil) + _ -> failVersion + + HardForkNodeToClientEnabled _ subVersions -> do + enforceSize failVersionTxt expectedN + hsequence' $ hczipWith + (Proxy @SerialiseConstraintsHFC) + (\ccfg subVersionMay -> Comp $ case subVersionMay of + EraNodeToClientEnabled subVersion -> decodeElement ccfg subVersion + -- Fail if any era is disabled + EraNodeToClientDisabled -> failVersion + ) + ccfgs + subVersions + where + expectedN = lengthSList (Proxy @xs) + + failVersion :: Decoder s a + failVersion = fail failVersionStr + failVersionStr = "decodeNodeToClient: (NP f xs): incompatible node-to-client version" + failVersionTxt = T.pack failVersionStr + +-- | Check that @version@ consists of a run of 0 or more enabled eras followed +-- by a run of 0 or more disabled eras. Returns an error message if not. +validateHardForkNodeToClientVersion :: + SerialiseHFC xs + => HardForkNodeToClientVersion xs + -> Maybe String +validateHardForkNodeToClientVersion version = case version of + HardForkNodeToClientDisabled _ -> Nothing + HardForkNodeToClientEnabled _ subVersions -> goEnabled subVersions + where + goEnabled :: NP EraNodeToClientVersion xs' -> Maybe String + goEnabled v = case v of + Nil -> Nothing + EraNodeToClientEnabled _ :* v' -> goEnabled v' + EraNodeToClientDisabled :* v' -> goDisabled v' + + goDisabled :: NP EraNodeToClientVersion xs' -> Maybe String + goDisabled v = case v of + Nil -> Nothing + EraNodeToClientEnabled _ :* _ -> Just $ + "Expected HardForkNodeToClientVersion to consists of a run of 0 or more" + <> " enabled eras followed by a run of 0 or more disabled eras, but got: " + <> show version + EraNodeToClientDisabled :* v' -> goDisabled v' + instance SerialiseHFC xs => SerialiseNodeToClientConstraints (HardForkBlock xs) +instance SerialiseHFC xs => SerialiseNodeToClient (HardForkBlock xs) (HardForkLedgerConfig xs) where + encodeNodeToClient ccfg version (HardForkLedgerConfig hflcShape perEraLedgerConfig) = + mconcat [ + encodeListLen 2 + , encodeNodeToClient @_ @(History.Shape xs) ccfg version hflcShape + , encodeNodeToClient @_ @(PerEraLedgerConfig xs) ccfg version perEraLedgerConfig + ] + decodeNodeToClient ccfg version = do + enforceSize "HardForkLedgerConfig" 2 + HardForkLedgerConfig + <$> decodeNodeToClient @_ @(History.Shape xs) ccfg version + <*> decodeNodeToClient @_ @(PerEraLedgerConfig xs) ccfg version + +instance SerialiseHFC xs => SerialiseNodeToClient (HardForkBlock xs) (History.Shape xs) where + encodeNodeToClient ccfg version (History.Shape (Exactly xs)) = + encodeNodeToClientNP + (\_ _ (K a) -> Serialise.encode a) + ccfg + version + xs + decodeNodeToClient ccfg version = + History.Shape . Exactly <$> decodeNodeToClientNP + (\_ _ -> K <$> Serialise.decode) + ccfg + version + {------------------------------------------------------------------------------- Dispatch to first era or HFC -------------------------------------------------------------------------------} @@ -134,6 +288,16 @@ dispatchDecoderErr ccfg version = after :: (a -> b -> d -> e) -> (c -> d) -> a -> b -> c -> e after f g x y z = f x y (g z) +{------------------------------------------------------------------------------- + Ledger Config +-------------------------------------------------------------------------------} + +instance SerialiseHFC xs => SerialiseNodeToClient (HardForkBlock xs) (PerEraLedgerConfig xs) where + encodeNodeToClient ccfg version (PerEraLedgerConfig xs) = + encodeNodeToClientNP encodeNodeToClient ccfg version xs + decodeNodeToClient ccfg version = + PerEraLedgerConfig <$> decodeNodeToClientNP decodeNodeToClient ccfg version + {------------------------------------------------------------------------------- Blocks -------------------------------------------------------------------------------} diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/EraParams.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/EraParams.hs index 7827bb7291..2a046f24f3 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/EraParams.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/EraParams.hs @@ -17,6 +17,7 @@ module Ouroboros.Consensus.HardFork.History.EraParams ( ) where import Cardano.Binary (enforceSize) +import Cardano.Ledger.BaseTypes (unNonZero) import Codec.CBOR.Decoding (Decoder, decodeListLen, decodeWord8) import Codec.CBOR.Encoding (Encoding, encodeListLen, encodeWord8) import Codec.Serialise (Serialise (..)) @@ -149,10 +150,10 @@ data EraParams = EraParams { -- This is primarily useful for tests. defaultEraParams :: SecurityParam -> SlotLength -> EraParams defaultEraParams (SecurityParam k) slotLength = EraParams { - eraEpochSize = EpochSize (k * 10) + eraEpochSize = EpochSize (unNonZero k * 10) , eraSlotLength = slotLength - , eraSafeZone = StandardSafeZone (k * 2) - , eraGenesisWin = GenesisWindow (k * 2) + , eraSafeZone = StandardSafeZone (unNonZero k * 2) + , eraGenesisWin = GenesisWindow (unNonZero k * 2) } -- | Zone in which it is guaranteed that no hard fork can take place diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Simple.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Simple.hs index d3d5db0280..e32c870493 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Simple.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Simple.hs @@ -1,12 +1,18 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} module Ouroboros.Consensus.HardFork.Simple (TriggerHardFork (..)) where +import Cardano.Binary import Cardano.Slotting.Slot (EpochNo) import Data.Word import GHC.Generics (Generic) import NoThunks.Class (NoThunks) +import Ouroboros.Consensus.Node.Serialisation -- | The trigger condition that will cause the hard fork transition. -- @@ -32,3 +38,17 @@ data TriggerHardFork = -- era. | TriggerHardForkNotDuringThisExecution deriving (Show, Generic, NoThunks) + +instance SerialiseNodeToClient blk TriggerHardFork where + encodeNodeToClient _ _ triggerHardFork = case triggerHardFork of + TriggerHardForkAtVersion v -> encodeListLen 2 <> encodeWord8 0 <> toCBOR v + TriggerHardForkAtEpoch e -> encodeListLen 2 <> encodeWord8 1 <> toCBOR e + TriggerHardForkNotDuringThisExecution -> encodeListLen 2 <> encodeWord8 2 + decodeNodeToClient _ _ = do + len <- decodeListLen + tag <- decodeWord8 + case (len, tag) of + (2, 0) -> TriggerHardForkAtVersion <$> fromCBOR @Word16 + (2, 1) -> TriggerHardForkAtEpoch <$> fromCBOR @EpochNo + (2, 2) -> pure TriggerHardForkNotDuringThisExecution + _ -> fail $ "TriggerHardFork: invalid (len, tag): " <> show (len, tag) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderStateHistory.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderStateHistory.hs index 0fc4be977d..9e56726fe6 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderStateHistory.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderStateHistory.hs @@ -255,8 +255,7 @@ fromChain cfg initState chain = anchorSnapshot NE.:| snapshots = fmap (mkHeaderStateWithTime (configLedger cfg)) . NE.scanl - (flip (tickThenReapply (ExtLedgerCfg cfg))) + (flip (tickThenReapply OmitLedgerEvents (ExtLedgerCfg cfg))) initState . Chain.toOldestFirst $ chain - diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Abstract.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Abstract.hs index d78c5692d0..1a3d16afae 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Abstract.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Abstract.hs @@ -17,7 +17,10 @@ module Ouroboros.Consensus.Ledger.Abstract ( Validated -- * Apply block , ApplyBlock (..) + , ComputeLedgerEvents (..) , UpdateLedger + , defaultApplyBlockLedgerResult + , defaultReapplyBlockLedgerResult -- * Derived , applyLedgerBlock , foldLedger @@ -36,12 +39,13 @@ module Ouroboros.Consensus.Ledger.Abstract ( ) where import Control.Monad.Except +import qualified Control.State.Transition.Extended as STS import Data.Kind (Type) import GHC.Stack (HasCallStack) import Ouroboros.Consensus.Block.Abstract import Ouroboros.Consensus.Ledger.Basics import Ouroboros.Consensus.Ticked -import Ouroboros.Consensus.Util (repeatedly, repeatedlyM, (..:)) +import Ouroboros.Consensus.Util -- | " Validated " transaction or block -- @@ -83,9 +87,28 @@ class ( IsLedger l -- -- This is passed the ledger state ticked to the slot of the given block, so -- 'applyChainTickLedgerResult' has already been called. + -- + -- Users of this function can set any validation level allowed by the + -- @small-steps@ package. See "Control.State.Transition.Extended". + applyBlockLedgerResultWithValidation :: + HasCallStack + => STS.ValidationPolicy + -> ComputeLedgerEvents + -> LedgerCfg l + -> blk + -> Ticked l + -> Except (LedgerErr l) (LedgerResult l l) + + -- | Apply a block to the ledger state. + -- + -- This is passed the ledger state ticked to the slot of the given block, so + -- 'applyChainTickLedgerResult' has already been called. + -- + -- This function will use 'ValidateAll' policy for calling the ledger rules. applyBlockLedgerResult :: HasCallStack - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> Ticked l -> Except (LedgerErr l) (LedgerResult l l) @@ -98,14 +121,38 @@ class ( IsLedger l -- -- It is worth noting that since we already know that the block is valid in -- the provided ledger state, the ledger layer should not perform /any/ - -- validation checks. + -- validation checks. Thus this function will call the ledger rules with + -- 'ValidateNone' policy. reapplyBlockLedgerResult :: HasCallStack - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> Ticked l -> LedgerResult l l +defaultApplyBlockLedgerResult :: + (HasCallStack, ApplyBlock l blk) + => ComputeLedgerEvents + -> LedgerCfg l + -> blk + -> Ticked l + -> Except (LedgerErr l) (LedgerResult l l) +defaultApplyBlockLedgerResult = + applyBlockLedgerResultWithValidation STS.ValidateAll + +defaultReapplyBlockLedgerResult :: + (HasCallStack, ApplyBlock l blk) + => (LedgerErr l -> LedgerResult l l) + -> ComputeLedgerEvents + -> LedgerCfg l + -> blk + -> Ticked l + -> LedgerResult l l +defaultReapplyBlockLedgerResult throwReapplyError = + (either throwReapplyError id . runExcept) + ...: applyBlockLedgerResultWithValidation STS.ValidateNone + -- | Interaction with the ledger layer class ApplyBlock (LedgerState blk) blk => UpdateLedger blk @@ -115,75 +162,87 @@ class ApplyBlock (LedgerState blk) blk => UpdateLedger blk -- | 'lrResult' after 'applyBlockLedgerResult' applyLedgerBlock :: + forall l blk. (ApplyBlock l blk, HasCallStack) - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> Ticked l -> Except (LedgerErr l) l -applyLedgerBlock = fmap lrResult ..: applyBlockLedgerResult +applyLedgerBlock = fmap lrResult ...: applyBlockLedgerResult -- | 'lrResult' after 'reapplyBlockLedgerResult' reapplyLedgerBlock :: + forall l blk. (ApplyBlock l blk, HasCallStack) - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> Ticked l -> l -reapplyLedgerBlock = lrResult ..: reapplyBlockLedgerResult +reapplyLedgerBlock = + lrResult ...: reapplyBlockLedgerResult tickThenApplyLedgerResult :: ApplyBlock l blk - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> l -> Except (LedgerErr l) (LedgerResult l l) -tickThenApplyLedgerResult cfg blk l = do - let lrTick = applyChainTickLedgerResult cfg (blockSlot blk) l - lrBlock <- applyBlockLedgerResult cfg blk (lrResult lrTick) +tickThenApplyLedgerResult opts cfg blk l = do + let lrTick = applyChainTickLedgerResult opts cfg (blockSlot blk) l + lrBlock <- applyBlockLedgerResult opts cfg blk (lrResult lrTick) pure LedgerResult { lrEvents = lrEvents lrTick <> lrEvents lrBlock , lrResult = lrResult lrBlock } tickThenReapplyLedgerResult :: + forall l blk. ApplyBlock l blk - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> l -> LedgerResult l l -tickThenReapplyLedgerResult cfg blk l = - let lrTick = applyChainTickLedgerResult cfg (blockSlot blk) l - lrBlock = reapplyBlockLedgerResult cfg blk (lrResult lrTick) +tickThenReapplyLedgerResult evs cfg blk l = + let lrTick = applyChainTickLedgerResult evs cfg (blockSlot blk) l + lrBlock = reapplyBlockLedgerResult evs cfg blk (lrResult lrTick) in LedgerResult { lrEvents = lrEvents lrTick <> lrEvents lrBlock , lrResult = lrResult lrBlock } tickThenApply :: + forall l blk. ApplyBlock l blk - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> l -> Except (LedgerErr l) l -tickThenApply = fmap lrResult ..: tickThenApplyLedgerResult +tickThenApply = fmap lrResult ...: tickThenApplyLedgerResult tickThenReapply :: + forall l blk. ApplyBlock l blk - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> blk -> l -> l -tickThenReapply = lrResult ..: tickThenReapplyLedgerResult +tickThenReapply = lrResult ...: tickThenReapplyLedgerResult foldLedger :: ApplyBlock l blk - => LedgerCfg l -> [blk] -> l -> Except (LedgerErr l) l -foldLedger = repeatedlyM . tickThenApply + => ComputeLedgerEvents -> LedgerCfg l -> [blk] -> l -> Except (LedgerErr l) l +foldLedger = repeatedlyM .: tickThenApply refoldLedger :: ApplyBlock l blk - => LedgerCfg l -> [blk] -> l -> l -refoldLedger = repeatedly . tickThenReapply + => ComputeLedgerEvents -> LedgerCfg l -> [blk] -> l -> l +refoldLedger = repeatedly .: tickThenReapply {------------------------------------------------------------------------------- Short-hand diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs index b7b6eca434..8a0cb13036 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} @@ -23,17 +25,21 @@ module Ouroboros.Consensus.Ledger.Basics ( , LedgerCfg , applyChainTick -- * Link block to its ledger + , ComputeLedgerEvents (..) , LedgerConfig , LedgerError , LedgerState + , Proxy (..) , TickedLedgerState ) where import Data.Kind (Type) +import Data.Proxy (Proxy (..)) +import GHC.Generics import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block.Abstract import Ouroboros.Consensus.Ticked -import Ouroboros.Consensus.Util ((..:)) +import Ouroboros.Consensus.Util ((...:)) {------------------------------------------------------------------------------- Tip @@ -97,6 +103,18 @@ pureLedgerResult a = LedgerResult { -- Types that inhabit this family will come from the Ledger code. type family LedgerCfg l :: Type +-- | Whether we tell the ledger layer to compute ledger events +-- +-- At the moment events are not emitted in any case in the consensus +-- layer (i.e. there is no handler for those events, nor are they +-- traced), so they are not really forced, we always discard +-- them. This behavior does not incur big costs thanks to laziness. +-- +-- By passing 'OmitLedgerEvents' we tell the Ledger layer to not even +-- allocate thunks for those events, as we explicitly don't want them. +data ComputeLedgerEvents = ComputeLedgerEvents | OmitLedgerEvents + deriving (Eq, Show, Generic, NoThunks) + class ( -- Requirements on the ledger state itself Show l , Eq l @@ -155,14 +173,15 @@ class ( -- Requirements on the ledger state itself -- > ledgerTipPoint (applyChainTick cfg slot st) -- > == ledgerTipPoint st applyChainTickLedgerResult :: - LedgerCfg l + ComputeLedgerEvents + -> LedgerCfg l -> SlotNo -> l -> LedgerResult l (Ticked l) -- | 'lrResult' after 'applyChainTickLedgerResult' -applyChainTick :: IsLedger l => LedgerCfg l -> SlotNo -> l -> Ticked l -applyChainTick = lrResult ..: applyChainTickLedgerResult +applyChainTick :: IsLedger l => ComputeLedgerEvents -> LedgerCfg l -> SlotNo -> l -> Ticked l +applyChainTick = lrResult ...: applyChainTickLedgerResult {------------------------------------------------------------------------------- Link block to its ledger diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs index a5dc517634..6658fe4b9e 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs @@ -47,12 +47,14 @@ module Ouroboros.Consensus.Ledger.Dual ( , decodeDualGenTxErr , decodeDualGenTxId , decodeDualHeader + , decodeDualLedgerConfig , decodeDualLedgerState , encodeDualBlock , encodeDualGenTx , encodeDualGenTxErr , encodeDualGenTxId , encodeDualHeader + , encodeDualLedgerConfig , encodeDualLedgerState ) where @@ -74,6 +76,7 @@ import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config import Ouroboros.Consensus.Config.SupportsNode import Ouroboros.Consensus.HardFork.Abstract +import Ouroboros.Consensus.HardFork.Combinator.PartialConfig import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.CommonProtocolParams @@ -327,6 +330,8 @@ data DualLedgerConfig m a = DualLedgerConfig { type instance LedgerCfg (LedgerState (DualBlock m a)) = DualLedgerConfig m a +instance Bridge m a => HasPartialLedgerConfig (DualBlock m a) + instance Bridge m a => GetTip (LedgerState (DualBlock m a)) where getTip = castPoint . getTip . dualLedgerStateMain @@ -359,12 +364,13 @@ instance Bridge m a => IsLedger (LedgerState (DualBlock m a)) where -- any events. So we make this easy choice for for now. type AuxLedgerEvent (LedgerState (DualBlock m a)) = AuxLedgerEvent (LedgerState m) - applyChainTickLedgerResult DualLedgerConfig{..} + applyChainTickLedgerResult evs + DualLedgerConfig{..} slot DualLedgerState{..} = castLedgerResult ledgerResult <&> \main -> TickedDualLedgerState { tickedDualLedgerStateMain = main - , tickedDualLedgerStateAux = applyChainTick + , tickedDualLedgerStateAux = applyChainTick evs dualLedgerConfigAux slot dualLedgerStateAux @@ -372,23 +378,32 @@ instance Bridge m a => IsLedger (LedgerState (DualBlock m a)) where , tickedDualLedgerStateBridge = dualLedgerStateBridge } where - ledgerResult = applyChainTickLedgerResult + ledgerResult = applyChainTickLedgerResult evs dualLedgerConfigMain slot dualLedgerStateMain -instance Bridge m a => ApplyBlock (LedgerState (DualBlock m a)) (DualBlock m a) where - - applyBlockLedgerResult cfg - block@DualBlock{..} - TickedDualLedgerState{..} = do +applyHelper :: + Bridge m a + => ( ComputeLedgerEvents + -> LedgerCfg (LedgerState m) + -> m + -> Ticked (LedgerState m) + -> Except (LedgerErr (LedgerState m)) (LedgerResult (LedgerState m) (LedgerState m)) + ) + -> ComputeLedgerEvents + -> DualLedgerConfig m a + -> DualBlock m a + -> Ticked (LedgerState (DualBlock m a)) + -> Except (DualLedgerError m a) (LedgerResult (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))) +applyHelper f opts cfg block@DualBlock{..} TickedDualLedgerState{..} = do (ledgerResult, aux') <- agreeOnError DualLedgerError ( - applyBlockLedgerResult + f opts (dualLedgerConfigMain cfg) dualBlockMain tickedDualLedgerStateMain - , applyMaybeBlock + , applyMaybeBlock opts (dualLedgerConfigAux cfg) dualBlockAux tickedDualLedgerStateAux @@ -402,12 +417,20 @@ instance Bridge m a => ApplyBlock (LedgerState (DualBlock m a)) (DualBlock m a) tickedDualLedgerStateBridge } - reapplyBlockLedgerResult cfg +instance Bridge m a => ApplyBlock (LedgerState (DualBlock m a)) (DualBlock m a) where + + applyBlockLedgerResultWithValidation doValidate = + applyHelper (applyBlockLedgerResultWithValidation doValidate) + + applyBlockLedgerResult = + applyHelper applyBlockLedgerResult + + reapplyBlockLedgerResult evs cfg block@DualBlock{..} TickedDualLedgerState{..} = castLedgerResult ledgerResult <&> \main' -> DualLedgerState { dualLedgerStateMain = main' - , dualLedgerStateAux = reapplyMaybeBlock + , dualLedgerStateAux = reapplyMaybeBlock evs (dualLedgerConfigAux cfg) dualBlockAux tickedDualLedgerStateAux @@ -417,7 +440,7 @@ instance Bridge m a => ApplyBlock (LedgerState (DualBlock m a)) (DualBlock m a) tickedDualLedgerStateBridge } where - ledgerResult = reapplyBlockLedgerResult + ledgerResult = reapplyBlockLedgerResult evs (dualLedgerConfigMain cfg) dualBlockMain tickedDualLedgerStateMain @@ -766,25 +789,27 @@ type instance ForgeStateUpdateError (DualBlock m a) = ForgeStateUpdateError m -- -- Returns state unchanged on 'Nothing' applyMaybeBlock :: UpdateLedger blk - => LedgerConfig blk + => ComputeLedgerEvents + -> LedgerConfig blk -> Maybe blk -> TickedLedgerState blk -> LedgerState blk -> Except (LedgerError blk) (LedgerState blk) -applyMaybeBlock _ Nothing _ st = return st -applyMaybeBlock cfg (Just block) tst _ = applyLedgerBlock cfg block tst +applyMaybeBlock _ _ Nothing _ st = return st +applyMaybeBlock opts cfg (Just block) tst _ = applyLedgerBlock opts cfg block tst -- | Lift 'reapplyLedgerBlock' to @Maybe blk@ -- -- See also 'applyMaybeBlock' reapplyMaybeBlock :: UpdateLedger blk - => LedgerConfig blk + => ComputeLedgerEvents + -> LedgerConfig blk -> Maybe blk -> TickedLedgerState blk -> LedgerState blk -> LedgerState blk -reapplyMaybeBlock _ Nothing _ st = st -reapplyMaybeBlock cfg (Just block) tst _ = reapplyLedgerBlock cfg block tst +reapplyMaybeBlock _ _ Nothing _ st = st +reapplyMaybeBlock evs cfg (Just block) tst _ = reapplyLedgerBlock evs cfg block tst -- | Used when the concrete and abstract implementation should agree on errors -- @@ -811,6 +836,25 @@ agreeOnError f (ma, mb) = For now we just require 'Serialise' for the auxiliary block. -------------------------------------------------------------------------------} +encodeDualLedgerConfig :: (LedgerCfg (LedgerState m) -> Encoding) + -> (LedgerCfg (LedgerState a) -> Encoding) + -> DualLedgerConfig m a + -> Encoding +encodeDualLedgerConfig encodeM encodeA (DualLedgerConfig m a) = mconcat [ + encodeListLen 2 + , encodeM m + , encodeA a + ] + +decodeDualLedgerConfig :: Decoder s (LedgerCfg (LedgerState m)) + -> Decoder s (LedgerCfg (LedgerState a)) + -> Decoder s (DualLedgerConfig m a) +decodeDualLedgerConfig decodeM decodeA = do + enforceSize "DualLedgerConfig" 2 + DualLedgerConfig + <$> decodeM + <*> decodeA + encodeDualBlock :: (Bridge m a, Serialise a) => (m -> Encoding) -> DualBlock m a -> Encoding diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs index 522e2e2b51..9a1a2aaa2d 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs @@ -36,6 +36,7 @@ import Data.Functor ((<&>)) import Data.Proxy import Data.Typeable import GHC.Generics (Generic) +import GHC.Stack (HasCallStack) import NoThunks.Class (NoThunks (..)) import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config @@ -116,14 +117,13 @@ instance IsLedger (LedgerState blk) => GetTip (ExtLedgerState blk) where instance IsLedger (LedgerState blk) => GetTip (Ticked (ExtLedgerState blk)) where getTip = castPoint . getTip . tickedLedgerState -instance ( LedgerSupportsProtocol blk - ) +instance LedgerSupportsProtocol blk => IsLedger (ExtLedgerState blk) where type LedgerErr (ExtLedgerState blk) = ExtValidationError blk type AuxLedgerEvent (ExtLedgerState blk) = AuxLedgerEvent (LedgerState blk) - applyChainTickLedgerResult cfg slot (ExtLedgerState ledger header) = + applyChainTickLedgerResult evs cfg slot (ExtLedgerState ledger header) = castLedgerResult ledgerResult <&> \tickedLedgerState -> let ledgerView :: LedgerView (BlockProtocol blk) ledgerView = protocolLedgerView lcfg tickedLedgerState @@ -140,13 +140,31 @@ instance ( LedgerSupportsProtocol blk lcfg :: LedgerConfig blk lcfg = configLedger $ getExtLedgerCfg cfg - ledgerResult = applyChainTickLedgerResult lcfg slot ledger + ledgerResult = applyChainTickLedgerResult evs lcfg slot ledger -instance LedgerSupportsProtocol blk => ApplyBlock (ExtLedgerState blk) blk where - applyBlockLedgerResult cfg blk TickedExtLedgerState{..} = do +applyHelper :: + forall blk. + (HasCallStack, LedgerSupportsProtocol blk) + => ( HasCallStack + => ComputeLedgerEvents + -> LedgerCfg (LedgerState blk) + -> blk + -> Ticked (LedgerState blk) + -> Except + (LedgerErr (LedgerState blk)) + (LedgerResult (LedgerState blk) (LedgerState blk)) + ) + -> ComputeLedgerEvents + -> LedgerCfg (ExtLedgerState blk) + -> blk + -> Ticked (ExtLedgerState blk) + -> Except + (LedgerErr (ExtLedgerState blk)) + (LedgerResult (ExtLedgerState blk) (ExtLedgerState blk)) +applyHelper f opts cfg blk TickedExtLedgerState{..} = do ledgerResult <- withExcept ExtValidationErrorLedger - $ applyBlockLedgerResult + $ f opts (configLedger $ getExtLedgerCfg cfg) blk tickedLedgerState @@ -159,11 +177,18 @@ instance LedgerSupportsProtocol blk => ApplyBlock (ExtLedgerState blk) blk where tickedHeaderState pure $ (\l -> ExtLedgerState l hdr) <$> castLedgerResult ledgerResult - reapplyBlockLedgerResult cfg blk TickedExtLedgerState{..} = +instance LedgerSupportsProtocol blk => ApplyBlock (ExtLedgerState blk) blk where + applyBlockLedgerResultWithValidation doValidate = + applyHelper (applyBlockLedgerResultWithValidation doValidate) + + applyBlockLedgerResult = + applyHelper applyBlockLedgerResult + + reapplyBlockLedgerResult evs cfg blk TickedExtLedgerState{..} = (\l -> ExtLedgerState l hdr) <$> castLedgerResult ledgerResult where ledgerResult = - reapplyBlockLedgerResult + reapplyBlockLedgerResult evs (configLedger $ getExtLedgerCfg cfg) blk tickedLedgerState diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs index 028adc66d5..90bbc0ab24 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query.hs @@ -40,6 +40,7 @@ import Ouroboros.Consensus.Config import Ouroboros.Consensus.Config.SupportsNode import Ouroboros.Consensus.HeaderValidation (HasAnnTip (..), headerStateBlockNo, headerStatePoint) +import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.Query.Version import Ouroboros.Consensus.Node.NetworkProtocolVersion @@ -63,6 +64,7 @@ queryName query = case query of GetSystemStart -> "GetSystemStart" GetChainBlockNo -> "GetChainBlockNo" GetChainPoint -> "GetChainPoint" + GetLedgerConfig -> "GetLedgerConfig" -- | Different queries supported by the ledger for all block types, indexed -- by the result type. @@ -88,6 +90,13 @@ data Query blk result where -- Supported by 'QueryVersion' >= 'QueryVersion2'. GetChainPoint :: Query blk (Point blk) + -- | Get the ledger config. + -- + -- This constructor is supported by 'QueryVersion' >= 'QueryVersion3'. + -- Serialisation of the @LedgerConfig blk@ result is versioned by the + -- @BlockNodeToClientVersion blk@. + GetLedgerConfig :: Query blk (LedgerConfig blk) + instance (ShowProxy (BlockQuery blk)) => ShowProxy (Query blk) where showProxy (Proxy :: Proxy (Query blk)) = "Query (" ++ showProxy (Proxy @(BlockQuery blk)) ++ ")" @@ -96,6 +105,7 @@ instance (ShowQuery (BlockQuery blk), StandardHash blk) => ShowQuery (Query blk) showResult GetSystemStart = show showResult GetChainBlockNo = show showResult GetChainPoint = show + showResult GetLedgerConfig = const "LedgerConfig{..}" instance Eq (SomeSecond BlockQuery blk) => Eq (SomeSecond Query blk) where SomeSecond (BlockQuery blockQueryA) == SomeSecond (BlockQuery blockQueryB) @@ -111,11 +121,15 @@ instance Eq (SomeSecond BlockQuery blk) => Eq (SomeSecond Query blk) where SomeSecond GetChainPoint == SomeSecond GetChainPoint = True SomeSecond GetChainPoint == _ = False + SomeSecond GetLedgerConfig == SomeSecond GetLedgerConfig = True + SomeSecond GetLedgerConfig == _ = False + instance Show (SomeSecond BlockQuery blk) => Show (SomeSecond Query blk) where show (SomeSecond (BlockQuery blockQueryA)) = "Query " ++ show (SomeSecond blockQueryA) show (SomeSecond GetSystemStart) = "Query GetSystemStart" show (SomeSecond GetChainBlockNo) = "Query GetChainBlockNo" show (SomeSecond GetChainPoint) = "Query GetChainPoint" + show (SomeSecond GetLedgerConfig) = "Query GetLedgerConfig" -- | Exception thrown in the encoders @@ -167,6 +181,11 @@ queryEncodeNodeToClient codecConfig queryVersion blockVersion (SomeSecond query) , encodeWord8 3 ] + GetLedgerConfig -> + requireVersion QueryVersion3 $ mconcat + [ encodeListLen 1 + , encodeWord8 4 + ] where requireVersion :: QueryVersion -> a -> a requireVersion expectedVersion a = @@ -193,6 +212,7 @@ queryDecodeNodeToClient codecConfig queryVersion blockVersion = case queryVersion of QueryVersion1 -> handleTopLevelQuery QueryVersion2 -> handleTopLevelQuery + QueryVersion3 -> handleTopLevelQuery where handleTopLevelQuery :: Decoder s (SomeSecond Query blk) handleTopLevelQuery = do @@ -203,6 +223,7 @@ queryDecodeNodeToClient codecConfig queryVersion blockVersion (1, 1) -> requireVersion QueryVersion1 $ SomeSecond GetSystemStart (1, 2) -> requireVersion QueryVersion2 $ SomeSecond GetChainBlockNo (1, 3) -> requireVersion QueryVersion2 $ SomeSecond GetChainPoint + (1, 4) -> requireVersion QueryVersion3 $ SomeSecond GetLedgerConfig _ -> fail $ "Query: invalid size and tag" <> show (size, tag) requireVersion :: @@ -226,6 +247,7 @@ queryDecodeNodeToClient codecConfig queryVersion blockVersion instance ( SerialiseResult blk (BlockQuery blk) , Serialise (HeaderHash blk) + , SerialiseNodeToClient blk (LedgerConfig blk) ) => SerialiseResult blk (Query blk) where encodeResult codecConfig blockVersion (BlockQuery blockQuery) result = encodeResult codecConfig blockVersion blockQuery result @@ -235,6 +257,8 @@ instance ( SerialiseResult blk (BlockQuery blk) = toCBOR result encodeResult _ _ GetChainPoint result = encodePoint encode result + encodeResult codecConfig blockVersion GetLedgerConfig result + = encodeNodeToClient codecConfig blockVersion result decodeResult codecConfig blockVersion (BlockQuery query) = decodeResult codecConfig blockVersion query @@ -244,6 +268,8 @@ instance ( SerialiseResult blk (BlockQuery blk) = fromCBOR decodeResult _ _ GetChainPoint = decodePoint decode + decodeResult codecConfig blockVersion GetLedgerConfig + = decodeNodeToClient @blk @(LedgerConfig blk) codecConfig blockVersion instance SameDepIndex (BlockQuery blk) => SameDepIndex (Query blk) where sameDepIndex (BlockQuery blockQueryA) (BlockQuery blockQueryB) @@ -262,6 +288,10 @@ instance SameDepIndex (BlockQuery blk) => SameDepIndex (Query blk) where = Just Refl sameDepIndex GetChainPoint _ = Nothing + sameDepIndex GetLedgerConfig GetLedgerConfig + = Just Refl + sameDepIndex GetLedgerConfig _ + = Nothing deriving instance Show (BlockQuery blk result) => Show (Query blk result) @@ -277,6 +307,7 @@ answerQuery cfg query st = case query of GetSystemStart -> getSystemStart (topLevelConfigBlock (getExtLedgerCfg cfg)) GetChainBlockNo -> headerStateBlockNo (headerState st) GetChainPoint -> headerStatePoint (headerState st) + GetLedgerConfig -> topLevelConfigLedger (getExtLedgerCfg cfg) -- | Different queries supported by the ledger, indexed by the result type. data family BlockQuery blk :: Type -> Type diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query/Version.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query/Version.hs index 5eea4d6674..c2a605864a 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query/Version.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query/Version.hs @@ -15,6 +15,9 @@ data QueryVersion -- Adds support for 'GetChainBlockNo' and 'GetChainPoint'. | QueryVersion2 + + -- Adds support for 'GetLedgerConfig' + | QueryVersion3 deriving (Eq, Ord, Enum, Bounded, Show) -- | Get the @QueryVersion@ supported by this @NodeToClientVersion@. @@ -24,3 +27,4 @@ nodeToClientVersionToQueryVersion x = case x of NodeToClientV_17 -> QueryVersion2 NodeToClientV_18 -> QueryVersion2 NodeToClientV_19 -> QueryVersion2 + NodeToClientV_20 -> QueryVersion3 diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs index 605c66bf00..6dbb9c9add 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs @@ -19,6 +19,7 @@ module Ouroboros.Consensus.Ledger.SupportsMempool ( , LedgerSupportsMempool (..) , TxId , TxLimits (..) + , TxMeasureMetrics (..) , Validated , WhetherToIntervene (..) ) where @@ -35,6 +36,7 @@ import qualified Data.Measure import Data.Word (Word32) import GHC.Stack (HasCallStack) import NoThunks.Class +import Numeric.Natural import Ouroboros.Consensus.Block.Abstract import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ticked @@ -172,10 +174,11 @@ class HasTxs blk where -- bit more complex as it had to take other factors into account (like -- execution units). For details please see the individual instances for the -- TxLimits. -class ( Measure (TxMeasure blk) - , HasByteSize (TxMeasure blk) - , NoThunks (TxMeasure blk) - , Show (TxMeasure blk) +class ( Measure (TxMeasure blk) + , HasByteSize (TxMeasure blk) + , NoThunks (TxMeasure blk) + , TxMeasureMetrics (TxMeasure blk) + , Show (TxMeasure blk) ) => TxLimits blk where -- | The (possibly multi-dimensional) size of a transaction in a block. type TxMeasure blk @@ -271,6 +274,7 @@ newtype IgnoringOverflow a = IgnoringOverflow { unIgnoringOverflow :: a } deriving newtype (Monoid, Semigroup) deriving newtype (NoThunks) deriving newtype (HasByteSize) + deriving newtype (TxMeasureMetrics) instance Measure (IgnoringOverflow ByteSize32) where zero = coerce (0 :: Word32) @@ -284,3 +288,15 @@ class HasByteSize a where instance HasByteSize ByteSize32 where txMeasureByteSize = id + +class TxMeasureMetrics msr where + txMeasureMetricTxSizeBytes :: msr -> ByteSize32 + txMeasureMetricExUnitsMemory :: msr -> Natural + txMeasureMetricExUnitsSteps :: msr -> Natural + txMeasureMetricRefScriptsSizeBytes :: msr -> ByteSize32 + +instance TxMeasureMetrics ByteSize32 where + txMeasureMetricTxSizeBytes = id + txMeasureMetricExUnitsMemory _ = 0 + txMeasureMetricExUnitsSteps _ = 0 + txMeasureMetricRefScriptsSizeBytes _ = mempty diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsProtocol.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsProtocol.hs index 90939ac31c..9077d77a19 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsProtocol.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsProtocol.hs @@ -83,7 +83,7 @@ _lemma_ledgerViewForecastAt_applyChainTick cfg st forecast for | NotOrigin for >= ledgerTipSlot st , let lhs = forecastFor forecast for rhs = protocolLedgerView cfg - . applyChainTick cfg for + . applyChainTick OmitLedgerEvents cfg for $ st , Right lhs' <- runExcept lhs , lhs' /= rhs diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs index bb4841f044..cd7cedd41a 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs @@ -320,13 +320,12 @@ data ForgeLedgerState blk = data MempoolSnapshot blk = MempoolSnapshot { -- | Get all transactions (oldest to newest) in the mempool snapshot along -- with their ticket number. - snapshotTxs :: [(Validated (GenTx blk), TicketNo, ByteSize32)] + snapshotTxs :: [(Validated (GenTx blk), TicketNo, TxMeasure blk)] -- | Get all transactions (oldest to newest) in the mempool snapshot, -- along with their ticket number, which are associated with a ticket -- number greater than the one provided. - , snapshotTxsAfter :: - TicketNo -> [(Validated (GenTx blk), TicketNo, ByteSize32)] + , snapshotTxsAfter :: TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)] -- | Get the greatest prefix (oldest to newest) that respects the given -- block capacity. diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs index 0e67f2e210..fe1f237222 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs @@ -235,8 +235,8 @@ tickLedgerState :: -> ForgeLedgerState blk -> (SlotNo, TickedLedgerState blk) tickLedgerState _cfg (ForgeInKnownSlot slot st) = (slot, st) -tickLedgerState cfg (ForgeInUnknownSlot st) = - (slot, applyChainTick cfg slot st) +tickLedgerState cfg (ForgeInUnknownSlot st) = + (slot, applyChainTick OmitLedgerEvents cfg slot st) where -- Optimistically assume that the transactions will be included in a block -- in the next available slot @@ -431,12 +431,12 @@ snapshotFromIS is = MempoolSnapshot { } where implSnapshotGetTxs :: InternalState blk - -> [(Validated (GenTx blk), TicketNo, ByteSize32)] + -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)] implSnapshotGetTxs = flip implSnapshotGetTxsAfter TxSeq.zeroTicketNo implSnapshotGetTxsAfter :: InternalState blk -> TicketNo - -> [(Validated (GenTx blk), TicketNo, ByteSize32)] + -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)] implSnapshotGetTxsAfter IS{isTxs} = TxSeq.toTuples . snd . TxSeq.splitAfterTicketNo isTxs diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/TxSeq.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/TxSeq.hs index a3f932a02b..39180d323c 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/TxSeq.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/TxSeq.hs @@ -38,8 +38,6 @@ import qualified Data.Measure as Measure import Data.Word (Word64) import GHC.Generics (Generic) import NoThunks.Class (NoThunks) -import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32, - HasByteSize, txMeasureByteSize) {------------------------------------------------------------------------------- Mempool transaction sequence as a finger tree @@ -256,13 +254,13 @@ toList :: TxSeq sz tx -> [TxTicket sz tx] toList (TxSeq ftree) = Foldable.toList ftree -- | Convert a 'TxSeq' to a list of pairs of transactions and their --- associated 'TicketNo's and 'ByteSize32's. -toTuples :: HasByteSize sz => TxSeq sz tx -> [(tx, TicketNo, ByteSize32)] +-- associated 'TicketNo's and sizes. +toTuples :: TxSeq sz tx -> [(tx, TicketNo, sz)] toTuples (TxSeq ftree) = fmap (\ticket -> ( txTicketTx ticket , txTicketNo ticket - , txMeasureByteSize (txTicketSize ticket) + , txTicketSize ticket ) ) (Foldable.toList ftree) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs index 7748ab7ac7..8abc664fa1 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs @@ -13,6 +13,10 @@ module Ouroboros.Consensus.MiniProtocol.BlockFetch.ClientInterface ( , readFetchModeDefault ) where +import Cardano.Network.ConsensusMode (ConsensusMode) +import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers, + requiresBootstrapPeers) +import Cardano.Network.Types (LedgerStateJudgement) import Control.Monad import Control.Tracer (Tracer) import Data.Map.Strict (Map) @@ -44,14 +48,9 @@ import Ouroboros.Network.AnchoredFragment (AnchoredFragment) import qualified Ouroboros.Network.AnchoredFragment as AF import Ouroboros.Network.Block (MaxSlotNo) import Ouroboros.Network.BlockFetch.ConsensusInterface - (BlockFetchConsensusInterface (..), - ChainSelStarvation (..), FetchMode (..), - FromConsensus (..), PraosFetchMode (..), mkReadFetchMode) -import Ouroboros.Network.ConsensusMode (ConsensusMode) -import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers, - requiresBootstrapPeers) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type - (LedgerStateJudgement) + (BlockFetchConsensusInterface (..), ChainSelStarvation, + FetchMode (..), FromConsensus (..), PraosFetchMode (..), + mkReadFetchMode) import Ouroboros.Network.SizeInBytes -- | Abstract over the ChainDB diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs index d9a70817d9..21545e49d7 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs @@ -74,6 +74,7 @@ module Ouroboros.Consensus.MiniProtocol.ChainSync.Client ( , viewChainSyncState ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Monad (join, void) import Control.Monad.Class.MonadTimer (MonadTimer) import Control.Monad.Except (runExcept, throwError) @@ -694,7 +695,7 @@ checkKnownIntersectionInvariants cfg kis -- 'ourFrag' invariants | let nbHeaders = AF.length ourFrag ourAnchorPoint = AF.anchorPoint ourFrag - , nbHeaders < fromIntegral k + , nbHeaders < fromIntegral (unNonZero k) , ourAnchorPoint /= GenesisPoint = throwError $ unwords [ "ourFrag contains fewer than k headers and not close to genesis:" @@ -1967,7 +1968,7 @@ mkOffsets :: SecurityParam -> Word64 -> [Word64] mkOffsets (SecurityParam k) maxOffset = [0] ++ takeWhile (< l) [fib n | n <- [2..]] ++ [l] where - l = k `min` maxOffset + l = unNonZero k `min` maxOffset ourTipFromChain :: HasHeader (Header blk) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs index 7e4c59a8e9..bc8eb2e0de 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/LocalTxMonitor/Server.hs @@ -1,10 +1,16 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} module Ouroboros.Consensus.MiniProtocol.LocalTxMonitor.Server (localTxMonitorServer) where +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import qualified Data.Measure as Measure import Ouroboros.Consensus.Block import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Mempool @@ -33,20 +39,20 @@ localTxMonitorServer mempool = , recvMsgAcquire = do s <- atomically $ (,) - <$> (txMeasureByteSize <$> getCapacity mempool) + <$> getCapacity mempool <*> getSnapshot mempool pure $ serverStAcquiring s } serverStAcquiring - :: (ByteSize32, MempoolSnapshot blk) + :: (TxMeasure blk, MempoolSnapshot blk) -> ServerStAcquiring (GenTxId blk) (GenTx blk) SlotNo m () serverStAcquiring s@(_, snapshot) = SendMsgAcquired (snapshotSlotNo snapshot) (serverStAcquired s (snapshotTxs snapshot)) serverStAcquired - :: (ByteSize32, MempoolSnapshot blk) - -> [(Validated (GenTx blk), idx, ByteSize32)] + :: (TxMeasure blk, MempoolSnapshot blk) + -> [(Validated (GenTx blk), idx, TxMeasure blk)] -> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m () serverStAcquired s@(capacity, snapshot) txs = ServerStAcquired @@ -61,16 +67,25 @@ localTxMonitorServer mempool = , recvMsgGetSizes = do let MempoolSize{msNumTxs,msNumBytes} = snapshotMempoolSize snapshot let sizes = MempoolSizeAndCapacity - { capacityInBytes = unByteSize32 capacity - , sizeInBytes = unByteSize32 msNumBytes + { capacityInBytes = unByteSize32 $ txMeasureByteSize capacity + , sizeInBytes = unByteSize32 $ txMeasureByteSize msNumBytes , numberOfTxs = msNumTxs } pure $ SendMsgReplyGetSizes sizes (serverStAcquired s txs) + , recvMsgGetMeasures = do + let txsMeasures = + foldl (\acc (_, _, m) -> Measure.plus acc m) Measure.zero txs + measures = MempoolMeasures + { txCount = fromIntegral $ length txs + , measuresMap = + mkMeasuresMap (Proxy :: Proxy blk) txsMeasures capacity + } -- TODO what to do about overflow? + pure $ SendMsgReplyGetMeasures measures (serverStAcquired s txs) , recvMsgAwaitAcquire = do s' <- atomically $ do s'@(_, snapshot') <- (,) - <$> (txMeasureByteSize <$> getCapacity mempool) + <$> getCapacity mempool <*> getSnapshot mempool s' <$ check (not (snapshot `isSameSnapshot` snapshot')) pure $ serverStAcquiring s' @@ -89,3 +104,31 @@ localTxMonitorServer mempool = snapshotSlotNo a == snapshotSlotNo b tno (_a, b, _c) = b :: TicketNo + +mkMeasuresMap :: TxMeasureMetrics (TxMeasure blk) + => Proxy blk + -> TxMeasure blk + -> TxMeasure blk + -> Map MeasureName (SizeAndCapacity Integer) +mkMeasuresMap Proxy size capacity = + Map.fromList + [ (TransactionBytes, SizeAndCapacity (byteSizeInteger $ txMeasureMetricTxSizeBytes size) (byteSizeInteger $ txMeasureMetricTxSizeBytes capacity)) + , (ExUnitsMemory, SizeAndCapacity (fromIntegral $ txMeasureMetricExUnitsMemory size) (fromIntegral $ txMeasureMetricExUnitsMemory capacity)) + , (ExUnitsSteps, SizeAndCapacity (fromIntegral $ txMeasureMetricExUnitsSteps size) (fromIntegral $ txMeasureMetricExUnitsSteps capacity)) + , (ReferenceScriptsBytes, SizeAndCapacity (byteSizeInteger $ txMeasureMetricRefScriptsSizeBytes size) (byteSizeInteger $ txMeasureMetricRefScriptsSizeBytes capacity)) + ] + where + byteSizeInteger :: ByteSize32 -> Integer + byteSizeInteger = fromIntegral . unByteSize32 + +pattern TransactionBytes :: MeasureName +pattern TransactionBytes = MeasureName "transaction_bytes" + +pattern ExUnitsSteps :: MeasureName +pattern ExUnitsSteps = MeasureName "ex_units_steps" + +pattern ExUnitsMemory :: MeasureName +pattern ExUnitsMemory = MeasureName "ex_units_memory" + +pattern ReferenceScriptsBytes :: MeasureName +pattern ReferenceScriptsBytes = MeasureName "reference_scripts_bytes" diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs index 1fe2ae42ee..6f5512497b 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Run.hs @@ -21,6 +21,7 @@ import Data.Typeable (Typeable) import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config.SupportsNode import Ouroboros.Consensus.HardFork.Abstract +import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.CommonProtocolParams import Ouroboros.Consensus.Ledger.Inspect import Ouroboros.Consensus.Ledger.Query @@ -72,7 +73,9 @@ class ( Typeable blk , SerialiseNodeToClient blk SlotNo , SerialiseNodeToClient blk (ApplyTxErr blk) , SerialiseNodeToClient blk (SomeSecond BlockQuery blk) + , SerialiseNodeToClient blk (LedgerConfig blk) , SerialiseResult blk (BlockQuery blk) + , SerialiseNodeToClient blk (LedgerConfig blk) ) => SerialiseNodeToClientConstraints blk class ( LedgerSupportsProtocol blk diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs index 71f10eaafb..6a47a2e9bb 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs @@ -1,8 +1,12 @@ {-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -- | Serialisation for sending things across the network. @@ -30,6 +34,7 @@ import Codec.CBOR.Encoding (Encoding) import Codec.Serialise (Serialise (decode, encode)) import Data.SOP.BasicFunctors import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId) import Ouroboros.Consensus.Node.NetworkProtocolVersion @@ -125,37 +130,20 @@ defaultDecodeCBORinCBOR = unwrapCBORinCBOR (const <$> decode) Forwarding instances -------------------------------------------------------------------------------} -instance SerialiseNodeToNode blk blk - => SerialiseNodeToNode blk (I blk) where - encodeNodeToNode cfg version (I h) = - encodeNodeToNode cfg version h - decodeNodeToNode cfg version = - I <$> decodeNodeToNode cfg version - -instance SerialiseNodeToClient blk blk - => SerialiseNodeToClient blk (I blk) where - encodeNodeToClient cfg version (I h) = - encodeNodeToClient cfg version h - decodeNodeToClient cfg version = - I <$> decodeNodeToClient cfg version - -instance SerialiseNodeToNode blk (GenTxId blk) - => SerialiseNodeToNode blk (WrapGenTxId blk) where - encodeNodeToNode cfg version (WrapGenTxId h) = - encodeNodeToNode cfg version h - decodeNodeToNode cfg version = - WrapGenTxId <$> decodeNodeToNode cfg version - -instance SerialiseNodeToClient blk (GenTxId blk) - => SerialiseNodeToClient blk (WrapGenTxId blk) where - encodeNodeToClient cfg version (WrapGenTxId h) = - encodeNodeToClient cfg version h - decodeNodeToClient cfg version = - WrapGenTxId <$> decodeNodeToClient cfg version - -instance SerialiseNodeToClient blk (ApplyTxErr blk) - => SerialiseNodeToClient blk (WrapApplyTxErr blk) where - encodeNodeToClient cfg version (WrapApplyTxErr h) = - encodeNodeToClient cfg version h - decodeNodeToClient cfg version = - WrapApplyTxErr <$> decodeNodeToClient cfg version +deriving newtype instance SerialiseNodeToNode blk blk + => SerialiseNodeToNode blk (I blk) + +deriving newtype instance SerialiseNodeToClient blk blk + => SerialiseNodeToClient blk (I blk) + +deriving newtype instance SerialiseNodeToNode blk (GenTxId blk) + => SerialiseNodeToNode blk (WrapGenTxId blk) + +deriving newtype instance SerialiseNodeToClient blk (GenTxId blk) + => SerialiseNodeToClient blk (WrapGenTxId blk) + +deriving newtype instance SerialiseNodeToClient blk (ApplyTxErr blk) + => SerialiseNodeToClient blk (WrapApplyTxErr blk) + +deriving newtype instance SerialiseNodeToClient blk (LedgerConfig blk) + => SerialiseNodeToClient blk (WrapLedgerConfig blk) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/NodeId.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/NodeId.hs index 0dee0aa33f..9bee308faa 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/NodeId.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/NodeId.hs @@ -2,6 +2,9 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} module Ouroboros.Consensus.NodeId ( -- * Node IDs @@ -12,9 +15,10 @@ module Ouroboros.Consensus.NodeId ( , fromCoreNodeId ) where +import Cardano.Binary import qualified Codec.CBOR.Decoding as CBOR import qualified Codec.CBOR.Encoding as CBOR -import Codec.Serialise (Serialise) +import Codec.Serialise (Serialise (..)) import Data.Hashable import Data.Word import GHC.Generics (Generic) @@ -33,6 +37,24 @@ data NodeId = CoreId !CoreNodeId | RelayId !Word64 deriving (Eq, Ord, Show, Generic, NoThunks) +instance FromCBOR NodeId where + fromCBOR = do + len <- decodeListLen + tag <- decodeWord8 + case (len, tag) of + (2, 0) -> CoreId <$> fromCBOR @CoreNodeId + (2, 1) -> RelayId <$> fromCBOR @Word64 + _ -> fail $ "NodeId: unknown (len, tag) " ++ show (len, tag) + +instance ToCBOR NodeId where + toCBOR nodeId = case nodeId of + CoreId x -> encodeListLen 2 <> encodeWord8 0 <> toCBOR x + RelayId x -> encodeListLen 2 <> encodeWord8 1 <> toCBOR x + +instance Serialise NodeId where + decode = fromCBOR + encode = toCBOR + instance Condense NodeId where condense (CoreId (CoreNodeId i)) = "c" ++ show i condense (RelayId i ) = "r" ++ show i @@ -44,7 +66,7 @@ newtype CoreNodeId = CoreNodeId { unCoreNodeId :: Word64 } deriving stock (Eq, Ord, Generic) - deriving newtype (Condense, Serialise, NoThunks) + deriving newtype (Condense, FromCBOR, ToCBOR, NoThunks) deriving Show via Quiet CoreNodeId instance Hashable CoreNodeId @@ -69,5 +91,9 @@ decodeNodeId = do 1 -> RelayId <$> CBOR.decodeWord64 _ -> fail ("decodeNodeId: unknown tok:" ++ show tok) +instance Serialise CoreNodeId where + decode = fromCBOR + encode = toCBOR + fromCoreNodeId :: CoreNodeId -> NodeId fromCoreNodeId = CoreId diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs index 8859ba501f..184ed513ba 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs @@ -51,6 +51,7 @@ module Ouroboros.Consensus.Protocol.PBFT ( ) where import Cardano.Crypto.DSIGN.Class +import Cardano.Ledger.BaseTypes (unNonZero) import Codec.Serialise (Serialise (..)) import qualified Control.Exception as Exn import Control.Monad (unless) @@ -406,7 +407,7 @@ pbftWindowParams PBftConfig{..} = PBftWindowParams { -- -- We set the window size to be equal to k. pbftWindowSize :: SecurityParam -> S.WindowSize -pbftWindowSize (SecurityParam k) = S.WindowSize k +pbftWindowSize (SecurityParam k) = S.WindowSize $ unNonZero k -- | Does the number of blocks signed by this key exceed the threshold? -- diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/Crypto.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/Crypto.hs index 2694db8365..97648bdbcd 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/Crypto.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/Crypto.hs @@ -38,6 +38,7 @@ class ( Typeable c , Show (PBftVerKeyHash c) , NoThunks (PBftVerKeyHash c) , NoThunks (PBftDelegationCert c) + , Serialise (PBftVerKeyHash c) ) => PBftCrypto c where type family PBftDSIGN c :: Type type family PBftDelegationCert c = (d :: Type) | d -> c diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/State.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/State.hs index 28d8848935..5c5ed29814 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/State.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT/State.hs @@ -288,14 +288,14 @@ uninvert = . Map.toList encodePBftState :: - (PBftCrypto c, Serialise (PBftVerKeyHash c)) + PBftCrypto c => PBftState c -> Encoding encodePBftState st = encodeVersion serializationFormatVersion1 $ encode (invert st) decodePBftState :: - forall c. (PBftCrypto c, Serialise (PBftVerKeyHash c)) + forall c. PBftCrypto c => forall s. Decoder s (PBftState c) decodePBftState = decodeVersion [(serializationFormatVersion1, Decode decodePBftState1)] diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs index 9b88506e0b..aad189ccca 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs @@ -12,6 +12,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Args ( , RelativeMountPoint (..) , completeChainDbArgs , defaultArgs + , enableLedgerEvents , ensureValidateAll , updateDiskPolicyArgs , updateTracer @@ -19,11 +20,13 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Args ( import Control.ResourceRegistry (ResourceRegistry) import Control.Tracer (Tracer, nullTracer) +import Data.Function ((&)) import Data.Functor.Contravariant ((>$<)) import Data.Kind import Data.Time.Clock (secondsToDiffTime) import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config +import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Storage.ChainDB.API (GetLoEFragment, @@ -185,7 +188,10 @@ completeChainDbArgs , cdbLgrDbArgs = (cdbLgrDbArgs defArgs) { LedgerDB.lgrGenesis = pure initLedger , LedgerDB.lgrHasFS = mkVolFS $ RelativeMountPoint "ledger" - , LedgerDB.lgrConfig = LedgerDB.configLedgerDb cdbsTopLevelConfig + , LedgerDB.lgrConfig = + LedgerDB.configLedgerDb + cdbsTopLevelConfig + (LedgerDB.ledgerDbCfgComputeLedgerEvents $ LedgerDB.lgrConfig (cdbLgrDbArgs defArgs)) } , cdbsArgs = (cdbsArgs defArgs) { cdbsRegistry = registry @@ -213,6 +219,16 @@ updateDiskPolicyArgs :: updateDiskPolicyArgs spa args = args { cdbLgrDbArgs = (cdbLgrDbArgs args) { LedgerDB.lgrDiskPolicyArgs = spa } } +enableLedgerEvents :: + Complete ChainDbArgs m blk + -> Complete ChainDbArgs m blk +enableLedgerEvents args = + args { cdbLgrDbArgs = (cdbLgrDbArgs args) & \x -> + x { LedgerDB.lgrConfig = + (LedgerDB.lgrConfig x) { LedgerDB.ledgerDbCfgComputeLedgerEvents = ComputeLedgerEvents } + } + } + {------------------------------------------------------------------------------- Relative mount points -------------------------------------------------------------------------------} diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs index 9d7c31af8a..297ba75a09 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs @@ -36,6 +36,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Background ( , addBlockRunner ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Exception (assert) import Control.Monad (forM_, forever, void) import Control.Monad.Trans.Class (lift) @@ -133,7 +134,7 @@ copyToImmutableDB :: copyToImmutableDB CDB{..} = electric $ do toCopy <- atomically $ do curChain <- readTVar cdbChain - let nbToCopy = max 0 (AF.length curChain - fromIntegral k) + let nbToCopy = max 0 (AF.length curChain - fromIntegral (unNonZero k)) toCopy :: [Point blk] toCopy = map headerPoint $ AF.toOldestFirst @@ -244,8 +245,8 @@ copyAndSnapshotRunner cdb@CDB{..} gcSchedule replayed fuse = -- Wait for the chain to grow larger than @k@ numToWrite <- atomically $ do curChain <- readTVar cdbChain - check $ fromIntegral (AF.length curChain) > k - return $ fromIntegral (AF.length curChain) - k + check $ fromIntegral (AF.length curChain) > unNonZero k + return $ fromIntegral (AF.length curChain) - unNonZero k -- Copy blocks to ImmutableDB -- diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs index 2a25cfcdd1..38eab78a5b 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs @@ -20,6 +20,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel ( , olderThanK ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Exception (assert) import Control.Monad (forM, forM_, when) import Control.Monad.Except () @@ -184,7 +185,7 @@ initialChainSelection immutableDB volatileDB lgrDB tracer cfg varInvalid -- adversarial (ie the LoE did not allow the node to select it when it -- arrived). suffixesAfterI :: [NonEmpty (HeaderHash blk)] - suffixesAfterI = Paths.maximalCandidates succsOf limit (AF.anchorToPoint i) + suffixesAfterI = Paths.maximalCandidates succsOf (unNonZero <$> limit) (AF.anchorToPoint i) where limit = case loE of LoEDisabled -> Nothing @@ -508,7 +509,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do -- The current chain we're working with here is not longer than @k@ -- blocks (see 'getCurrentChain' and 'cdbChain'), which is easier to -- reason about when doing chain selection, etc. - assert (fromIntegral (AF.length curChain) <= k) $ + assert (fromIntegral (AF.length curChain) <= unNonZero k) $ VF.ValidatedFragment curChain ledgerDB immBlockNo :: WithOrigin BlockNo @@ -701,7 +702,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do case AF.intersect cand loe of Nothing -> error "trimToLoE: precondition 2 violated: the LoE fragment must intersect with the current selection" Just (candPrefix, _, candSuffix, loeSuffix) -> - let trimmedCandSuffix = AF.takeOldest (fromIntegral k) candSuffix + let trimmedCandSuffix = AF.takeOldest (fromIntegral $ unNonZero k) candSuffix trimmedCand = if AF.null loeSuffix then fromJust $ AF.join candPrefix trimmedCandSuffix diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs index c3d6ae008a..1de3e8bd09 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs @@ -69,6 +69,7 @@ import Ouroboros.Consensus.Storage.ChainDB.API (ChainDbFailure (..)) import Ouroboros.Consensus.Storage.ChainDB.Impl.BlockCache (BlockCache) import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.BlockCache as BlockCache +import Ouroboros.Consensus.Storage.Common (LedgerDBPruneTip (..)) import Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB) import Ouroboros.Consensus.Storage.ImmutableDB.Stream import Ouroboros.Consensus.Storage.LedgerDB (LedgerDB') @@ -127,7 +128,7 @@ data LgrDbArgs f m blk = LgrDbArgs { lgrDiskPolicyArgs :: LedgerDB.DiskPolicyArgs , lgrGenesis :: HKD f (m (ExtLedgerState blk)) , lgrHasFS :: HKD f (SomeHasFS m) - , lgrConfig :: HKD f (LedgerDB.LedgerDbCfg (ExtLedgerState blk)) + , lgrConfig :: LedgerDB.LedgerDbCfgF f (ExtLedgerState blk) , lgrTracer :: Tracer m (LedgerDB.TraceSnapshotEvent blk) } @@ -137,7 +138,7 @@ defaultArgs = LgrDbArgs { lgrDiskPolicyArgs = LedgerDB.defaultDiskPolicyArgs , lgrGenesis = noDefault , lgrHasFS = noDefault - , lgrConfig = noDefault + , lgrConfig = LedgerDB.LedgerDbCfg noDefault noDefault OmitLedgerEvents , lgrTracer = nullTracer } @@ -190,7 +191,7 @@ openDB args@LgrDbArgs { lgrHasFS = lgrHasFS@(SomeHasFS hasFS), .. } replayTracer -- >k blocks long. Thus 'Lbn' is the oldest point we can roll back to. -- Therefore, we need to make the newest state (current) of the ledger DB -- the anchor. - let dbPrunedToImmDBTip = LedgerDB.ledgerDbPrune (SecurityParam 0) db + let dbPrunedToImmDBTip = LedgerDB.ledgerDbPrune LedgerDBPruneTipZero db (varDB, varPrevApplied) <- (,) <$> newTVarIO dbPrunedToImmDBTip <*> newTVarIO Set.empty return ( diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs index 9d03c5f5a0..b509f804bb 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs @@ -25,6 +25,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Query ( , getChainSelStarvation ) where +import Cardano.Ledger.BaseTypes (unNonZero) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Ouroboros.Consensus.Block @@ -78,7 +79,7 @@ getCurrentChain :: => ChainDbEnv m blk -> STM m (AnchoredFragment (Header blk)) getCurrentChain CDB{..} = - AF.anchorNewest k <$> readTVar cdbChain + AF.anchorNewest (unNonZero k) <$> readTVar cdbChain where SecurityParam k = configSecurityParam cdbTopLevelConfig diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/Common.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/Common.hs index 6da304ff11..91555b930f 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/Common.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/Common.hs @@ -13,6 +13,8 @@ module Ouroboros.Consensus.Storage.Common ( , PrefixLen (..) , addPrefixLen , takePrefix + -- * Pruning + , LedgerDBPruneTip (..) -- * BinaryBlockInfo , BinaryBlockInfo (..) , extractHeader @@ -34,6 +36,7 @@ import Data.Word import GHC.Generics (Generic) import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Protocol.Abstract (SecurityParam) import Ouroboros.Network.SizeInBytes (SizeInBytes) {------------------------------------------------------------------------------- @@ -65,6 +68,21 @@ takePrefix :: PrefixLen -> BL.ByteString -> ShortByteString takePrefix (PrefixLen n) = Short.toShort . BL.toStrict . BL.take (fromIntegral n) +{------------------------------------------------------------------------------- + Pruning +-------------------------------------------------------------------------------} + +-- | The "tip" to prune snapshots from. +-- +-- `SecurityParam` has been updated to use `NonZero` but we need to prune from +-- @0@ in some cases. +-- +-- Rather than using a plain `Word64` we use this to be able to distinguish that +-- we are indeed using +-- 1. @0@ in places where it is necessary +-- 2. the security parameter as is, in other places +data LedgerDBPruneTip = LedgerDBPruneTipZero | LedgerDBPruneTip SecurityParam + {------------------------------------------------------------------------------- BinaryBlockInfo -------------------------------------------------------------------------------} diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs index abfad3fdc6..d9377953e1 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs @@ -82,7 +82,8 @@ module Ouroboros.Consensus.Storage.LedgerDB ( Checkpoint (..) , LedgerDB (..) , LedgerDB' - , LedgerDbCfg (..) + , LedgerDbCfg + , LedgerDbCfgF (..) , configLedgerDb -- * Initialization , InitLog (..) @@ -172,7 +173,8 @@ import Ouroboros.Consensus.Storage.LedgerDB.Init (InitLog (..), decorateReplayTracerWithGoal, decorateReplayTracerWithStart, initLedgerDB) import Ouroboros.Consensus.Storage.LedgerDB.LedgerDB (Checkpoint (..), - LedgerDB (..), LedgerDB', LedgerDbCfg (..), configLedgerDb) + LedgerDB (..), LedgerDB', LedgerDbCfg, LedgerDbCfgF (..), + configLedgerDb) import Ouroboros.Consensus.Storage.LedgerDB.Query (ledgerDbAnchor, ledgerDbCurrent, ledgerDbIsSaturated, ledgerDbMaxRollback, ledgerDbPast, ledgerDbSnapshots, ledgerDbTip) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/DiskPolicy.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/DiskPolicy.hs index 44c17b06ed..c64d7313c9 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/DiskPolicy.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/DiskPolicy.hs @@ -20,6 +20,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy ( , Flag (..) ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Monad.Class.MonadTime.SI import Data.Time.Clock (secondsToDiffTime) import Data.Word @@ -139,7 +140,7 @@ mkDiskPolicy (SecurityParam k) (DiskPolicyArgs reqInterval reqNumOfSnapshots onD -- take a snapshot roughly every @k@ blocks. It does mean the possibility of -- an extra unnecessary snapshot during syncing (if the node is restarted), but -- that is not a big deal. - blocksSinceLast >= k + blocksSinceLast >= unNonZero k onDiskShouldTakeSnapshot (TimeSinceLast timeSinceLast) blocksSinceLast = timeSinceLast >= snapshotInterval @@ -163,4 +164,4 @@ mkDiskPolicy (SecurityParam k) (DiskPolicyArgs reqInterval reqNumOfSnapshots onD -- defaults to 72 minutes. snapshotInterval = case reqInterval of RequestedSnapshotInterval value -> value - DefaultSnapshotInterval -> secondsToDiffTime $ fromIntegral $ k * 2 + DefaultSnapshotInterval -> secondsToDiffTime $ fromIntegral $ unNonZero k * 2 diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/LedgerDB.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/LedgerDB.hs index 15e2745c26..2498353501 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/LedgerDB.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/LedgerDB.hs @@ -12,7 +12,8 @@ module Ouroboros.Consensus.Storage.LedgerDB.LedgerDB ( Checkpoint (..) , LedgerDB (..) , LedgerDB' - , LedgerDbCfg (..) + , LedgerDbCfg + , LedgerDbCfgF (..) , configLedgerDb ) where @@ -24,6 +25,7 @@ import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended (ExtLedgerCfg (..), ExtLedgerState) import Ouroboros.Consensus.Protocol.Abstract (ConsensusProtocol) +import Ouroboros.Consensus.Util.Args import Ouroboros.Network.AnchoredSeq (Anchorable (..), AnchoredSeq (..)) import qualified Ouroboros.Network.AnchoredSeq as AS @@ -116,19 +118,24 @@ instance GetTip l => Anchorable (WithOrigin SlotNo) (Checkpoint l) (Checkpoint l LedgerDB Config -------------------------------------------------------------------------------} -data LedgerDbCfg l = LedgerDbCfg { - ledgerDbCfgSecParam :: !SecurityParam - , ledgerDbCfg :: !(LedgerCfg l) +data LedgerDbCfgF f l = LedgerDbCfg { + ledgerDbCfgSecParam :: !(HKD f SecurityParam) + , ledgerDbCfg :: !(HKD f (LedgerCfg l)) + , ledgerDbCfgComputeLedgerEvents :: !ComputeLedgerEvents } deriving (Generic) -deriving instance NoThunks (LedgerCfg l) => NoThunks (LedgerDbCfg l) +type LedgerDbCfg l = Complete LedgerDbCfgF l + +deriving instance NoThunks (LedgerCfg l) => NoThunks (Complete LedgerDbCfgF l) configLedgerDb :: ConsensusProtocol (BlockProtocol blk) => TopLevelConfig blk + -> ComputeLedgerEvents -> LedgerDbCfg (ExtLedgerState blk) -configLedgerDb cfg = LedgerDbCfg { +configLedgerDb cfg opts = LedgerDbCfg { ledgerDbCfgSecParam = configSecurityParam cfg , ledgerDbCfg = ExtLedgerCfg cfg + , ledgerDbCfgComputeLedgerEvents = opts } diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Query.hs index aaa4e20f2c..ff1cfa60a0 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Query.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Query.hs @@ -21,6 +21,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.Query ( , ledgerDbTip ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Data.Foldable (find) import Data.Word import Ouroboros.Consensus.Block @@ -59,7 +60,7 @@ ledgerDbTip = castPoint . getTip . ledgerDbCurrent -- | Have we seen at least @k@ blocks? ledgerDbIsSaturated :: GetTip l => SecurityParam -> LedgerDB l -> Bool ledgerDbIsSaturated (SecurityParam k) db = - ledgerDbMaxRollback db >= k + ledgerDbMaxRollback db >= unNonZero k -- | Get a past ledger state -- diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Update.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Update.hs index d79bd72c4a..e791276d19 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Update.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Update.hs @@ -48,6 +48,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.Update ( , UpdateLedgerDbTraceEvent (..) ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Monad.Except (ExceptT, runExcept, runExceptT, throwError) import Control.Monad.Reader (ReaderT (..), runReaderT) @@ -60,6 +61,7 @@ import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended +import Ouroboros.Consensus.Storage.Common (LedgerDBPruneTip (..)) import Ouroboros.Consensus.Storage.LedgerDB.LedgerDB import Ouroboros.Consensus.Storage.LedgerDB.Query import Ouroboros.Consensus.Util @@ -110,26 +112,27 @@ toRealPoint (Weaken ap) = toRealPoint ap -- -- We take in the entire 'LedgerDB' because we record that as part of errors. applyBlock :: forall m c l blk. (ApplyBlock l blk, Monad m, c) - => LedgerCfg l + => ComputeLedgerEvents + -> LedgerCfg l -> Ap m l blk c -> LedgerDB l -> m l -applyBlock cfg ap db = case ap of +applyBlock opts cfg ap db = case ap of ReapplyVal b -> return $ - tickThenReapply cfg b l + tickThenReapply opts cfg b l ApplyVal b -> either (throwLedgerError db (blockRealPoint b)) return $ runExcept $ - tickThenApply cfg b l + tickThenApply opts cfg b l ReapplyRef r -> do b <- doResolveBlock r return $ - tickThenReapply cfg b l + tickThenReapply opts cfg b l ApplyRef r -> do b <- doResolveBlock r either (throwLedgerError db r) return $ runExcept $ - tickThenApply cfg b l + tickThenApply opts cfg b l Weaken ap' -> - applyBlock cfg ap' db + applyBlock opts cfg ap' db where l :: l l = ledgerDbCurrent db @@ -231,10 +234,15 @@ ledgerDbBimap f g = -- | Prune snapshots until at we have at most @k@ snapshots in the LedgerDB, -- excluding the snapshots stored at the anchor. -ledgerDbPrune :: GetTip l => SecurityParam -> LedgerDB l -> LedgerDB l -ledgerDbPrune (SecurityParam k) db = db { - ledgerDbCheckpoints = AS.anchorNewest k (ledgerDbCheckpoints db) - } +ledgerDbPrune :: GetTip l => LedgerDBPruneTip -> LedgerDB l -> LedgerDB l +ledgerDbPrune tip db = + let tip' = + case tip of + LedgerDBPruneTipZero -> 0 + LedgerDBPruneTip (SecurityParam k) -> unNonZero k + in db { + ledgerDbCheckpoints = AS.anchorNewest tip' (ledgerDbCheckpoints db) + } -- NOTE: we must inline 'ledgerDbPrune' otherwise we get unexplained thunks in -- 'LedgerDB' and thus a space leak. Alternatively, we could disable the @@ -252,7 +260,7 @@ pushLedgerState :: -> l -- ^ Updated ledger state -> LedgerDB l -> LedgerDB l pushLedgerState secParam current' db@LedgerDB{..} = - ledgerDbPrune secParam $ db { + ledgerDbPrune (LedgerDBPruneTip secParam) $ db { ledgerDbCheckpoints = ledgerDbCheckpoints AS.:> Checkpoint current' } @@ -293,7 +301,7 @@ ledgerDbPush :: forall m c l blk. (ApplyBlock l blk, Monad m, c) -> Ap m l blk c -> LedgerDB l -> m (LedgerDB l) ledgerDbPush cfg ap db = (\current' -> pushLedgerState (ledgerDbCfgSecParam cfg) current' db) <$> - applyBlock (ledgerDbCfg cfg) ap db + applyBlock (ledgerDbCfgComputeLedgerEvents cfg) (ledgerDbCfg cfg) ap db -- | Push a bunch of blocks (oldest first) ledgerDbPushMany :: @@ -383,4 +391,3 @@ ledgerDbSwitch' cfg n bs db = case runIdentity $ ledgerDbSwitch cfg n (const $ pure ()) (map pureBlock bs) db of Left ExceededRollback{} -> Nothing Right db' -> Just db' - diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs index 0ba537b87b..ea3bd3ecdb 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs @@ -14,7 +14,7 @@ module Ouroboros.Consensus.Util.Orphans () where import Cardano.Crypto.DSIGN.Class import Cardano.Crypto.DSIGN.Mock (MockDSIGN) -import Cardano.Crypto.Hash (Hash) +import Cardano.Crypto.Hash (Hash, SizeHash) import Cardano.Ledger.Genesis (NoGenesis (..)) import Codec.CBOR.Decoding (Decoder) import Codec.Serialise (Serialise (..)) @@ -26,6 +26,7 @@ import qualified Data.IntPSQ as PSQ import Data.MultiSet (MultiSet) import qualified Data.MultiSet as MultiSet import Data.SOP.BasicFunctors +import GHC.TypeLits (KnownNat) import NoThunks.Class (InspectHeap (..), InspectHeapNamed (..), NoThunks (..), OnlyCheckWhnfNamed (..), allNoThunks, noThunksInKeysAndValues) @@ -38,7 +39,7 @@ import System.FS.CRC (CRC (CRC)) Serialise -------------------------------------------------------------------------------} -instance Serialise (Hash h a) where +instance KnownNat (SizeHash h) => Serialise (Hash h a) where instance Serialise (VerKeyDSIGN MockDSIGN) where encode = encodeVerKeyDSIGN diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Adversarial.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Adversarial.hs index 0a429dd219..2bbe7bcb41 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Adversarial.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Adversarial.hs @@ -171,6 +171,7 @@ checkAdversarialChain recipe adv = do let pc = BV.countActivesInV S.notInverted vA when (C.toVar pc <= 0) $ Exn.throwError BadCount + -- the youngest slot in which the adversarial schedule cannot have accelerated -- -- (IE @s@ past the first active adversarial slot, or @d@ past the @k+1@st diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Params.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Params.hs index 1e863c43c1..74c23e3e63 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Params.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/ChainGenerator/Params.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Ouroboros.Consensus.ChainGenerator.Params ( Asc (Asc, UnsafeAsc) @@ -100,7 +102,7 @@ genKSD :: QC.Gen (Kcp, Scg, Delta) genKSD = sized1 $ \sz -> do -- k > 0 so we can ensure an alternative schema loses the density comparison -- without having to deactivate the first active slot - k <- (+ 1) <$> QC.choose (0, sz) + k <- QC.choose (1, sz + 1) s <- (+ (k + 1)) <$> QC.choose (0, 2 * sz) -- ensures @(k+1) / s <= 1@ d <- QC.choose (0, max 0 $ min (div sz 4) (s-1)) -- ensures @d < s@ pure (Kcp k, Scg s, Delta d) diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs index 493bc743c8..190c1df05d 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs @@ -19,6 +19,7 @@ import Ouroboros.Consensus.Block.Abstract import Ouroboros.Consensus.Config (TopLevelConfig (topLevelConfigLedger), configCodec) import Ouroboros.Consensus.HardFork.History.EraParams (eraEpochSize) +import Ouroboros.Consensus.Ledger.Basics (ComputeLedgerEvents (..)) import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState) import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Storage.ChainDB hiding @@ -117,7 +118,7 @@ fromMinimalChainDbArgs MinimalChainDbArgs {..} = ChainDbArgs { , lgrGenesis = return mcdbInitLedger , lgrHasFS = SomeHasFS $ simHasFS (nodeDBsLgr mcdbNodeDBs) , lgrTracer = nullTracer - , lgrConfig = configLedgerDb mcdbTopLevelConfig + , lgrConfig = configLedgerDb mcdbTopLevelConfig OmitLedgerEvents } , cdbsArgs = ChainDbSpecificArgs { cdbsBlocksToAddSize = 1 diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainUpdates.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainUpdates.hs index 43d91a672b..036af180fe 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainUpdates.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainUpdates.hs @@ -12,6 +12,7 @@ module Test.Util.ChainUpdates ( , prop_genChainUpdates ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Control.Monad (replicateM, replicateM_) import Control.Monad.State.Strict (MonadTrans, execStateT, get, lift, modify) @@ -105,7 +106,7 @@ genChainUpdateState updateBehavior securityParam n = addUpdate u cus = cus { cusUpdates = u : cusUpdates cus } setChain c cus = cus { cusCurrentChain = c } - k = fromIntegral $ maxRollbacks securityParam + k = fromIntegral $ unNonZero $ maxRollbacks securityParam genChainUpdate = do ChainUpdateState { cusCurrentChain = chain } <- get diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs index 52e2cfed17..d54b0639b6 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs @@ -45,6 +45,7 @@ import Ouroboros.Consensus.HardFork.Combinator (HardForkBlock, import Ouroboros.Consensus.HardFork.Combinator.State (Current (..), Past (..)) import Ouroboros.Consensus.HardFork.History (Bound (..)) +import Ouroboros.Consensus.HardFork.History.EraParams import Ouroboros.Consensus.HeaderValidation (TipInfo) import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Query @@ -61,6 +62,7 @@ import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Layout import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index as Index import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Network.SizeInBytes +import Test.Cardano.Ledger.Binary.Arbitrary () import Test.Cardano.Slotting.Arbitrary () import Test.QuickCheck hiding (Fixed (..)) import Test.QuickCheck.Instances () @@ -265,6 +267,19 @@ instance (All (Arbitrary `Compose` f) xs, IsNonEmpty xs) ] shrink = hctraverse' (Proxy @(Arbitrary `Compose` f)) shrink +{------------------------------------------------------------------------------- + Configuration +-------------------------------------------------------------------------------} + +instance Arbitrary EraParams where + arbitrary = EraParams <$> arbitrary <*> arbitrary <*> arbitrary <*> (GenesisWindow <$> arbitrary) + +instance Arbitrary SafeZone where + arbitrary = oneof + [ StandardSafeZone <$> arbitrary + , return UnsafeIndefiniteSafeZone + ] + {------------------------------------------------------------------------------- Telescope & HardForkState -------------------------------------------------------------------------------} diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs index 3774a47bcb..7ed56f245c 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs @@ -65,7 +65,9 @@ instance ( ToExpr (ChainDepState (BlockProtocol blk)) instance ( ToExpr (TipInfo blk) ) => ToExpr (AnnTip blk) -instance ToExpr SecurityParam +instance ToExpr SecurityParam where + toExpr = defaultExprViaShow + instance ToExpr CRC instance ToExpr DiskSnapshot diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Range.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Range.hs index 41a1cabd14..0741858fea 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Range.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Range.hs @@ -11,6 +11,7 @@ module Test.Util.Range ( , rangeK ) where +import Cardano.Ledger.BaseTypes (unNonZero) import qualified Data.List as L import Data.Word import Ouroboros.Consensus.Config.SecurityParam @@ -57,17 +58,17 @@ instance Show RangeK where show r = case r of Range_Eq_K (SecurityParam k) -> "= (k = " ++ show k ++ ")" - Range_Just_Below_K (SecurityParam k) n -> "= (k = " ++ show k ++ ")" ++ " > " ++ show (k - n) - Range_Just_Above_K (SecurityParam k) n -> "= (k = " ++ show k ++ ")" ++ " < " ++ show (k + n) + Range_Just_Below_K (SecurityParam k) n -> "= (k = " ++ show k ++ ")" ++ " > " ++ show (unNonZero k - n) + Range_Just_Above_K (SecurityParam k) n -> "= (k = " ++ show k ++ ")" ++ " < " ++ show (unNonZero k + n) Range_Near_Zero (SecurityParam k) n -> "= (k = " ++ show k ++ ")" ++ " >> " ++ show n Range_Less_Than_K (SecurityParam k) n -> "≈ (k = " ++ show k ++ ")" ++ " >> " ++ show n Range_More_Than_K (SecurityParam k) n -> "≈ (k = " ++ show k ++ ")" ++ " << " ++ show n rangeK :: Integral a => SecurityParam -> a -> RangeK rangeK (SecurityParam k) a - | n == k = Range_Eq_K (SecurityParam k) + | n == unNonZero k = Range_Eq_K (SecurityParam k) | n < nearK = Range_Near_Zero (SecurityParam k) n - | n < k = if belowK <= nearK + | n < unNonZero k = if belowK <= nearK then Range_Just_Below_K (SecurityParam k) n else Range_Less_Than_K (SecurityParam k) (n `div` bandSize) | otherwise = if aboveK <= nearK @@ -75,15 +76,15 @@ rangeK (SecurityParam k) a else Range_More_Than_K (SecurityParam k) (head (dropWhile (< n) powers)) where n = fromIntegral a - belowK = k - n - aboveK = n - k - powers = [k + 2 ^ i | i <- [0..] :: [Int]] + belowK = unNonZero k - n + aboveK = n - unNonZero k + powers = [unNonZero k + 2 ^ i | i <- [0..] :: [Int]] -- threshold for determining if a value is near k nearK = 5 -- bands for summarizing values less than k - bandSize = max 1 (k `div` 10) + bandSize = max 1 (unNonZero k `div` 10) {------------------------------------------------------------------------------- Summarize values not related to K diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Examples.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Examples.hs index 39a2b91ed3..3495767a81 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Examples.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Serialisation/Examples.hs @@ -18,7 +18,7 @@ import Data.Bifunctor (first) import Ouroboros.Consensus.Block (BlockProtocol, Header, HeaderHash, SlotNo, SomeSecond) import Ouroboros.Consensus.HeaderValidation (AnnTip) -import Ouroboros.Consensus.Ledger.Abstract (LedgerState) +import Ouroboros.Consensus.Ledger.Abstract (LedgerConfig, LedgerState) import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState) import Ouroboros.Consensus.Ledger.Query (BlockQuery) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, @@ -48,6 +48,7 @@ data Examples blk = Examples { , exampleChainDepState :: Labelled (ChainDepState (BlockProtocol blk)) , exampleExtLedgerState :: Labelled (ExtLedgerState blk) , exampleSlotNo :: Labelled SlotNo + , exampleLedgerConfig :: Labelled (LedgerConfig blk) } emptyExamples :: Examples blk @@ -67,6 +68,7 @@ emptyExamples = Examples { , exampleChainDepState = mempty , exampleExtLedgerState = mempty , exampleSlotNo = mempty + , exampleLedgerConfig = mempty } combineExamples :: @@ -91,6 +93,7 @@ combineExamples f e1 e2 = Examples { , exampleChainDepState = combine exampleChainDepState , exampleExtLedgerState = combine exampleExtLedgerState , exampleSlotNo = combine exampleSlotNo + , exampleLedgerConfig = combine exampleLedgerConfig } where combine :: (Examples blk -> Labelled a) -> Labelled a 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 1504ed06b8..0c21047f08 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 @@ -337,6 +337,7 @@ goldenTest_SerialiseNodeToClient codecConfig goldenDir Examples {..} = , test "ApplyTxErr" exampleApplyTxErr enc' , test "Query" exampleQuery enc' , test "SlotNo" exampleSlotNo enc' + , test "LedgerConfig" exampleLedgerConfig enc' , test "Result" exampleResult encRes ] where 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 7425098bc0..59fe145e0e 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 @@ -55,7 +55,7 @@ import Data.Typeable import GHC.Generics (Generic) import Ouroboros.Consensus.Block import Ouroboros.Consensus.HeaderValidation (AnnTip) -import Ouroboros.Consensus.Ledger.Abstract (LedgerState) +import Ouroboros.Consensus.Ledger.Basics import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, decodeExtLedgerState, encodeExtLedgerState) import Ouroboros.Consensus.Ledger.Query (BlockQuery, Query (..), @@ -167,6 +167,37 @@ roundtripAnd check enc dec a = checkRoundtripResult $ do checkRoundtripResult (Left str) = counterexample str False checkRoundtripResult (Right ()) = property () +roundtripComparingEncoding :: + (a -> Encoding) + -> (forall s. Decoder s a) + -> a + -> Property +roundtripComparingEncoding enc dec = roundtripComparingEncoding' enc (const <$> dec) + +-- | Like 'roundtrip'', but checks for equality of the encoding (i.e. the byte +-- string) instead of the @a@ values using @Eq a@. This is useful When we don't +-- have an @Eq a@ instance. +roundtripComparingEncoding' :: + (a -> Encoding) -- ^ @enc@ + -> (forall s. Decoder s (Lazy.ByteString -> a)) + -> a + -> Property +roundtripComparingEncoding' enc dec a = case deserialiseFromBytes dec bs of + Right (remainingBytes, a') + | let bs' = toLazyByteString (enc (a' bs)) + , Lazy.null remainingBytes + -> bs === bs' + | otherwise + -> counterexample ("left-over bytes: " <> toBase16 remainingBytes) False + Left e + -> counterexample (show e) $ + counterexample (toBase16 bs) False + where + bs = toLazyByteString (enc a) + + toBase16 :: Lazy.ByteString -> String + toBase16 = Char8.unpack . Base16.encode + {------------------------------------------------------------------------------ Test skeleton ------------------------------------------------------------------------------} @@ -207,6 +238,7 @@ roundtrip_all , ArbitraryWithVersion (BlockNodeToClientVersion blk) (ApplyTxErr blk) , ArbitraryWithVersion (BlockNodeToClientVersion blk) (SomeSecond BlockQuery blk) , ArbitraryWithVersion (BlockNodeToClientVersion blk) (SomeResult blk) + , Arbitrary (WithVersion (BlockNodeToClientVersion blk) (LedgerConfig blk)) , ArbitraryWithVersion (QueryVersion, BlockNodeToClientVersion blk) (SomeSecond Query blk) ) => CodecConfig blk @@ -255,6 +287,7 @@ roundtrip_all_skipping , ArbitraryWithVersion (BlockNodeToClientVersion blk) (ApplyTxErr blk) , ArbitraryWithVersion (BlockNodeToClientVersion blk) (SomeSecond BlockQuery blk) , ArbitraryWithVersion (BlockNodeToClientVersion blk) (SomeResult blk) + , Arbitrary (WithVersion (BlockNodeToClientVersion blk) (LedgerConfig blk)) , ArbitraryWithVersion (QueryVersion, BlockNodeToClientVersion blk) (SomeSecond Query blk) ) => (TestName -> ShouldCheckCBORValidity) @@ -340,6 +373,7 @@ instance ( blockVersion ~ BlockNodeToClientVersion blk -- support such top level `Query` constructors in this Arbitrary instance. Query.QueryVersion1 -> genTopLevelQuery1 Query.QueryVersion2 -> genTopLevelQuery2 + Query.QueryVersion3 -> genTopLevelQuery3 where mkEntry :: QueryVersion -> Query blk query @@ -365,6 +399,16 @@ instance ( blockVersion ~ BlockNodeToClientVersion blk , (1 , mkEntry version GetChainPoint ) ] + genTopLevelQuery3 = + let version = Query.QueryVersion3 + in frequency + [ (15, arbitraryBlockQuery version ) + , (1 , mkEntry version GetSystemStart ) + , (1 , mkEntry version GetChainBlockNo) + , (1 , mkEntry version GetChainPoint ) + , (1 , mkEntry version GetLedgerConfig) + ] + arbitraryBlockQuery :: QueryVersion -> Gen (WithVersion (QueryVersion, blockVersion) (SomeSecond Query blk)) @@ -496,6 +540,7 @@ roundtrip_SerialiseNodeToClient , ArbitraryWithVersion (BlockNodeToClientVersion blk) (ApplyTxErr blk) , ArbitraryWithVersion (BlockNodeToClientVersion blk) (SomeSecond BlockQuery blk) , ArbitraryWithVersion (BlockNodeToClientVersion blk) (SomeResult blk) + , Arbitrary (WithVersion (BlockNodeToClientVersion blk) (LedgerConfig blk)) , ArbitraryWithVersion (QueryVersion, BlockNodeToClientVersion blk) (SomeSecond Query blk) -- Needed for testing the @Serialised blk@ @@ -510,6 +555,12 @@ roundtrip_SerialiseNodeToClient shouldCheckCBORvalidity ccfg = , rt (Proxy @(GenTx blk)) "GenTx" , rt (Proxy @(ApplyTxErr blk)) "ApplyTxErr" , rt (Proxy @(SomeSecond BlockQuery blk)) "BlockQuery" + -- Note: Ideally we'd just use 'rt' to test Ledger config, but that would + -- require an 'Eq' and 'Show' instance for all ledger config types which + -- we'd like to avoid (as the EpochInfo is a record of functions). + , testProperty "roundtrip (comparing encoding) LedgerConfig" $ + withMaxSuccess 20 $ \(Blind (WithVersion version a)) -> + roundtripComparingEncoding @(LedgerConfig blk) (enc version) (dec version) a , rtWith @(SomeSecond Query blk) @(QueryVersion, BlockNodeToClientVersion blk) diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs index 5ed7674f03..7fd4160deb 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs @@ -83,6 +83,7 @@ module Test.Util.TestBlock ( ) where import Cardano.Crypto.DSIGN +import Cardano.Ledger.BaseTypes (knownNonZeroBounded, unNonZero) import Codec.Serialise (Serialise (..), serialise) import Control.DeepSeq (force) import Control.Monad (guard, replicateM, replicateM_) @@ -490,7 +491,7 @@ instance ( Typeable ptype instance PayloadSemantics ptype => ApplyBlock (LedgerState (TestBlockWith ptype)) (TestBlockWith ptype) where - applyBlockLedgerResult _ tb@TestBlockWith{..} (TickedTestLedger TestLedger{..}) + applyBlockLedgerResultWithValidation _validation _events _ tb@TestBlockWith{..} (TickedTestLedger TestLedger{..}) | blockPrevHash tb /= pointHash lastAppliedPoint = throwError $ InvalidHash (pointHash lastAppliedPoint) (blockPrevHash tb) | tbValid == Invalid @@ -504,15 +505,9 @@ instance PayloadSemantics ptype , payloadDependentState = st' } - reapplyBlockLedgerResult _ tb@TestBlockWith{..} (TickedTestLedger TestLedger{..}) = - case applyPayload payloadDependentState tbPayload of - Left err -> error $ "Found an error when reapplying a block: " ++ show err - Right st' -> pureLedgerResult - $ TestLedger { - lastAppliedPoint = Chain.blockPoint tb - , payloadDependentState = st' - } - + applyBlockLedgerResult = defaultApplyBlockLedgerResult + reapplyBlockLedgerResult = + defaultReapplyBlockLedgerResult (error . ("Found an error when reapplying a block: " ++) . show) data instance LedgerState (TestBlockWith ptype) = TestLedger { @@ -573,7 +568,7 @@ instance PayloadSemantics ptype => IsLedger (LedgerState (TestBlockWith ptype)) type AuxLedgerEvent (LedgerState (TestBlockWith ptype)) = VoidLedgerEvent (LedgerState (TestBlockWith ptype)) - applyChainTickLedgerResult _ _ = pureLedgerResult . TickedTestLedger + applyChainTickLedgerResult _ _ _ = pureLedgerResult . TickedTestLedger instance PayloadSemantics ptype => UpdateLedger (TestBlockWith ptype) @@ -673,11 +668,11 @@ testInitExtLedger = testInitExtLedgerWithState () -- | Trivial test configuration with a single core node singleNodeTestConfig :: TopLevelConfig TestBlock -singleNodeTestConfig = singleNodeTestConfigWithK (SecurityParam 4) +singleNodeTestConfig = singleNodeTestConfigWithK (SecurityParam $ knownNonZeroBounded @4) singleNodeTestConfigWithK :: SecurityParam -> TopLevelConfig TestBlock singleNodeTestConfigWithK k = - singleNodeTestConfigWith TestBlockCodecConfig TestBlockStorageConfig k (GenesisWindow (2 * maxRollbacks k)) + singleNodeTestConfigWith TestBlockCodecConfig TestBlockStorageConfig k (GenesisWindow (2 * unNonZero (maxRollbacks k))) {------------------------------------------------------------------------------- Chain of blocks (without payload) diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs index f6db8e90cf..86a79f4148 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block.hs @@ -76,10 +76,12 @@ import Data.Proxy import Data.Typeable import Data.Word import GHC.Generics (Generic) +import GHC.TypeNats (KnownNat) import NoThunks.Class (NoThunks (..)) import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config import Ouroboros.Consensus.HardFork.Abstract +import Ouroboros.Consensus.HardFork.Combinator.PartialConfig import qualified Ouroboros.Consensus.HardFork.History as HardFork import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Ledger.Abstract @@ -92,6 +94,7 @@ import Ouroboros.Consensus.Ledger.SupportsPeerSelection import Ouroboros.Consensus.Mock.Ledger.Address import Ouroboros.Consensus.Mock.Ledger.State import qualified Ouroboros.Consensus.Mock.Ledger.UTxO as Mock +import Ouroboros.Consensus.Node.Serialisation import Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..), SizeInBytes) import Ouroboros.Consensus.Util (ShowProxy (..), hashFromBytesShortE, @@ -170,7 +173,10 @@ data SimpleStdHeader c ext = SimpleStdHeader { , simpleBodySize :: SizeInBytes } deriving stock (Generic, Show, Eq) - deriving anyclass (Serialise, NoThunks) + deriving anyclass (NoThunks) + +deriving anyclass instance KnownNat (Hash.SizeHash (SimpleHash c)) => + Serialise (SimpleStdHeader c ext) data SimpleBody = SimpleBody { simpleTxs :: [Mock.Tx] @@ -312,9 +318,10 @@ instance HasHardForkHistory (SimpleBlock c ext) where -------------------------------------------------------------------------------} class ( SimpleCrypto c - , Typeable ext - , Show (MockLedgerConfig c ext) - , NoThunks (MockLedgerConfig c ext) + , Typeable ext + , Show (MockLedgerConfig c ext) + , NoThunks (MockLedgerConfig c ext) + , Serialise (MockLedgerConfig c ext) ) => MockProtocolSpecific c ext where type family MockLedgerConfig c ext :: Type @@ -334,11 +341,19 @@ data SimpleLedgerConfig c ext = SimpleLedgerConfig { deriving (Generic) deriving instance Show (MockLedgerConfig c ext) => Show (SimpleLedgerConfig c ext) -deriving instance NoThunks (MockLedgerConfig c ext) +deriving instance Eq (MockLedgerConfig c ext) => Eq (SimpleLedgerConfig c ext) +deriving instance NoThunks (MockLedgerConfig c ext) => NoThunks (SimpleLedgerConfig c ext) +deriving instance Serialise (MockLedgerConfig c ext) + => Serialise (SimpleLedgerConfig c ext) type instance LedgerCfg (LedgerState (SimpleBlock c ext)) = SimpleLedgerConfig c ext +instance MockProtocolSpecific c ext => HasPartialLedgerConfig (SimpleBlock c ext) + +instance (Serialise (MockLedgerConfig c ext)) + => SerialiseNodeToClient (SimpleBlock c ext) (SimpleLedgerConfig c ext) + instance GetTip (LedgerState (SimpleBlock c ext)) where getTip (SimpleLedgerState st) = castPoint $ mockTip st @@ -351,23 +366,25 @@ instance MockProtocolSpecific c ext type AuxLedgerEvent (LedgerState (SimpleBlock c ext)) = VoidLedgerEvent (SimpleBlock c ext) - applyChainTickLedgerResult _ _ = pureLedgerResult . TickedSimpleLedgerState + applyChainTickLedgerResult _ _ _ = pureLedgerResult . TickedSimpleLedgerState instance MockProtocolSpecific c ext => ApplyBlock (LedgerState (SimpleBlock c ext)) (SimpleBlock c ext) where - applyBlockLedgerResult = fmap pureLedgerResult ..: updateSimpleLedgerState + applyBlockLedgerResultWithValidation _validation _events = + fmap pureLedgerResult ..: updateSimpleLedgerState + applyBlockLedgerResult = defaultApplyBlockLedgerResult reapplyBlockLedgerResult = - (mustSucceed . runExcept) ..: applyBlockLedgerResult - where - mustSucceed (Left err) = error ("reapplyBlockLedgerResult: unexpected error: " <> show err) - mustSucceed (Right st) = st + defaultReapplyBlockLedgerResult (error . ("reapplyBlockLedgerResult: unexpected error: " <>) . show) newtype instance LedgerState (SimpleBlock c ext) = SimpleLedgerState { simpleLedgerState :: MockState (SimpleBlock c ext) } deriving stock (Generic, Show, Eq) - deriving newtype (Serialise, NoThunks) + deriving newtype (NoThunks) + +deriving anyclass instance KnownNat (Hash.SizeHash (SimpleHash c)) => + Serialise (LedgerState (SimpleBlock c ext)) -- Ticking has no effect on the simple ledger state newtype instance Ticked (LedgerState (SimpleBlock c ext)) = TickedSimpleLedgerState { @@ -541,7 +558,7 @@ instance InspectLedger (SimpleBlock c ext) where Crypto needed for simple blocks -------------------------------------------------------------------------------} -class (HashAlgorithm (SimpleHash c), Typeable c) => SimpleCrypto c where +class (KnownNat (Hash.SizeHash (SimpleHash c)), HashAlgorithm (SimpleHash c), Typeable c) => SimpleCrypto c where type family SimpleHash c :: Type data SimpleStandardCrypto @@ -598,7 +615,8 @@ instance Condense ext' => Condense (SimpleBlock' c ext ext') where instance ToCBOR SimpleBody where toCBOR = encode -encodeSimpleHeader :: (ext' -> CBOR.Encoding) +encodeSimpleHeader :: KnownNat (Hash.SizeHash (SimpleHash c)) + => (ext' -> CBOR.Encoding) -> Header (SimpleBlock' c ext ext') -> CBOR.Encoding encodeSimpleHeader encodeExt SimpleHeader{..} = mconcat [ diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs index 2e7769d785..ac6cc26cf1 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs @@ -86,7 +86,7 @@ _simplePBftHeader = simpleHeader Customization of the generic infrastructure -------------------------------------------------------------------------------} -instance (SimpleCrypto c, PBftCrypto c') +instance (SimpleCrypto c, PBftCrypto c', Serialise (PBftVerKeyHash c')) => MockProtocolSpecific c (SimplePBftExt c c') where -- | PBFT requires the ledger view; for the mock ledger, this is constant type MockLedgerConfig c (SimplePBftExt c c') = PBftLedgerView c' @@ -175,10 +175,10 @@ instance SimpleCrypto c => SignableRepresentation (SignedSimplePBft c c') where instance (Typeable c', SimpleCrypto c) => ToCBOR (SignedSimplePBft c c') where toCBOR = encode -instance (Serialise (PBftVerKeyHash c'), PBftCrypto c') +instance PBftCrypto c' => EncodeDisk (SimplePBftBlock c c') (S.PBftState c') where encodeDisk = const S.encodePBftState -instance (Serialise (PBftVerKeyHash c'), PBftCrypto c') +instance PBftCrypto c' => DecodeDisk (SimplePBftBlock c c') (S.PBftState c') where decodeDisk = const S.decodePBftState diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/State.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/State.hs index 2bbcc377eb..d7170e56fe 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/State.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/State.hs @@ -50,7 +50,7 @@ data MockConfig = MockConfig { mockCfgMaxTxSize :: !(Maybe ByteSize32) } deriving stock (Show, Eq, Generic) - deriving anyclass (NoThunks) + deriving anyclass (NoThunks, Serialise) defaultMockConfig :: MockConfig defaultMockConfig = MockConfig { diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node.hs index dab988bc6d..5a3cef4d23 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node.hs @@ -16,6 +16,7 @@ module Ouroboros.Consensus.Mock.Node ( , simpleBlockForging ) where +import Cardano.Ledger.BaseTypes (unNonZero) import Codec.Serialise (Serialise) import qualified Data.Map.Strict as Map import Data.Void (Void) @@ -48,7 +49,7 @@ instance SupportedNetworkProtocolVersion (SimpleBlock SimpleMockCrypto ext) wher instance NodeInitStorage (SimpleBlock SimpleMockCrypto ext) where nodeImmutableDbChunkInfo (SimpleStorageConfig secParam) = simpleChunkInfo $ - EpochSize $ 10 * maxRollbacks secParam + EpochSize $ 10 * unNonZero (maxRollbacks secParam) nodeCheckIntegrity _ _ = True diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Praos.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Praos.hs index 00d678da6d..0b3ce9a5d9 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Praos.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Praos.hs @@ -104,7 +104,7 @@ blockForgingPraos numCoreNodes nid = sequence [praosBlockForging nid initHotKey] initHotKey = HotKey 0 - (SignKeyMockKES + (UnsoundPureSignKeyMockKES -- key ID (fst $ verKeys Map.! nid) -- KES initial slot diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Serialisation.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Serialisation.hs index 63482abd63..d4923dcac7 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Serialisation.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Node/Serialisation.hs @@ -4,6 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -94,7 +95,8 @@ instance SerialiseNodeToNode (MockBlock ext) (GenTxId (MockBlock ext)) possible. -------------------------------------------------------------------------------} -instance (Serialise ext, Typeable ext) => SerialiseNodeToClientConstraints (MockBlock ext) +instance (Serialise ext, Typeable ext, Serialise (MockLedgerConfig SimpleMockCrypto ext)) + => SerialiseNodeToClientConstraints (MockBlock ext) instance Serialise ext => SerialiseNodeToClient (MockBlock ext) (MockBlock ext) where encodeNodeToClient _ _ = defaultEncodeCBORinCBOR diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/Praos.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/Praos.hs index 73407f75af..232eab4df5 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/Praos.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/Praos.hs @@ -43,7 +43,7 @@ module Ouroboros.Consensus.Mock.Protocol.Praos ( ) where import Cardano.Binary (FromCBOR (..), ToCBOR (..), serialize') -import Cardano.Crypto.DSIGN.Ed448 (Ed448DSIGN) +import Cardano.Crypto.DSIGN.Ed25519 (Ed25519DSIGN) import Cardano.Crypto.Hash.Class (HashAlgorithm (..), hashToBytes, hashWithSerialiser, sizeHash) import Cardano.Crypto.Hash.SHA256 (SHA256) @@ -203,12 +203,14 @@ praosValidateView getFields hdr = data HotKey c = HotKey !Period -- ^ Absolute period of the KES key - !(SignKeyKES (PraosKES c)) + !(UnsoundPureSignKeyKES (PraosKES c)) | HotKeyPoisoned deriving (Generic) instance PraosCrypto c => NoThunks (HotKey c) -deriving instance PraosCrypto c => Show (HotKey c) +instance PraosCrypto c => Show (HotKey c) where + show (HotKey p _) = "HotKey " ++ show p ++ "