From 613ab5f1716430b8122a8688c899b2705d9d2722 Mon Sep 17 00:00:00 2001 From: Kenneth MacKenzie Date: Mon, 29 Jul 2024 12:07:31 +0100 Subject: [PATCH] Make NumBytesCostedAsNumWords use Integer instead of Int (#6350) The `NumBytesCostedAsNumWords` wrapper contained an `Int`, but this changes it to `Integer` for consistency with the other wrappers. This change also affects the type of `Bitwise.replicateByte`. --- .../budgeting-bench/Benchmarks/Bitwise.hs | 8 +--- .../plutus-core/src/PlutusCore/Bitwise.hs | 43 +++++++++---------- .../src/PlutusCore/Default/Builtins.hs | 8 +--- .../Evaluation/Machine/ExMemoryUsage.hs | 14 +++++- .../test/Evaluation/Builtins/Conversion.hs | 19 ++++---- plutus-tx/src/PlutusTx/Builtins/Internal.hs | 2 +- 6 files changed, 47 insertions(+), 47 deletions(-) diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs index d3621bc7301..0af273555ff 100644 --- a/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs @@ -46,10 +46,6 @@ topBitIndex s = fromIntegral $ 8*(BS.length s)-1 memoryUsageAsNumBytes :: ExMemoryUsage a => a -> Int memoryUsageAsNumBytes = (8*) . fromSatInt . sumCostStream . flattenCostRose . memoryUsage --- An explicit conversion to avoid some type annotations later. -integerToInt :: Integer -> Int -integerToInt = fromIntegral - {- Experiments show that the times for big-endian and little-endian `byteStringToInteger` conversions are very similar, with big-endian conversion perhaps taking a fraction longer. We just generate a costing @@ -81,7 +77,7 @@ benchIntegerToByteString = -- The minimum width of bytestring needed to fit the inputs into. widthsInBytes = fmap (fromIntegral . memoryUsageAsNumBytes) inputs in createThreeTermBuiltinBenchElementwiseWithWrappers - (id, NumBytesCostedAsNumWords . integerToInt, id) b [] $ + (id, NumBytesCostedAsNumWords, id) b [] $ zip3 (repeat True) widthsInBytes inputs {- For `andByteString` with different-sized inputs, calling it with extension @@ -174,7 +170,7 @@ benchReplicateByte = -- ^ This gives us replication counts up to 64*128 = 8192, the maximum allowed. inputs = pairWith (const (0xFF::Integer)) xs in createTwoTermBuiltinBenchElementwiseWithWrappers - (NumBytesCostedAsNumWords . fromIntegral, id) ReplicateByte [] inputs + (NumBytesCostedAsNumWords, id) ReplicateByte [] inputs {- Benchmarks with varying sizes of bytestrings and varying amounts of shifting show that the execution time of `shiftByteString` depends linearly on the diff --git a/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs b/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs index 8f41cfd9078..d43f0d49020 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs @@ -14,7 +14,7 @@ module PlutusCore.Bitwise ( rotateByteStringWrapper, -- * Implementation details IntegerToByteStringError (..), - integerToByteStringMaximumOutputLength, + maximumOutputLength, integerToByteString, byteStringToInteger, andByteString, @@ -53,20 +53,17 @@ import GHC.Exts (Int (I#)) import GHC.Integer.Logarithms (integerLog2#) import GHC.IO.Unsafe (unsafeDupablePerformIO) -{- Note [Input length limitation for IntegerToByteString]. We make - `integerToByteString` fail if it is called with arguments which would cause - the length of the result to exceed about 8K bytes because the execution time - becomes difficult to predict accurately beyond this point (benchmarks on a - number of different machines show that the CPU time increases smoothly for - inputs up to about 8K then increases sharply, becoming chaotic after about - 14K). This restriction may be removed once a more efficient implementation - becomes available, which may happen when we no longer have to support GHC - 8.10. -} -{- NB: if we do relax the length restriction then we will need two variants of - integerToByteString in Plutus Core so that we can continue to support the - current behaviour for old scripts.-} -integerToByteStringMaximumOutputLength :: Integer -integerToByteStringMaximumOutputLength = 8192 +{- Note [Input length limitation for IntegerToByteString]. +We make `integerToByteString` and `replicateByte` fail if they're called with arguments which would +cause the length of the result to exceed about 8K bytes because the execution time becomes difficult +to predict accurately beyond this point (benchmarks on a number of different machines show that the +CPU time increases smoothly for inputs up to about 8K then increases sharply, becoming chaotic after +about 14K). This restriction may be removed once a more efficient implementation becomes available, +which may happen when we no longer have to support GHC 8.10. -} +{- NB: if we do relax the length restriction then we will need two variants of integerToByteString in + Plutus Core so that we can continue to support the current behaviour for old scripts.-} +maximumOutputLength :: Integer +maximumOutputLength = 8192 {- Return the base 2 logarithm of an integer, returning 0 for inputs that aren't strictly positive. This is essentially copied from GHC.Num.Integer, which @@ -85,9 +82,9 @@ integerToByteStringWrapper endiannessArg lengthArg input evaluationFailure -- Check that the requested length does not exceed the limit. *NB*: if we remove the limit we'll -- still have to make sure that the length fits into an Int. - | lengthArg > integerToByteStringMaximumOutputLength = do + | lengthArg > maximumOutputLength = do emit . pack $ "integerToByteString: requested length is too long (maximum is " - ++ show integerToByteStringMaximumOutputLength + ++ show maximumOutputLength ++ " bytes)" emit $ "Length requested: " <> (pack . show $ lengthArg) evaluationFailure @@ -96,12 +93,12 @@ integerToByteStringWrapper endiannessArg lengthArg input -- limit. If the requested length is nonzero and less than the limit, -- integerToByteString checks that the input fits. | lengthArg == 0 -- integerLog2 n is one less than the number of significant bits in n - && fromIntegral (integerLog2 input) >= 8 * integerToByteStringMaximumOutputLength = + && fromIntegral (integerLog2 input) >= 8 * maximumOutputLength = let bytesRequiredFor n = integerLog2 n `div` 8 + 1 -- ^ This gives 1 instead of 0 for n=0, but we'll never get that. in do emit . pack $ "integerToByteString: input too long (maximum is 2^" - ++ show (8 * integerToByteStringMaximumOutputLength) + ++ show (8 * maximumOutputLength) ++ "-1)" emit $ "Length required: " <> (pack . show $ bytesRequiredFor input) evaluationFailure @@ -599,18 +596,18 @@ writeBits bs ixs bits = case unsafeDupablePerformIO . try $ go of -- | Byte replication, as per [CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122) -- We want to cautious about the allocation of huge amounts of memory so we -- impose the same length limit that's used in integerToByteString. -replicateByte :: Int -> Word8 -> BuiltinResult ByteString +replicateByte :: Integer -> Word8 -> BuiltinResult ByteString replicateByte len w8 | len < 0 = do emit "replicateByte: negative length requested" evaluationFailure - | toInteger len > integerToByteStringMaximumOutputLength = do + | len > maximumOutputLength = do emit . pack $ "replicateByte: requested length is too long (maximum is " - ++ show integerToByteStringMaximumOutputLength + ++ show maximumOutputLength ++ " bytes)" emit $ "Length requested: " <> (pack . show $ len) evaluationFailure - | otherwise = pure . BS.replicate len $ w8 + | otherwise = pure . BS.replicate (fromIntegral len) $ w8 -- | Wrapper for calling 'shiftByteString' safely. Specifically, we avoid various edge cases: -- diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs index cc437bbd89a..b3bd314cf76 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs @@ -1872,12 +1872,8 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where toBuiltinMeaning _semvar IntegerToByteString = let integerToByteStringDenotation :: Bool -> NumBytesCostedAsNumWords -> Integer -> BuiltinResult BS.ByteString {- The second argument is wrapped in a NumBytesCostedAsNumWords to allow us to - interpret it as a size during costing. Elsewhere we need - `NumBytesCostedAsNumWords` to contain an `Int` so we re-use that - here at the cost of not being able to convert an integer to a - bytestring of length greater than 2^63-1, which we're never going - to want to do anyway. -} - integerToByteStringDenotation b (NumBytesCostedAsNumWords w) = Bitwise.integerToByteStringWrapper b $ toInteger w + interpret it as a size during costing. -} + integerToByteStringDenotation b (NumBytesCostedAsNumWords w) = Bitwise.integerToByteStringWrapper b w {-# INLINE integerToByteStringDenotation #-} in makeBuiltinMeaning integerToByteStringDenotation diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs index 090ad7c3dab..e3b4fb2136e 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs @@ -179,10 +179,14 @@ instance ExMemoryUsage () where denotation of a builtin then it *MUST* also be used to wrap the same argument in the relevant budgeting benchmark. -} -newtype NumBytesCostedAsNumWords = NumBytesCostedAsNumWords { unNumBytesCostedAsNumWords :: Int } +newtype NumBytesCostedAsNumWords = NumBytesCostedAsNumWords { unNumBytesCostedAsNumWords :: Integer } instance ExMemoryUsage NumBytesCostedAsNumWords where memoryUsage (NumBytesCostedAsNumWords n) = singletonRose . fromIntegral $ ((n-1) `div` 8) + 1 {-# INLINE memoryUsage #-} + -- Note that this uses `fromIntegral`, which will narrow large values to + -- maxBound::SatInt = 2^63-1. This shouldn't be a problem for costing because no + -- realistic input should be that large; however if you're going to use this then be + -- sure to convince yourself that it's safe. {- | A wrapper for `Integer`s whose "memory usage" for costing purposes is the absolute value of the `Integer`. This is used for costing built-in functions @@ -195,6 +199,10 @@ newtype IntegerCostedLiterally = IntegerCostedLiterally { unIntegerCostedLiteral instance ExMemoryUsage IntegerCostedLiterally where memoryUsage (IntegerCostedLiterally n) = singletonRose . fromIntegral $ abs n {-# INLINE memoryUsage #-} + -- Note that this uses `fromIntegral`, which will narrow large values to + -- maxBound::SatInt = 2^63-1. This shouldn't be a problem for costing because no + -- realistic input should be that large; however if you're going to use this then be + -- sure to convince yourself that it's safe. {- | A wrappper for lists whose "memory usage" for costing purposes is just the length of the list, ignoring the sizes of the elements. If this is used to @@ -204,6 +212,10 @@ newtype ListCostedByLength a = ListCostedByLength { unListCostedByLength :: [a] instance ExMemoryUsage (ListCostedByLength a) where memoryUsage (ListCostedByLength l) = singletonRose . fromIntegral $ length l {-# INLINE memoryUsage #-} + -- Note that this uses `fromIntegral`, which will narrow large values to + -- maxBound::SatInt = 2^63-1. This shouldn't be a problem for costing because no + -- realistic input should be that large; however if you're going to use this then be + -- sure to convince yourself that it's safe. -- | Calculate a 'CostingInteger' for the given 'Integer'. memoryUsageInteger :: Integer -> CostingInteger diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs index 34c891554b3..f212938aa9f 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Conversion.hs @@ -21,7 +21,7 @@ module Evaluation.Builtins.Conversion ( import Evaluation.Builtins.Common (typecheckEvaluateCek) import PlutusCore qualified as PLC -import PlutusCore.Bitwise (integerToByteStringMaximumOutputLength) +import PlutusCore.Bitwise qualified as Bitwise (maximumOutputLength) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultBuiltinCostModelForTesting) import PlutusCore.MkPlc (builtin, mkConstant, mkIterAppNoAnn) import PlutusPrelude (Word8, def) @@ -47,7 +47,7 @@ i2bProperty1 = do e <- forAllWith ppShow Gen.bool -- We limit this temporarily due to the limit imposed on lengths for the -- conversion primitive. - d <- forAllWith ppShow $ Gen.integral (Range.constant 0 integerToByteStringMaximumOutputLength) + d <- forAllWith ppShow $ Gen.integral (Range.constant 0 Bitwise.maximumOutputLength) let actualExp = mkIterAppNoAnn (builtin () PLC.IntegerToByteString) [ mkConstant @Bool () e, mkConstant @Integer () d, @@ -68,7 +68,7 @@ i2bProperty2 = do e <- forAllWith ppShow Gen.bool -- We limit this temporarily due to the limit imposed on lengths for the -- conversion primitive. - k <- forAllWith ppShow $ Gen.integral (Range.constant 1 integerToByteStringMaximumOutputLength) + k <- forAllWith ppShow $ Gen.integral (Range.constant 1 Bitwise.maximumOutputLength) j <- forAllWith ppShow $ Gen.integral (Range.constant 0 (k-1)) let actualExp = mkIterAppNoAnn (builtin () PLC.IntegerToByteString) [ mkConstant @Bool () e, @@ -406,9 +406,8 @@ i2bCipExamples = [ -- inputs close to the maximum size. i2bLimitTests ::[TestTree] i2bLimitTests = - let maxAcceptableInput = 2 ^ (8*integerToByteStringMaximumOutputLength) - 1 - maxAcceptableLength = integerToByteStringMaximumOutputLength -- Just for brevity - maxOutput = fromList (take (fromIntegral integerToByteStringMaximumOutputLength) $ repeat 0xFF) + let maxAcceptableInput = 2 ^ (8*Bitwise.maximumOutputLength) - 1 + maxOutput = fromList (take (fromIntegral Bitwise.maximumOutputLength) $ repeat 0xFF) makeTests endianness = let prefix = if endianness then "Big-endian, " @@ -427,7 +426,7 @@ i2bLimitTests = in evaluateAssertEqual expectedExp actualExp, -- integerToByteString maxLen maxInput = 0xFF...FF testCase (prefix ++ "maximum acceptable input, maximum acceptable length argument") $ - let actualExp = mkIntegerToByteStringApp maxAcceptableLength maxAcceptableInput + let actualExp = mkIntegerToByteStringApp Bitwise.maximumOutputLength maxAcceptableInput expectedExp = mkConstant @ByteString () maxOutput in evaluateAssertEqual expectedExp actualExp, -- integerToByteString 0 (maxInput+1) fails @@ -436,16 +435,16 @@ i2bLimitTests = in evaluateShouldFail actualExp, -- integerToByteString maxLen (maxInput+1) fails testCase (prefix ++ "input too big, maximum acceptable length argument") $ - let actualExp = mkIntegerToByteStringApp maxAcceptableLength (maxAcceptableInput + 1) + let actualExp = mkIntegerToByteStringApp Bitwise.maximumOutputLength (maxAcceptableInput + 1) in evaluateShouldFail actualExp, -- integerToByteString (maxLen-1) maxInput fails testCase (prefix ++ "maximum acceptable input, length argument not big enough") $ - let actualExp = mkIntegerToByteStringApp (maxAcceptableLength - 1) maxAcceptableInput + let actualExp = mkIntegerToByteStringApp (Bitwise.maximumOutputLength - 1) maxAcceptableInput in evaluateShouldFail actualExp, -- integerToByteString _ (maxLen+1) 0 fails, just to make sure that -- we can't go beyond the supposed limit testCase (prefix ++ "input zero, length argument over limit") $ - let actualExp = mkIntegerToByteStringApp (maxAcceptableLength + 1) 0 + let actualExp = mkIntegerToByteStringApp (Bitwise.maximumOutputLength + 1) 0 in evaluateShouldFail actualExp ] in makeTests True ++ makeTests False diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index 8960ded91f4..aed894c7a36 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -817,7 +817,7 @@ replicateByte :: BuiltinInteger -> BuiltinByteString replicateByte n w8 = - case Bitwise.replicateByte (fromIntegral n) (fromIntegral w8) of + case Bitwise.replicateByte n (fromIntegral w8) of BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $ Haskell.error "byteStringReplicate errored." BuiltinSuccess bs -> BuiltinByteString bs