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/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 -------------------------------------------------------------------------------------- diff --git a/plutus-core/plutus-core/src/PlutusCore/Value.hs b/plutus-core/plutus-core/src/PlutusCore/Value.hs index 76412b0cb19..2d3ed38ba9a 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,8 +39,8 @@ module PlutusCore.Value import Codec.Serialise qualified as CBOR import Control.DeepSeq (NFData) +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 @@ -217,12 +218,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' #-} @@ -230,7 +231,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. @@ -297,7 +298,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) @@ -318,15 +319,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 @@ -334,22 +335,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, @@ -440,33 +441,85 @@ 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 - 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 - _ -> fail "unValueData: non-Map constructor" +unValueData = \case + Map cs -> do + (outerList, sizes, total, neg) <- goCurrencies cs + 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 - 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" + {-# INLINEABLE unQ #-} - 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 -> fmap (Map.fromListWith unsafeAddQuantity) (traverse (bitraverse unB unQ) ts) + Map ts -> do + when (null ts) $ fail "unValueData: empty inner map" + (innerList, neg) <- goTokens ts + 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 ([(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' = (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 ([(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' = (t, q) : acc + go (Just t) acc' neg' rest {-# INLINEABLE unValueData #-} -- | Decrement bucket @old@, and increment bucket @new@. diff --git a/plutus-core/plutus-core/test/Value/Spec.hs b/plutus-core/plutus-core/test/Value/Spec.hs index 8f927e1966c..9562fd4c2f6 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) @@ -241,6 +242,13 @@ prop_oppositeScaleIsInverse c v = BuiltinSuccess r -> r == V.empty _ -> scaleIncorrectlyBound c v +prop_dataRoundtrip :: Value -> Property +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 @@ -353,7 +361,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 +372,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) @@ -494,6 +505,9 @@ tests = , testProperty "oppositeScaleIsInverse" prop_oppositeScaleIsInverse + , testProperty + "dataRoundtrip" + prop_dataRoundtrip , testProperty "flatRoundtrip" prop_flatRoundtrip