Try generator as per review comment

eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs

@@ -81,13 +81,13 @@ import Data.CanonicalMaps (
 import Data.Foldable (foldMap')
 import Data.Group (Abelian, Group (..))
 import Data.Int (Int64)
-import Data.List (nub, sortOn)
+import Data.List (sortOn)
 import Data.Map (Map)
 import Data.Map.Internal (
   link,
   link2,
  )
-import Data.Map.Strict (assocs, foldr', keys, keysSet)
+import Data.Map.Strict (assocs)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust)
 import qualified Data.Primitive.ByteArray as BA
@@ -336,13 +336,13 @@ decodeMultiAssetMaps decodeAmount = do
   ma <- decodeMap decCBOR (decodeMap decCBOR decodeAmount)
   -- compact form inequality:
   --   8n (Word64) + 2n (Word16) + 2n (Word16) + 28p (policy ids) + sum of lengths of unique asset names <= 65535
-  -- where: n = number of assets, p = number of unique policy ids
-  let numUniqPolicies = length $ keysSet ma
-      numAssets = sum $ length <$> ma
-      sumLengthsUniqAssetNames = sum . fmap SBS.length . nub . foldr' (<>) [] $ fmap assetName . keys <$> ma
-      highestOffset = 12 * numAssets + 28 * numUniqPolicies + sumLengthsUniqAssetNames
-  if highestOffset >= 65535
-    then fail "MultiAsset too big to compact, has too many assets. Ideal number is < 910."
+  -- maximum size for the asset name is 32 bytes, so:
+  -- 8n + 2n + 2n + 28p + 32n <= 65535
+  -- where: n = total number of assets, p = number of unique policy ids
+  let numPolicies = Map.size ma
+      numAssetNames = sum $ length <$> ma
+  if 44 * numAssetNames + 28 * numPolicies > 65535
+    then fail "MultiAsset too big to compact"
     else
       ifDecoderVersionAtLeast
         (natVersion @9)

eras/mary/impl/test/Test/Cardano/Ledger/Mary/ValueSpec.hs

@@ -10,7 +10,9 @@ module Test.Cardano.Ledger.Mary.ValueSpec (spec) where
 import Cardano.Ledger.BaseTypes (natVersion)
 import Cardano.Ledger.Coin (Coin (Coin))
 import Cardano.Ledger.Compactible (fromCompact, toCompact)
+import Cardano.Ledger.Core (eraProtVerLow)
 import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
+import Cardano.Ledger.Mary (Mary)
 import Cardano.Ledger.Mary.Value
 import qualified Data.ByteString.Base16 as BS16
 import qualified Data.ByteString.Char8 as BS8
@@ -20,7 +22,6 @@ import Data.Maybe (fromJust)
 import GHC.Exts
 import Test.Cardano.Data
 import Test.Cardano.Ledger.Binary.RoundTrip (
-  FailureVerbosity (Minimal),
   cborTrip,
   embedTripRangeFailureExpectation,
   roundTripCborExpectation,
@@ -81,22 +82,21 @@ spec = do
             forAll
               (genMaryValue (genMultiAssetToFail @StandardCrypto))
               ( embedTripRangeFailureExpectation @(MaryValue StandardCrypto) @(MaryValue StandardCrypto)
-                  Minimal
                   cborTrip
-                  minBound
+                  (eraProtVerLow @Mary)
                   maxBound
               )
 
   describe "MaryValue compacting" $ do
     prop "Canonical generator" $
       \(ma :: MaryValue StandardCrypto) ->
-        fromCompact (fromJust (toCompact ma)) == ma
+        fromCompact (fromJust (toCompact ma)) `shouldBe` ma
     it "Failing generator" $
       expectFailure $
         property $
           forAll (genMaryValue (genMultiAssetToFail @StandardCrypto)) $
             \ma ->
-              fromCompact (fromJust (toCompact ma)) == ma
+              fromCompact (fromJust (toCompact ma)) `shouldBe` ma
 
 instance IsString AssetName where
   fromString = AssetName . either error SBS.toShort . BS16.decode . BS8.pack

eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Arbitrary.hs

@@ -18,18 +18,20 @@ import Cardano.Crypto.Hash.Class (Hash, HashAlgorithm, castHash, hashWith)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Mary.TxBody (MaryTxBody (..))
-import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..))
+import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..), flattenMultiAsset, representationSize)
 import qualified Cardano.Ledger.Mary.Value as ConcreteValue
 import Data.Int (Int64)
 import qualified Data.Map.Strict as Map (empty)
 import Data.Maybe.Strict (StrictMaybe)
 import Data.String (IsString (fromString))
