From 5c39a7adce358ab30754471c0310ff9491c71e32 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Tue, 20 Jan 2026 18:34:59 -0800 Subject: [PATCH 1/4] update unValueData to reject non-canonical input --- plutus-conformance/agda/Spec.hs | 6 ++-- ...ate-currencies-cancel.uplc.budget.expected | 3 +- ...-duplicate-currencies-cancel.uplc.expected | 2 +- ...cate-currencies-merge.uplc.budget.expected | 3 +- ...a-duplicate-currencies-merge.uplc.expected | 2 +- ...-duplicate-currencies.uplc.budget.expected | 3 +- .../data-duplicate-currencies.uplc.expected | 2 +- ...data-duplicate-tokens.uplc.budget.expected | 3 +- .../data-duplicate-tokens.uplc.expected | 2 +- .../data-empty-tokens.uplc.budget.expected | 3 +- .../data-empty-tokens.uplc.expected | 2 +- .../data-unordered-currencies.uplc} | 0 ...-unordered-currencies.uplc.budget.expected | 1 + .../data-unordered-currencies.uplc.expected | 1 + .../data-unordered-tokens.uplc | 5 +++ ...data-unordered-tokens.uplc.budget.expected | 1 + .../data-unordered-tokens.uplc.expected | 1 + .../data-unordered.uplc.budget.expected | 2 -- .../data-unordered.uplc.expected | 1 - .../data-zero-quantity.uplc.budget.expected | 3 +- .../data-zero-quantity.uplc.expected | 2 +- .../data-zero-sum.uplc.budget.expected | 3 +- .../data-zero-sum/data-zero-sum.uplc.expected | 2 +- ...20260120_183522_unsafeFixIO_unValueData.md | 4 +++ .../plutus-core/src/PlutusCore/Value.hs | 35 ++++++++++++++----- plutus-core/plutus-core/test/Value/Spec.hs | 8 +++-- 26 files changed, 63 insertions(+), 37 deletions(-) rename plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/{data-unordered/data-unordered.uplc => data-unordered-currencies/data-unordered-currencies.uplc} (100%) create mode 100644 plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.budget.expected create mode 100644 plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.expected create mode 100644 plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc create mode 100644 plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.budget.expected create mode 100644 plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.expected delete mode 100644 plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.budget.expected delete mode 100644 plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.expected create mode 100644 plutus-core/changelog.d/20260120_183522_unsafeFixIO_unValueData.md diff --git a/plutus-conformance/agda/Spec.hs b/plutus-conformance/agda/Spec.hs index 72c83477e11..fc317ea3eb7 100644 --- a/plutus-conformance/agda/Spec.hs +++ b/plutus-conformance/agda/Spec.hs @@ -239,7 +239,8 @@ failingEvaluationTests = , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens" - , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered" + , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies" + , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/non-map-integer" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/non-map-constr" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/non-map-list" @@ -391,7 +392,8 @@ failingBudgetTests = , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens" - , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered" + , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies" + , "test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/non-map-integer" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/non-map-constr" , "test-cases/uplc/evaluation/builtin/semantics/unValueData/non-map-list" diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.budget.expected index bcd4e8c7850..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 4352525 -| mem: 432}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.expected index 940e2e2d23b..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-cancel/data-duplicate-currencies-cancel.uplc.expected @@ -1 +1 @@ -(program 1.0.0 (con value [(#bb, [(#bb, 2)]), (#cc, [(#cc, 2)])])) +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.budget.expected index bcd4e8c7850..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 4352525 -| mem: 432}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.expected index 8695c852ef7..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies-merge/data-duplicate-currencies-merge.uplc.expected @@ -1 +1 @@ -(program 1.0.0 (con value [(#aa, [(#aa, 246)]), (#bb, [(#bb, 2)]), (#cc, [(#cc, 2)])])) +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.budget.expected index 95dedcb266f..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 1893317 -| mem: 420}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.expected index 6f5c97c8b0b..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-currencies/data-duplicate-currencies.uplc.expected @@ -1 +1 @@ -(program 1.0.0 (con value [(#aa, [(#bb, 100), (#cc, 50)])])) +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.budget.expected index 7e16e2a2bb9..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 1483477 -| mem: 418}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.expected index 58600ebb785..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-duplicate-tokens/data-duplicate-tokens.uplc.expected @@ -1 +1 @@ -(program 1.0.0 (con value [(#aa, [(#bb, 150)])])) +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.budget.expected index 948fb443aa1..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 663821 -| mem: 414}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.expected index 7d7c99a0689..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-empty-tokens/data-empty-tokens.uplc.expected @@ -1 +1 @@ -(program 1.0.0 (con value [])) +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc similarity index 100% rename from plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc rename to plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.budget.expected new file mode 100644 index 00000000000..ccc477ffed6 --- /dev/null +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.budget.expected @@ -0,0 +1 @@ +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.expected new file mode 100644 index 00000000000..ccc477ffed6 --- /dev/null +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-currencies/data-unordered-currencies.uplc.expected @@ -0,0 +1 @@ +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc new file mode 100644 index 00000000000..51ff7b42782 --- /dev/null +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc @@ -0,0 +1,5 @@ +(program 1.0.0 + [(builtin unValueData) + (con data (Map [(B #aa, Map [(B #cc, I 100), (B #bb, I 50)])])) + ] +) diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.budget.expected new file mode 100644 index 00000000000..ccc477ffed6 --- /dev/null +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.budget.expected @@ -0,0 +1 @@ +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.expected new file mode 100644 index 00000000000..ccc477ffed6 --- /dev/null +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered-tokens/data-unordered-tokens.uplc.expected @@ -0,0 +1 @@ +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.budget.expected deleted file mode 100644 index 95dedcb266f..00000000000 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.budget.expected +++ /dev/null @@ -1,2 +0,0 @@ -({cpu: 1893317 -| mem: 420}) \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.expected deleted file mode 100644 index 2688efe3547..00000000000 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-unordered/data-unordered.uplc.expected +++ /dev/null @@ -1 +0,0 @@ -(program 1.0.0 (con value [(#aa, [(#cc, 20)]), (#bb, [(#aa, 10)])])) diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.budget.expected index 7e16e2a2bb9..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 1483477 -| mem: 418}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.expected index 1286d957604..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-quantity/data-zero-quantity.uplc.expected @@ -1 +1 @@ -(program 1.0.0 (con value [(#aa, [(#cc, 100)])])) +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.budget.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.budget.expected index 7e16e2a2bb9..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.budget.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.budget.expected @@ -1,2 +1 @@ -({cpu: 1483477 -| mem: 418}) \ No newline at end of file +evaluation failure \ No newline at end of file diff --git a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.expected b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.expected index 7d7c99a0689..ccc477ffed6 100644 --- a/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.expected +++ b/plutus-conformance/test-cases/uplc/evaluation/builtin/semantics/unValueData/data-zero-sum/data-zero-sum.uplc.expected @@ -1 +1 @@ -(program 1.0.0 (con value [])) +evaluation failure \ No newline at end of file diff --git a/plutus-core/changelog.d/20260120_183522_unsafeFixIO_unValueData.md b/plutus-core/changelog.d/20260120_183522_unsafeFixIO_unValueData.md new file mode 100644 index 00000000000..9498094be36 --- /dev/null +++ b/plutus-core/changelog.d/20260120_183522_unsafeFixIO_unValueData.md @@ -0,0 +1,4 @@ + +### Changed + +- Updated `unValueData` to reject non-canonical input, based on https://github.com/cardano-foundation/CIPs/pull/1134 diff --git a/plutus-core/plutus-core/src/PlutusCore/Value.hs b/plutus-core/plutus-core/src/PlutusCore/Value.hs index 76412b0cb19..cddb739879d 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Value.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Value.hs @@ -38,6 +38,7 @@ module PlutusCore.Value import Codec.Serialise qualified as CBOR import Control.DeepSeq (NFData) +import Control.Monad (when) import Data.Bifunctor import Data.Bitraversable import Data.ByteString (ByteString) @@ -440,17 +441,15 @@ valueData = Map . fmap (bimap (B . unK) tokensData) . Map.toList . unpack tokensData = Map . fmap (bimap (B . unK) (I . unQuantity)) . Map.toList {-# INLINEABLE valueData #-} -{-| \(O(n \log n)\). Decodes `Data` into `Value`, in the same way as non-builtin @Value@. +{-| \(O(n)\). Decodes `Data` into `Value`. This is the denotation of @UnValueData@ in Plutus V1, V2 and V3. -} unValueData :: Data -> BuiltinResult Value unValueData = - fmap pack . \case + fmap pack' . \case Map cs -> do - -- Use unchecked addition during construction - outerMap <- - Map.fromListWith (Map.unionWith unsafeAddQuantity) <$> traverse (bitraverse unB unTokens) cs - -- Validate all quantities are within bounds - validateQuantities outerMap + cs' <- traverse (bitraverse unB unTokens) cs + ensureDistinctAsc "unValueData: currency symbols not strictly ascending" (fst <$> cs') + pure $ Map.fromDistinctAscList cs' _ -> fail "unValueData: non-Map constructor" where unB :: Data -> BuiltinResult K @@ -460,15 +459,33 @@ unValueData = unQ :: Data -> BuiltinResult Quantity unQ = \case - I i -> pure (UnsafeQuantity i) + I i + | i == 0 || i < unQuantity minBound || i > unQuantity maxBound -> + fail "unValueData: invalid quantity" + | otherwise -> pure (UnsafeQuantity i) _ -> fail "unValueData: non-I constructor" unTokens :: Data -> BuiltinResult (Map K Quantity) unTokens = \case - Map ts -> fmap (Map.fromListWith unsafeAddQuantity) (traverse (bitraverse unB unQ) ts) + Map ts -> do + when (null ts) $ fail "unValueData: empty inner map" + ts' <- traverse (bitraverse unB unQ) ts + ensureDistinctAsc "unValueData: token names not strictly ascending" (fst <$> ts') + pure $ Map.fromDistinctAscList ts' _ -> fail "unValueData: non-Map constructor" {-# INLINEABLE unValueData #-} +ensureDistinctAsc :: String -> [K] -> BuiltinResult () +ensureDistinctAsc msg = go + where + go = \case + [] -> pure () + [_] -> pure () + x : xs@(y : _) + | x < y -> go xs + | otherwise -> fail msg +{-# INLINEABLE ensureDistinctAsc #-} + -- | Decrement bucket @old@, and increment bucket @new@. updateSizes :: Int -> Int -> IntMap Int -> IntMap Int updateSizes old new = dec . inc diff --git a/plutus-core/plutus-core/test/Value/Spec.hs b/plutus-core/plutus-core/test/Value/Spec.hs index 8f927e1966c..9dadd2251b1 100644 --- a/plutus-core/plutus-core/test/Value/Spec.hs +++ b/plutus-core/plutus-core/test/Value/Spec.hs @@ -10,6 +10,7 @@ import Data.ByteString (ByteString) import Data.ByteString qualified as B import Data.Either import Data.Foldable qualified as F +import Data.List.Extra (nubOrdOn, sortOn) import Data.Map.Strict qualified as Map import Data.Maybe import Safe.Foldable (maximumMay) @@ -353,7 +354,7 @@ prop_unValueDataValidatesMixedQuantities = genValueDataWithMixedQuantities :: Gen (Data, Bool) genValueDataWithMixedQuantities = do numEntries <- chooseInt (1, 10) - entries <- vectorOf numEntries $ do + entries <- fmap (nubOrdOn fst . sortOn fst) . vectorOf numEntries $ do c <- gen32BytesOrFewer t <- gen32BytesOrFewer -- 90% valid, 10% invalid @@ -364,7 +365,10 @@ prop_unValueDataValidatesMixedQuantities = ] pure (B c, Map [(B t, I quantity)]) let hasInvalid = any (\(_, Map inner) -> any isInvalidQuantity inner) entries - isInvalidQuantity (_, I q) = q < V.unQuantity minBound || q > V.unQuantity maxBound + isInvalidQuantity (_, I q) = + q < V.unQuantity minBound + || q > V.unQuantity maxBound + || q == 0 isInvalidQuantity _ = False pure (Map entries, hasInvalid) From 790fcc0915854cad10247aa69bcefb7bc7e2bc6d Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Wed, 21 Jan 2026 12:17:09 -0800 Subject: [PATCH 2/4] Fuse traversals --- .../plutus-core/src/PlutusCore/Value.hs | 113 ++++++++++++------ plutus-core/plutus-core/test/Value/Spec.hs | 8 ++ 2 files changed, 82 insertions(+), 39 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Value.hs b/plutus-core/plutus-core/src/PlutusCore/Value.hs index cddb739879d..b2d1c970ee7 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Value.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Value.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} @@ -38,12 +39,13 @@ module PlutusCore.Value import Codec.Serialise qualified as CBOR import Control.DeepSeq (NFData) -import Control.Monad (when) +import Control.Monad.Extra (unless, when, whenJust) import Data.Bifunctor -import Data.Bitraversable import Data.ByteString (ByteString) import Data.ByteString qualified as B import Data.ByteString.Base64 qualified as Base64 +import Data.DList (DList) +import Data.DList qualified as DList import Data.Foldable (find) import Data.Hashable (Hashable (..)) import Data.IntMap.Strict (IntMap) @@ -218,12 +220,12 @@ pack = pack' . normalize -- | Like `pack` but does not normalize. pack' :: NestedMap -> Value -pack' v = Value v sizes size neg +pack' v = Value v sizes total neg where - (sizes, size, neg) = Map.foldl' alg (mempty, 0, 0) v - alg (ss, s, n) inner = + (sizes, total, neg) = Map.foldl' alg (mempty, 0, 0) v + alg (ss, t, n) inner = ( IntMap.alter (maybe (Just 1) (Just . (+ 1))) (Map.size inner) ss - , s + Map.size inner + , t + Map.size inner , n + Map.size (Map.filter (< zeroQuantity) inner) ) {-# INLINEABLE pack' #-} @@ -231,7 +233,7 @@ pack' v = Value v sizes size neg {-| Total size, i.e., the number of distinct `(currency symbol, token name)` pairs contained in the `Value`. -} totalSize :: Value -> Int -totalSize (Value _ _ size _) = size +totalSize (Value _ _ total _) = total {-# INLINE totalSize #-} -- | Size of the largest inner map. @@ -298,7 +300,7 @@ instance Pretty Value where {-| \(O(\log \max(m, k))\), where \(m\) is the size of the outer map, and \(k\) is the size of the largest inner map. -} insertCoin :: ByteString -> ByteString -> Integer -> Value -> BuiltinResult Value -insertCoin unsafeCurrency unsafeToken unsafeAmount v@(Value outer sizes size neg) +insertCoin unsafeCurrency unsafeToken unsafeAmount v@(Value outer sizes total neg) | unsafeAmount == 0 = pure $ deleteCoin unsafeCurrency unsafeToken v | otherwise = case (k unsafeCurrency, k unsafeToken, quantity unsafeAmount) of (Nothing, _, _) -> fail $ "insertCoin: invalid currency: " <> show (B.unpack unsafeCurrency) @@ -319,15 +321,15 @@ insertCoin unsafeCurrency unsafeToken unsafeAmount v@(Value outer sizes size neg Map.insertLookupWithKey (\_ _ _ -> qty) token qty inner in (maybe (Left (Map.size inner)) Right mOldQuantity, Just inner') (res, outer') = Map.alterF f currency outer - (sizes', size', neg') = case res of + (sizes', total', neg') = case res of Left oldSize -> ( updateSizes oldSize (oldSize + 1) sizes - , size + 1 + , total + 1 , if qty < zeroQuantity then neg + 1 else neg ) Right oldQuantity -> ( sizes - , size + , total , if oldQuantity < zeroQuantity && qty > zeroQuantity then neg - 1 else @@ -335,22 +337,22 @@ insertCoin unsafeCurrency unsafeToken unsafeAmount v@(Value outer sizes size neg then neg + 1 else neg ) - in pure $ Value outer' sizes' size' neg' + in pure $ Value outer' sizes' total' neg' {-# INLINEABLE insertCoin #-} -- | \(O(\log \max(m, k))\) deleteCoin :: ByteString -> ByteString -> Value -> Value -deleteCoin (UnsafeK -> currency) (UnsafeK -> token) (Value outer sizes size neg) = - Value outer' sizes' size' neg' +deleteCoin (UnsafeK -> currency) (UnsafeK -> token) (Value outer sizes total neg) = + Value outer' sizes' total' neg' where (mold, outer') = Map.alterF f currency outer - (sizes', size', neg') = case mold of + (sizes', total', neg') = case mold of Just (oldSize, oldQuantity) -> ( updateSizes oldSize (oldSize - 1) sizes - , size - 1 + , total - 1 , if oldQuantity < zeroQuantity then neg - 1 else neg ) - Nothing -> (sizes, size, neg) + Nothing -> (sizes, total, neg) f :: Maybe (Map K Quantity) -> ( -- Just (old size of inner map, old quantity) if the total size shrinks by 1, @@ -444,13 +446,11 @@ valueData = Map . fmap (bimap (B . unK) tokensData) . Map.toList . unpack {-| \(O(n)\). Decodes `Data` into `Value`. This is the denotation of @UnValueData@ in Plutus V1, V2 and V3. -} unValueData :: Data -> BuiltinResult Value -unValueData = - fmap pack' . \case - Map cs -> do - cs' <- traverse (bitraverse unB unTokens) cs - ensureDistinctAsc "unValueData: currency symbols not strictly ascending" (fst <$> cs') - pure $ Map.fromDistinctAscList cs' - _ -> fail "unValueData: non-Map constructor" +unValueData = \case + Map cs -> do + (outerList, sizes, total, neg) <- goCurrencies cs + pure $ Value (Map.fromDistinctAscList (DList.toList outerList)) sizes total neg + _ -> fail "unValueData: non-Map constructor" where unB :: Data -> BuiltinResult K unB = \case @@ -465,26 +465,61 @@ unValueData = | otherwise -> pure (UnsafeQuantity i) _ -> fail "unValueData: non-I constructor" - unTokens :: Data -> BuiltinResult (Map K Quantity) + -- Returns the inner map and the number of negative quantities in it. + unTokens :: Data -> BuiltinResult (Map K Quantity, Int) unTokens = \case Map ts -> do when (null ts) $ fail "unValueData: empty inner map" - ts' <- traverse (bitraverse unB unQ) ts - ensureDistinctAsc "unValueData: token names not strictly ascending" (fst <$> ts') - pure $ Map.fromDistinctAscList ts' + (innerList, neg) <- goTokens ts + pure (Map.fromDistinctAscList (DList.toList innerList), neg) _ -> fail "unValueData: non-Map constructor" -{-# INLINEABLE unValueData #-} -ensureDistinctAsc :: String -> [K] -> BuiltinResult () -ensureDistinctAsc msg = go - where - go = \case - [] -> pure () - [_] -> pure () - x : xs@(y : _) - | x < y -> go xs - | otherwise -> fail msg -{-# INLINEABLE ensureDistinctAsc #-} + -- Returns outer map's list, plus stats (sizes, total, neg). + goCurrencies + :: [(Data, Data)] + -> BuiltinResult (DList (K, Map K Quantity), IntMap Int, Int, Int) + goCurrencies = go Nothing mempty mempty 0 0 + where + go !prev !acc !sizes !total !neg = \case + [] -> pure (acc, sizes, total, neg) + (cData, tsData) : rest -> do + c <- unB cData + -- Verify that currencies are strictly ascending + whenJust + prev + ( \p -> + unless + (p < c) + (fail "unValueData: currency symbols not strictly ascending") + ) + (inner, innerNeg) <- unTokens tsData + let sizes' = IntMap.alter (maybe (Just 1) (Just . (+ 1))) (Map.size inner) sizes + total' = total + Map.size inner + neg' = neg + innerNeg + acc' = DList.snoc acc (c, inner) + go (Just c) acc' sizes' total' neg' rest + + -- Returns inner map's list, plus the number of negative quantities in the inner map. + goTokens :: [(Data, Data)] -> BuiltinResult (DList (K, Quantity), Int) + goTokens = go Nothing mempty 0 + where + go !prev !acc !neg = \case + [] -> pure (acc, neg) + (tData, qData) : rest -> do + t <- unB tData + -- Verify that token names within an inner map are strictly ascending + whenJust + prev + ( \p -> + unless + (p < t) + (fail "unValueData: token names not strictly ascending") + ) + q <- unQ qData + let neg' = if q < zeroQuantity then neg + 1 else neg + acc' = DList.snoc acc (t, q) + go (Just t) acc' neg' rest +{-# INLINEABLE unValueData #-} -- | Decrement bucket @old@, and increment bucket @new@. updateSizes :: Int -> Int -> IntMap Int -> IntMap Int diff --git a/plutus-core/plutus-core/test/Value/Spec.hs b/plutus-core/plutus-core/test/Value/Spec.hs index 9dadd2251b1..ed4e5472166 100644 --- a/plutus-core/plutus-core/test/Value/Spec.hs +++ b/plutus-core/plutus-core/test/Value/Spec.hs @@ -242,6 +242,11 @@ prop_oppositeScaleIsInverse c v = BuiltinSuccess r -> r == V.empty _ -> scaleIncorrectlyBound c v +prop_dataRoundtrip :: Value -> Property +prop_dataRoundtrip v = case V.unValueData (V.valueData v) of + BuiltinSuccess v' -> v === v' + _ -> property False + prop_flatRoundtrip :: Value -> Property prop_flatRoundtrip v = Flat.unflat (Flat.flat v) === Right v @@ -498,6 +503,9 @@ tests = , testProperty "oppositeScaleIsInverse" prop_oppositeScaleIsInverse + , testProperty + "dataRoundtrip" + prop_dataRoundtrip , testProperty "flatRoundtrip" prop_flatRoundtrip From 64224fc4d82a69d71606fc68007defb132989990 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Wed, 21 Jan 2026 19:01:16 -0800 Subject: [PATCH 3/4] Update Benchmarks.values --- plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs index 4ec031d9b67..57449b16a9e 100644 --- a/plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Values.hs @@ -23,7 +23,6 @@ import GHC.Stack (HasCallStack) import PlutusCore (DefaultFun (InsertCoin, LookupCoin, ScaleValue, UnValueData, UnionValue, ValueContains, ValueData)) import PlutusCore.Builtin (BuiltinResult (BuiltinFailure, BuiltinSuccess, BuiltinSuccessWithLogs)) -import PlutusCore.Data qualified as Data import PlutusCore.Evaluation.Machine.ExMemoryUsage ( DataNodeCount (..) , ValueMaxDepth (..) @@ -280,10 +279,7 @@ unValueDataBenchmark gen = DataNodeCount UnValueData [] - (f . Value.valueData <$> generateTestValues gen) - where - f (Data.Map l) = Data.Map (reverse l) - f _ = error "NO" + (Value.valueData <$> generateTestValues gen) ---------------------------------------------------------------------------------------------------- -- InsertCoin -------------------------------------------------------------------------------------- From ecf20f2a198659b86363951bf4d35c38e805f2b9 Mon Sep 17 00:00:00 2001 From: Ziyang Liu Date: Thu, 22 Jan 2026 09:12:31 -0800 Subject: [PATCH 4/4] Use regular list and fromDistinctDescList --- .../plutus-core/src/PlutusCore/Value.hs | 25 ++++++++++--------- plutus-core/plutus-core/test/Value/Spec.hs | 6 +++-- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/plutus-core/plutus-core/src/PlutusCore/Value.hs b/plutus-core/plutus-core/src/PlutusCore/Value.hs index b2d1c970ee7..2d3ed38ba9a 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Value.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Value.hs @@ -44,8 +44,6 @@ import Data.Bifunctor import Data.ByteString (ByteString) import Data.ByteString qualified as B import Data.ByteString.Base64 qualified as Base64 -import Data.DList (DList) -import Data.DList qualified as DList import Data.Foldable (find) import Data.Hashable (Hashable (..)) import Data.IntMap.Strict (IntMap) @@ -449,13 +447,14 @@ unValueData :: Data -> BuiltinResult Value unValueData = \case Map cs -> do (outerList, sizes, total, neg) <- goCurrencies cs - pure $ Value (Map.fromDistinctAscList (DList.toList outerList)) sizes total neg + pure $ Value (Map.fromDistinctDescList outerList) sizes total neg _ -> fail "unValueData: non-Map constructor" where unB :: Data -> BuiltinResult K unB = \case B b -> maybe (fail $ "unValueData: invalid key: " <> show (B.unpack b)) pure (k b) _ -> fail "unValueData: non-B constructor" + {-# INLINEABLE unB #-} unQ :: Data -> BuiltinResult Quantity unQ = \case @@ -464,6 +463,7 @@ unValueData = \case fail "unValueData: invalid quantity" | otherwise -> pure (UnsafeQuantity i) _ -> fail "unValueData: non-I constructor" + {-# INLINEABLE unQ #-} -- Returns the inner map and the number of negative quantities in it. unTokens :: Data -> BuiltinResult (Map K Quantity, Int) @@ -471,19 +471,20 @@ unValueData = \case Map ts -> do when (null ts) $ fail "unValueData: empty inner map" (innerList, neg) <- goTokens ts - pure (Map.fromDistinctAscList (DList.toList innerList), neg) + pure (Map.fromDistinctDescList innerList, neg) _ -> fail "unValueData: non-Map constructor" + {-# INLINEABLE unTokens #-} -- Returns outer map's list, plus stats (sizes, total, neg). goCurrencies :: [(Data, Data)] - -> BuiltinResult (DList (K, Map K Quantity), IntMap Int, Int, Int) + -> BuiltinResult ([(K, Map K Quantity)], IntMap Int, Int, Int) goCurrencies = go Nothing mempty mempty 0 0 where go !prev !acc !sizes !total !neg = \case [] -> pure (acc, sizes, total, neg) (cData, tsData) : rest -> do - c <- unB cData + !c <- unB cData -- Verify that currencies are strictly ascending whenJust prev @@ -492,21 +493,21 @@ unValueData = \case (p < c) (fail "unValueData: currency symbols not strictly ascending") ) - (inner, innerNeg) <- unTokens tsData + (!inner, !innerNeg) <- unTokens tsData let sizes' = IntMap.alter (maybe (Just 1) (Just . (+ 1))) (Map.size inner) sizes total' = total + Map.size inner neg' = neg + innerNeg - acc' = DList.snoc acc (c, inner) + acc' = (c, inner) : acc go (Just c) acc' sizes' total' neg' rest -- Returns inner map's list, plus the number of negative quantities in the inner map. - goTokens :: [(Data, Data)] -> BuiltinResult (DList (K, Quantity), Int) + goTokens :: [(Data, Data)] -> BuiltinResult ([(K, Quantity)], Int) goTokens = go Nothing mempty 0 where go !prev !acc !neg = \case [] -> pure (acc, neg) (tData, qData) : rest -> do - t <- unB tData + !t <- unB tData -- Verify that token names within an inner map are strictly ascending whenJust prev @@ -515,9 +516,9 @@ unValueData = \case (p < t) (fail "unValueData: token names not strictly ascending") ) - q <- unQ qData + !q <- unQ qData let neg' = if q < zeroQuantity then neg + 1 else neg - acc' = DList.snoc acc (t, q) + acc' = (t, q) : acc go (Just t) acc' neg' rest {-# INLINEABLE unValueData #-} diff --git a/plutus-core/plutus-core/test/Value/Spec.hs b/plutus-core/plutus-core/test/Value/Spec.hs index ed4e5472166..9562fd4c2f6 100644 --- a/plutus-core/plutus-core/test/Value/Spec.hs +++ b/plutus-core/plutus-core/test/Value/Spec.hs @@ -243,9 +243,11 @@ prop_oppositeScaleIsInverse c v = _ -> scaleIncorrectlyBound c v prop_dataRoundtrip :: Value -> Property -prop_dataRoundtrip v = case V.unValueData (V.valueData v) of - BuiltinSuccess v' -> v === v' +prop_dataRoundtrip v = case V.unValueData d of + BuiltinSuccess v' -> (v === v') .&&. (V.valueData v' === d) _ -> property False + where + d = V.valueData v prop_flatRoundtrip :: Value -> Property prop_flatRoundtrip v = Flat.unflat (Flat.flat v) === Right v