From 6203592f404cf566ee8a007fbee006a2564e8351 Mon Sep 17 00:00:00 2001
From: Koz Ross <koz.ross@retro-freedom.nz>
Date: Tue, 16 Jul 2024 07:45:39 +1200
Subject: [PATCH] Fix overflow bug in shiftByteString, add tests to ensure it
 stays fixed

---
 .../plutus-core/src/PlutusCore/Bitwise.hs       |  3 +++
 .../test/Evaluation/Builtins/Bitwise.hs         | 17 ++++++++++++++---
 .../test/Evaluation/Builtins/Definition.hs      |  4 +++-
 3 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs b/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs
index 4c8f0dc9324..6096e98ef0f 100644
--- a/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs
+++ b/plutus-core/plutus-core/src/PlutusCore/Bitwise.hs
@@ -656,6 +656,9 @@ shiftByteString :: ByteString -> Int -> ByteString
 shiftByteString bs bitMove
   | BS.null bs = bs
   | bitMove == 0 = bs
+  -- Needed to guard against overflow when given minBound for Int as a bit move
+  | abs (fromIntegral bitMove) >= (fromIntegral bitLen :: Integer) =
+      BS.replicate len 0x00
   | otherwise = unsafeDupablePerformIO . BS.useAsCString bs $ \srcPtr ->
       BSI.create len $ \dstPtr -> do
         -- To simplify our calculations, we work only with absolute values,
diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Bitwise.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Bitwise.hs
index 55341b27a93..6e2c5d879ce 100644
--- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Bitwise.hs
+++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Bitwise.hs
@@ -3,8 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications  #-}
 
--- | Tests for [this
--- CIP](https://github.com/mlabs-haskell/CIPs/blob/koz/bitwise/CIP-XXXX/CIP-XXXX.md)
+-- | Tests for [CIP-123](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0123)
 module Evaluation.Builtins.Bitwise (
   shiftHomomorphism,
   rotateHomomorphism,
@@ -21,7 +20,8 @@ module Evaluation.Builtins.Bitwise (
   ffsReplicate,
   ffsXor,
   ffsIndex,
-  ffsZero
+  ffsZero,
+  shiftMinBound
   ) where
 
 import Control.Monad (unless)
@@ -38,6 +38,17 @@ import Test.Tasty (TestTree)
 import Test.Tasty.Hedgehog (testPropertyNamed)
 import Test.Tasty.HUnit (testCase)
 
+-- | If given 'Int' 'minBound' as an argument, shifts behave sensibly.
+shiftMinBound :: Property
+shiftMinBound = property $ do
+  bs <- forAllByteString 0 512
+  let len = BS.length bs
+  let shiftExp = mkIterAppNoAnn (builtin () PLC.ShiftByteString) [
+        mkConstant @ByteString () bs,
+        mkConstant @Integer () . fromIntegral $ (minBound :: Int)
+        ]
+  evaluatesToConstant @ByteString (BS.replicate len 0x00) shiftExp
+
 -- | Finding the first set bit in a bytestring with only zero bytes should always give -1.
 ffsZero :: Property
 ffsZero = property $ do
diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs
index f1585551781..e37261b8b73 100644
--- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs
+++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs
@@ -972,7 +972,9 @@ test_Bitwise =
       testPropertyNamed "positive shifts clear low indexes" "shift_pos_low"
                         Bitwise.shiftPosClearLow,
       testPropertyNamed "negative shifts clear high indexes" "shift_neg_high"
-                        Bitwise.shiftNegClearHigh
+                        Bitwise.shiftNegClearHigh,
+      testPropertyNamed "shifts do not break when given minBound as a shift" "shift_min_bound"
+                        Bitwise.shiftMinBound
     ],
   testGroup "rotateByteString" [
       testGroup "homomorphism" Bitwise.rotateHomomorphism,