+import Debug.Trace (traceShow)
 import Test.Cardano.Data (genNonEmptyMap)
 import Test.Cardano.Ledger.Allegra.Arbitrary ()
 import Test.Cardano.Ledger.Binary.Arbitrary (genShortByteString)
 import Test.QuickCheck (
   Arbitrary,
   Gen,
+  Positive (Positive, getPositive),
   arbitrary,
   choose,
   chooseInt,
@@ -112,13 +114,13 @@ genMultiAssetTriple genAmount = (,,) <$> arbitrary <*> arbitrary <*> genAmount
 --   3. If the offsets exceed their maxBounds, they will overflow.
 --   4. So, we need to ensure that at least the last of the offsets (AssetName offsets) do
 --      not exceed 65535.
---   5. With `n` as the total number of assets, the inequality to be satisfied is thus:
+--   5. With `n` as the total number of assets, `p` the number of policy ids, the inequality to be satisfied is thus:
 --           8n -- Word64 asset quantities
 --        +  2n -- Word16 policy id offsets
 --        +  2n -- Word16 asset name offsets
---        + 28n -- 28-byte policy ids
+--        + 28p -- 28-byte policy ids
 --        + 32n -- 32-byte asset names (a maximum of 32 bytes)
---        should be <= 65535
+--        should be <= 65535, assuming the numer of policies to be maximal (i.e. equal to number of assets)
 --        65535 / 72 ~ 910.2 is the maximum number of triples to be safely generated
 --
 -- NOTE: There are some conditions due to which exceeding this number may not
@@ -142,21 +144,42 @@ genMultiAssetZero :: Crypto c => Gen (MultiAsset c)
 genMultiAssetZero = MultiAsset <$> genNonEmptyMap arbitrary (genNonEmptyMap arbitrary (pure 0))
 
 -- For negative tests, we need a definite generator that causes overflow
-genMultiAssetToFail :: Crypto c => Gen (MultiAsset c)
+genMultiAssetToFail :: forall c. Crypto c => Gen (MultiAsset c)
 genMultiAssetToFail = do
-  n <- chooseInt (200, 500) -- The generator can use a lot of resources if the number is made arbitrarily large.
-  let triplesSize = n + 910
-  multiAssetFromListBounded @Int64
-    <$> resize
-      triplesSize
-      ( vectorOf
-          triplesSize
-          ( (,,)
-              <$> arbitrary
-              <*> (AssetName <$> genShortByteString 32)
-              <*> (fromIntegral <$> chooseInt (1, maxBound))
+  (numPolicyId, numAssetName) <-
+    oneof
+      [ do
+          Positive numAsssetNames <- arbitrary
+          let minNumPolicyId = (65535 - 44 * numAsssetNames) `div` 28
+          numPolicyIds <- (minNumPolicyId +) . getPositive <$> arbitrary
+          pure (numPolicyIds, numAsssetNames)
+      , do
+          Positive numPolicyIds <- arbitrary
+          let minNumAssetNames = (65535 - 28 * numPolicyIds) `div` 44
+          numAssetNames <- (minNumAssetNames +) . getPositive <$> arbitrary
+          pure (numPolicyIds, numAssetNames)
+      ]
+  -- Here we generate separately a list of asset names and a list of policy ids and
+  -- randomly shuffle them into a MultiAsset
+
+  if numPolicyId > numAssetName -- Since we don't want to generate policies with empty assets
+    then genMultiAssetToFail
+    else do
+      ps <- resize numPolicyId $ vectorOf numPolicyId (arbitrary :: Gen (PolicyID c))
+      as <- resize numAssetName $ vectorOf numAssetName (arbitrary :: Gen (AssetName, Int))
+      let
+        initialTriples = zipWith (\p (a, v) -> (p, a, v)) ps as -- All policies should have at least one asset
+        remainingAs = drop numPolicyId as
+      remainingTriples <-
+        traverse
+          ( \(a, v) -> do
+              policy <- elements ps
+              pure (policy, a, v)
           )
-      )
+          remainingAs
+      pure $
+        let final = multiAssetFromListBounded $ initialTriples <> remainingTriples
+         in traceShow ("FINAL" :: String, numPolicyId, numAssetName, representationSize $ flattenMultiAsset final) final -- TODO
 
 instance Crypto c => Arbitrary (MultiAsset c) where
   arbitrary =

libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Failure.hs

@@ -8,7 +8,7 @@ import Cardano.Ledger.Binary
 import Data.Map (Map)
 import Data.Proxy (Proxy (Proxy))
 import Data.Set (Set)
-import Test.Cardano.Ledger.Binary.RoundTrip (FailureVerbosity (Maximal), Trip (..), embedTripRangeFailureExpectation)
+import Test.Cardano.Ledger.Binary.RoundTrip (Trip (..), embedTripRangeFailureExpectation)
 import Test.Hspec
 import Test.Hspec.QuickCheck
 import Test.QuickCheck
@@ -57,15 +57,15 @@ prop_shouldFailMapWithDupKeys =
   forAllBlind genDuplicateAssocListEncoding $
     \mapEncoding ->
       let trip = Trip id (decCBOR @(Map Int Int)) (dropCBOR (Proxy @(Map Int Int)))
-       in property $ embedTripRangeFailureExpectation Maximal trip (natVersion @9) maxBound mapEncoding
+       in property $ embedTripRangeFailureExpectation trip (natVersion @9) maxBound mapEncoding
 
 -- | Starting in version 9, do not accept duplicates in CBOR sets
 prop_shouldFailSetWithDupKeys :: Property
 prop_shouldFailSetWithDupKeys =
   forAllBlind genDuplicateListEncoding $
     \setEncoding ->
       let trip = Trip id (decCBOR @(Set Int)) (dropCBOR (Proxy @(Set Int)))
-       in property $ embedTripRangeFailureExpectation Maximal trip (natVersion @9) maxBound setEncoding
+       in property $ embedTripRangeFailureExpectation trip (natVersion @9) maxBound setEncoding
 
 spec :: Spec
 spec = do

libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/RoundTrip.hs

@@ -57,9 +57,6 @@ module Test.Cardano.Ledger.Binary.RoundTrip (
   embedTrip,
   embedTripAnn,
   embedTripLabel,
-
-  -- * Verbosity
-  FailureVerbosity (..),
 )
 where
 
@@ -159,43 +156,37 @@ roundTripRangeFailureExpectation ::
   Version ->
   t ->
   Expectation
-roundTripRangeFailureExpectation = embedTripRangeFailureExpectation Maximal
+roundTripRangeFailureExpectation = embedTripRangeFailureExpectation
 
 embedTripFailureExpectation ::
   (Typeable b, HasCallStack) =>
   Trip a b ->
   a ->
   Expectation
-embedTripFailureExpectation trip = embedTripRangeFailureExpectation Maximal trip minBound maxBound
-
-data FailureVerbosity = Maximal | Minimal
+embedTripFailureExpectation trip = embedTripRangeFailureExpectation trip minBound maxBound
 
 embedTripRangeFailureExpectation ::
   forall a b.
   (Typeable b, HasCallStack) =>
-  FailureVerbosity ->
   Trip a b ->
   -- | From Version
   Version ->
   -- | To Version
   Version ->
   a ->
   Expectation
-embedTripRangeFailureExpectation llvl trip fromVersion toVersion t =
+embedTripRangeFailureExpectation trip fromVersion toVersion t =
   forM_ [fromVersion .. toVersion] $ \version ->
     case embedTripLabelExtra (typeLabel @b) version version trip t of
       (Left _, _, _) -> pure ()
       (Right _, _, bs) ->
         expectationFailure $
-          case llvl of
-            Maximal ->
-              mconcat
-                [ "Should not have deserialized: <version: "
-                , show version
-                , "> "
-                , showExpr (CBORBytes (BSL.toStrict bs))
-                ]
-            Minimal -> "Failed"
+          mconcat
+            [ "Should not have deserialized: <version: "
+            , show version
+            , "> "
+            , showExpr (CBORBytes (BSL.toStrict bs))
+            ]
 
 -- | Verify that round triping through the binary form holds for a range of versions.
 --
@@ -348,7 +339,7 @@ data RoundTripFailure = RoundTripFailure
   -- ^ Produced plain encoding
   , rtfEncodedBytes :: BSL.ByteString
   -- ^ Serialized encoding using the version in this failure
-  , rtfReEncodedBytes :: Maybe (BSL.ByteString)
+  , rtfReEncodedBytes :: Maybe BSL.ByteString
   -- ^ Re-serialized bytes, if there was a mismatch between the binary form and the
   -- reserialization of the data type.
   , rtfDropperError :: Maybe DecoderError