From 7c299846bab2512f8ee2361c1450a2d303be5919 Mon Sep 17 00:00:00 2001 From: Jared Corduan Date: Thu, 26 Jan 2023 14:16:44 -0500 Subject: [PATCH] tests highlighting issue in cardano-node #4826 --- .../Test/Cardano/Ledger/Mary/ValueSpec.hs | 4 +- .../cardano-ledger-shelley-ma-test.cabal | 3 + .../test/Test/Cardano/Ledger/Mary/Value.hs | 76 +++++++++++++++++++ libs/cardano-data/CHANGELOG.md | 7 ++ libs/cardano-data/cardano-data.cabal | 2 +- 5 files changed, 90 insertions(+), 2 deletions(-) diff --git a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs index fc559ba7f6c..46ce8a89c27 100644 --- a/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs +++ b/eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs @@ -32,7 +32,9 @@ import Test.Cardano.Ledger.Mary.Arbitrary (genEmptyMultiAsset, genMaryValue, gen spec :: Spec spec = do describe "MultiAsset" $ do - prop "Canonical construction agrees" $ propCanonicalConstructionAgrees @StandardCrypto + prop "Canonical construction agrees" $ + withMaxSuccess 100000 $ + propCanonicalConstructionAgrees @StandardCrypto describe "CBOR roundtrip" $ do context "Coin" $ do prop "Non-negative Coin succeeds for all eras" $ diff --git a/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal b/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal index e244bb7b895..c9c5963d20c 100644 --- a/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal +++ b/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal @@ -93,6 +93,7 @@ test-suite cardano-ledger-shelley-ma-test build-depends: base, bytestring, + cardano-crypto-class, cardano-data, cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.1, cardano-ledger-core:{cardano-ledger-core, testlib}, @@ -104,6 +105,8 @@ test-suite cardano-ledger-shelley-ma-test cborg, containers, data-default-class, + deepseq, + groups, mtl, microlens, QuickCheck, diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs index 1c8e7487a56..5d82201fd72 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Value.hs @@ -9,10 +9,12 @@ module Test.Cardano.Ledger.Mary.Value (valTests) where +import Cardano.Crypto.Hash.Class (castHash, hashFromStringAsHex) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Compactible (fromCompact, toCompact) import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Crypto as CC (Crypto) +import Cardano.Ledger.Hashes (ScriptHash (..)) import Cardano.Ledger.Mary.Value ( AssetName (..), MaryValue (..), @@ -22,6 +24,7 @@ import Cardano.Ledger.Mary.Value ( lookupMultiAsset, ) import Cardano.Ledger.Val (Val (..), invert) +import Control.DeepSeq (rnf) import Control.Monad (replicateM) import Data.ByteString.Short (ShortByteString) import Data.CanonicalMaps ( @@ -29,8 +32,10 @@ import Data.CanonicalMaps ( canonicalInsert, canonicalMapUnion, ) +import qualified Data.Group as G import Data.Map.Strict (empty, singleton) import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) import Test.Cardano.Ledger.Mary.Arbitrary () import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators () import Test.Cardano.Ledger.Shelley.Serialisation.Generators () @@ -333,6 +338,75 @@ compactRoundTrip = forAll gen $ \v -> compactTest :: TestTree compactTest = testProperty "fromCompact . toCompact == id" compactRoundTrip +-- | Create a script hash of length 28 with 27 leading zeros followed by one hex-encoded byte +-- supplied by the caller. +makeScriptHash :: String -> ScriptHash StandardCrypto +makeScriptHash str = + ScriptHash $ castHash (fromMaybe (error "Impossible") $ hashFromStringAsHex (pad <> str)) + where + pad = replicate 54 '0' + +oneNonameAsset :: Map.Map AssetName Integer +oneNonameAsset = Map.fromList [(AssetName "", 1)] + +makeMultiAsset :: ScriptHash StandardCrypto -> MultiAsset StandardCrypto +makeMultiAsset sh = MultiAsset (Map.singleton (PolicyID sh) oneNonameAsset) + +s0, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12 :: MultiAsset StandardCrypto +s0 = makeMultiAsset $ makeScriptHash "00" +s1 = makeMultiAsset $ makeScriptHash "01" +s2 = makeMultiAsset $ makeScriptHash "02" +s3 = makeMultiAsset $ makeScriptHash "03" +s4 = makeMultiAsset $ makeScriptHash "04" +s5 = makeMultiAsset $ makeScriptHash "05" +s6 = makeMultiAsset $ makeScriptHash "06" +s7 = makeMultiAsset $ makeScriptHash "07" +s8 = makeMultiAsset $ makeScriptHash "08" +s9 = makeMultiAsset $ makeScriptHash "09" +s10 = makeMultiAsset $ makeScriptHash "10" +s11 = makeMultiAsset $ makeScriptHash "11" +s12 = makeMultiAsset $ makeScriptHash "12" + +exampleMultiAssets :: [MultiAsset StandardCrypto] +exampleMultiAssets = [s0, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12] + +-- | Test that the subtraction of Multi-assets (and the underlying 'CanonicalMaps') +-- is a total function. +-- This was used to diagnose https://github.com/input-output-hk/cardano-node/issues/4826 +subtractionIsTotal :: TestTree +subtractionIsTotal = testProperty "multi-asset subtraction is total" $ + QC.withMaxSuccess 100000 $ + do + shuffle1 <- take 12 <$> QC.shuffle exampleMultiAssets + shuffle2 <- take 2 <$> QC.shuffle exampleMultiAssets + let a = mconcat [m | MultiAsset m <- shuffle1] + -- \^ here we chose to perform addition on the CanonicalMaps, as this is what + -- happens during deserialization, giving us insight into how node-4826 could + -- have occurred on mainnet (since we care about how the addition is associated). + -- Note that the ledger does not manipulate instances of + -- 'Value' and then store them in memory, since outputs are created by the user + -- and only deserialized. In other words, it is only in the ledger rules themselves + -- that we manipulate 'Value'. + b = mconcat shuffle2 + pure $! rnf (MultiAsset a <> G.invert b) + +-- | The test below was discovered by a failure of 'subtractionIsTotal' +-- using git sha bd359d3f745ca72242b2cd1208780c2787992b5f and --quickcheck-replay=649941 +node4826Reproducible :: TestTree +node4826Reproducible = + testProperty "node4826Reproducible" $ + let shuffle1 = + [ makeMultiAsset $ makeScriptHash suffix + | suffix <- ["10", "09", "11", "08", "01", "06", "03", "05", "04", "07", "02", "00"] + ] + shuffle2 = + [ makeMultiAsset $ makeScriptHash suffix + | suffix <- ["04", "08"] + ] + multiAssetMap = mconcat [m | MultiAsset m <- shuffle1] + reproducible = MultiAsset multiAssetMap <> G.invert (mconcat shuffle2) + in rnf reproducible + -- =========================================== -- All the value tests @@ -347,4 +421,6 @@ valTests = , monoValueTests , valueGroupTests , compactTest + , subtractionIsTotal + , node4826Reproducible ] diff --git a/libs/cardano-data/CHANGELOG.md b/libs/cardano-data/CHANGELOG.md index 7a902cf12b7..de14d2481ba 100644 --- a/libs/cardano-data/CHANGELOG.md +++ b/libs/cardano-data/CHANGELOG.md @@ -1,5 +1,12 @@ # Version history for `cardano-data` +## 1.0.1.0 + +* Fix - A bug was fixed in the `canonicalInsert` function. + The bug manifested by creating an unbalanced tree in the `Data.Map` internals of the + 'CanonicalMap', which can result in a crash. + This was the root cause of https://github.com/input-output-hk/cardano-node/issues/4826. + ## 1.0.0.0 * First properly versioned released. diff --git a/libs/cardano-data/cardano-data.cabal b/libs/cardano-data/cardano-data.cabal index 810f5917000..021500a036b 100644 --- a/libs/cardano-data/cardano-data.cabal +++ b/libs/cardano-data/cardano-data.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-data -version: 1.0.0.0 +version: 1.0.1.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK