Change writeBits to take changelists as two separate lists (#6317)

* fix: types in defaultConstitution (#6307) More descriptive type names in the defaultConstitution Co-authored-by: Nikolaos Bezirgiannis <329939+bezirg@users.noreply.github.com> * Fix overflow bug in shiftByteString, rotateByteString, add tests to ensure it stays fixed (#6309) * Fix overflow bug in shiftByteString, add tests to ensure it stays fixed * Fix similar issue in rotations * Add shift wrapper for bounds checks * Fix rotations similarly, note in docs * Fix typo, note about fromIntegral * Release 1.31.0.0 (#6312) * Modify writeBits to use two lists as arguments * Fix writeBits in PlutusTx to match new API * Fix goldens --------- Co-authored-by: Romain Soulat <117812549+RSoulatIOHK@users.noreply.github.com> Co-authored-by: Nikolaos Bezirgiannis <329939+bezirg@users.noreply.github.com> Co-authored-by: Yura Lazarev <1009751+Unisay@users.noreply.github.com>
IntersectMBO · Jul 19, 2024 · 0da4c4b · 0da4c4b · github-actions · Jul 19, 2024
1 parent d89a339
commit 0da4c4b
Show file tree

Hide file tree

Showing 6 changed files with 68 additions and 32 deletions.
diff --git a/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs b/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs
@@ -12,6 +12,7 @@ module PlutusCore.Bitwise (
   byteStringToIntegerWrapper,
   shiftByteStringWrapper,
   rotateByteStringWrapper,
+  writeBitsWrapper,
   -- * Implementation details
   IntegerToByteStringError (..),
   integerToByteStringMaximumOutputLength,
@@ -357,6 +358,12 @@ byteStringToInteger statedByteOrder input = case statedByteOrder of
 endiannessArgToByteOrder :: Bool -> ByteOrder
 endiannessArgToByteOrder b = if b then BigEndian else LittleEndian
 
+-- | Needed due to the complexities of passing lists of pairs as arguments.
+-- Effectively, we pass the second argument as required by CIP-122 in its
+-- \'unzipped\' form, truncating mismatches.
+writeBitsWrapper :: ByteString -> [Integer] -> [Bool] -> BuiltinResult ByteString
+writeBitsWrapper bs ixes = writeBits bs . zip ixes
+
 {- Note [Binary bitwise operation implementation and manual specialization]
 
    All of the 'binary' bitwise operations (namely `andByteString`,

diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs
@@ -1921,12 +1921,12 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where
             (runCostingFunTwoArguments . unimplementedCostingFun)
 
     toBuiltinMeaning _semvar WriteBits =
-        let writeBitsDenotation :: BS.ByteString -> [(Integer, Bool)] -> BuiltinResult BS.ByteString
-            writeBitsDenotation = Bitwise.writeBits
+        let writeBitsDenotation :: BS.ByteString -> [Integer] -> [Bool] -> BuiltinResult BS.ByteString
+            writeBitsDenotation = Bitwise.writeBitsWrapper
             {-# INLINE writeBitsDenotation #-}
         in makeBuiltinMeaning
             writeBitsDenotation
-            (runCostingFunTwoArguments . unimplementedCostingFun)
+            (runCostingFunThreeArguments . unimplementedCostingFun)
 
     toBuiltinMeaning _semvar ReplicateByte =
         let replicateByteDenotation :: Int -> Word8 -> BuiltinResult BS.ByteString

diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/WriteBits.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/WriteBits.plc.golden
@@ -1 +1 @@
-bytestring -> list (pair integer bool) -> bytestring
+bytestring -> list integer -> list bool -> bytestring
diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Laws.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Laws.hs
@@ -65,7 +65,8 @@ getSet =
     b <- evaluateToHaskell lookupExp
     let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
           mkConstant @ByteString () bs,
-          mkConstant @[(Integer, Bool)] () [(i, b)]
+          mkConstant @[Integer] () [i],
+          mkConstant @[Bool] () [b]
           ]
     evaluatesToConstant bs lhs
 
@@ -79,7 +80,8 @@ setGet =
     b <- forAll Gen.bool
     let lhsInner = mkIterAppNoAnn (builtin () PLC.WriteBits) [
           mkConstant @ByteString () bs,
-          mkConstant @[(Integer, Bool)] () [(i, b)]
+          mkConstant @[Integer] () [i],
+          mkConstant @[Bool] () [b]
           ]
     let lhs = mkIterAppNoAnn (builtin () PLC.ReadBit) [
           lhsInner,
@@ -97,11 +99,13 @@ setSet =
     b2 <- forAll Gen.bool
     let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
           mkConstant @ByteString () bs,
-          mkConstant @[(Integer, Bool)] () [(i, b1), (i, b2)]
+          mkConstant @[Integer] () [i, i],
+          mkConstant @[Bool] () [b1, b2]
           ]
     let rhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
           mkConstant @ByteString () bs,
-          mkConstant @[(Integer, Bool)] () [(i, b2)]
+          mkConstant @[Integer] () [i],
+          mkConstant @[Bool] () [b2]
           ]
     evaluateTheSame lhs rhs
 
@@ -122,25 +126,29 @@ writeBitsHomomorphismLaws =
         bs <- forAllByteString 1 512
         let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
               mkConstant @ByteString () bs,
-              mkConstant @[(Integer, Bool)] () []
+              mkConstant @[Integer] () [],
+              mkConstant @[Bool] () []
               ]
         evaluatesToConstant bs lhs
       compositionProp :: Property
       compositionProp = property $ do
         bs <- forAllByteString 1 512
-        changelist1 <- forAllChangelistOf bs
-        changelist2 <- forAllChangelistOf bs
+        (ixes1, bits1) <- forAllChangelistsOf bs
+        (ixes2, bits2) <- forAllChangelistsOf bs
         let lhsInner = mkIterAppNoAnn (builtin () PLC.WriteBits) [
               mkConstant @ByteString () bs,
-              mkConstant @[(Integer, Bool)] () changelist1
+              mkConstant @[Integer] () ixes1,
+              mkConstant @[Bool] () bits1
               ]
         let lhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
               lhsInner,
-              mkConstant @[(Integer, Bool)] () changelist2
+              mkConstant @[Integer] () ixes2,
+              mkConstant @[Bool] () bits2
               ]
         let rhs = mkIterAppNoAnn (builtin () PLC.WriteBits) [
               mkConstant @ByteString () bs,
-              mkConstant @[(Integer, Bool)] () (changelist1 <> changelist2)
+              mkConstant @[Integer] () (ixes1 <> ixes2),
+              mkConstant @[Bool] () (bits1 <> bits2)
               ]
         evaluateTheSame lhs rhs
 
@@ -455,9 +463,12 @@ unitProp f isPadding unit = property $ do
 forAllIndexOf :: ByteString -> PropertyT IO Integer
 forAllIndexOf bs = forAll . Gen.integral . Range.linear 0 . fromIntegral $ BS.length bs * 8 - 1
 
-forAllChangelistOf :: ByteString -> PropertyT IO [(Integer, Bool)]
-forAllChangelistOf bs =
-  forAll . Gen.list (Range.linear 0 (8 * len - 1)) $ (,) <$> genIndex <*> Gen.bool
+forAllChangelistsOf :: ByteString -> PropertyT IO ([Integer], [Bool])
+forAllChangelistsOf bs = do
+  ourLen :: Int <- forAll . Gen.integral . Range.linear 0 $ 8 * len - 1
+  ixes <- forAll . Gen.list (Range.singleton ourLen) $ genIndex
+  bits <- forAll . Gen.list (Range.singleton ourLen) $ Gen.bool
+  pure (ixes, bits)
   where
     len :: Int
     len = BS.length bs

diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs
@@ -784,11 +784,28 @@ readBit ::
   Bool
 readBit bs i = fromOpaque (BI.readBit bs i)
 
--- | Given a 'BuiltinByteString' and a changelist of index-value pairs, set the _bit_ at each index
--- where the corresponding value is 'True', and clear the bit at each index where the corresponding
--- value is 'False'. Will error if any of the indexes are out-of-bounds: that is, if the index is
--- either negative, or equal to or greater than the total number of bits in the 'BuiltinByteString'
--- argument.
+-- | Given a 'BuiltinByteString', a list of indexes to change, and a list of values to change those
+-- indexes to, set the /bit/ at each of the specified index as follows:
+--
+-- * If the corresponding entry in the list of values is 'True', set that bit;
+-- * Otherwise, clear that bit.
+--
+-- Will error if any of the indexes are out-of-bounds: that is, if the index is either negative, or
+-- equal to or greater than the total number of bits in the 'BuiltinByteString' argument.
+--
+-- If the two list arguments have mismatched lengths, the longer argument will be truncated to match
+-- the length of the shorter one:
+--
+-- * @writeBits bs [0, 1, 4] [True]@ is the same as @writeBits bs [0] [True]@
+-- * @writeBits bs [0] [True, False, True]@ is the same as @writeBits bs [0] [True]@
+--
+-- = Note
+--
+-- This differs slightly from the description of the [corresponding operation in
+-- CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#writebits); instead of a
+-- single changelist argument comprised of pairs, we instead pass two lists, one for indexes to
+-- change, and one for the values to change those indexes to. Effectively, we are passing the
+-- changelist argument \'unzipped\'.
 --
 -- = See also
 --
@@ -799,9 +816,10 @@ readBit bs i = fromOpaque (BI.readBit bs i)
 {-# INLINEABLE writeBits #-}
 writeBits ::
   BuiltinByteString ->
-  BI.BuiltinList (BI.BuiltinPair BI.BuiltinInteger BI.BuiltinBool) ->
+  [Integer] ->
+  [Bool] ->
   BuiltinByteString
-writeBits = BI.writeBits
+writeBits bs ixes bits = BI.writeBits bs (toBuiltin ixes) (toBuiltin bits)
 
 -- | Given a length (first argument) and a byte (second argument), produce a 'BuiltinByteString' of
 -- that length, with that byte in every position. Will error if given a negative length, or a second

diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs
@@ -793,15 +793,15 @@ readBit (BuiltinByteString bs) i =
 {-# NOINLINE writeBits #-}
 writeBits ::
   BuiltinByteString ->
-  BuiltinList (BuiltinPair BuiltinInteger BuiltinBool) ->
+  BuiltinList BuiltinInteger ->
+  BuiltinList BuiltinBool ->
   BuiltinByteString
-writeBits (BuiltinByteString bs) (BuiltinList xs) =
-  let unwrapped = fmap (\(BuiltinPair (i, BuiltinBool b)) -> (i, b)) xs in
-    case Bitwise.writeBits bs unwrapped of
-      BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
-        Haskell.error "writeBits errored."
-      BuiltinSuccess bs' -> BuiltinByteString bs'
-      BuiltinSuccessWithLogs logs bs' -> traceAll logs $ BuiltinByteString bs'
+writeBits (BuiltinByteString bs) (BuiltinList ixes) (BuiltinList bits) =
+  case Bitwise.writeBitsWrapper bs ixes (fmap (\(BuiltinBool b) -> b) bits) of
+    BuiltinFailure logs err -> traceAll (logs <> pure (display err)) $
+      Haskell.error "writeBits errored."
+    BuiltinSuccess bs' -> BuiltinByteString bs'
+    BuiltinSuccessWithLogs logs bs' -> traceAll logs $ BuiltinByteString bs'
 
 {-# NOINLINE replicateByte #-}
 replicateByte ::
Original file line number	Diff line number	Diff line change
		@@ -1 +1 @@
		bytestring -> list (pair integer bool) -> bytestring
		bytestring -> list integer -> list bool -> bytestring
Benchmark suite	Current: `0da4c4b`	Previous: `d89a339`	Ratio
`validation-decode-auction_1-3`	`556` μs	`518.3` μs	`1.07`
`validation-decode-game-sm-success_1-1`	`541.2` μs	`508` μs	`1.07`
`validation-decode-ping-pong-1`	`504.3` μs	`477.8` μs	`1.06`
`validation-decode-uniswap-2`	`243.8` μs	`227.3` μs	`1.07`