Fix issue with use after free in CSL: Emurgo/cardano-serialization-li…

…b#670
mlabs-haskell · Apr 8, 2024 · 8813900 · 8813900
1 parent c72c790
commit 8813900
Show file tree

Hide file tree

Showing 5 changed files with 228 additions and 105 deletions.
diff --git a/src/Cardano/Types/BigNum.purs b/src/Cardano/Types/BigNum.purs
@@ -46,7 +46,7 @@ import Cardano.Serialization.Lib
   , toBytes
   )
 import Cardano.Serialization.Lib as Csl
-import Cardano.Types.Internal.Helpers (eqOrd)
+import Cardano.Types.Internal.Helpers (clone, eqOrd)
 import Data.Array.NonEmpty as NA
 import Data.Either (note)
 import Data.Generic.Rep (class Generic)
@@ -76,7 +76,7 @@ instance Eq BigNum where
 
 instance Ord BigNum where
   compare (BigNum lhs) (BigNum rhs) =
-    case bigNum_compare lhs rhs of
+    case bigNum_compare (clone lhs) (clone rhs) of
       1.0 -> GT
       0.0 -> EQ
       _ -> LT
@@ -117,13 +117,13 @@ zero :: BigNum
 zero = BigNum bigNum_zero
 
 add :: BigNum -> BigNum -> Maybe BigNum
-add (BigNum a) (BigNum b) = coerce $ toMaybe $ bigNum_checkedAdd a b
+add (BigNum a) (BigNum b) = coerce $ toMaybe $ bigNum_checkedAdd (clone a) (clone b)
 
 mul :: BigNum -> BigNum -> Maybe BigNum
-mul (BigNum a) (BigNum b) = coerce $ toMaybe $ bigNum_checkedMul a b
+mul (BigNum a) (BigNum b) = coerce $ toMaybe $ bigNum_checkedMul (clone a) (clone b)
 
 sub :: BigNum -> BigNum -> Maybe BigNum
-sub (BigNum a) (BigNum b) = coerce $ toMaybe $ bigNum_checkedSub a b
+sub (BigNum a) (BigNum b) = coerce $ toMaybe $ bigNum_checkedSub (clone a) (clone b)
 
 max :: BigNum -> BigNum -> BigNum
 max = coerce bigNum_max

diff --git a/src/Cardano/Types/PlutusScript.purs b/src/Cardano/Types/PlutusScript.purs
@@ -2,8 +2,13 @@ module Cardano.Types.PlutusScript where
 
 import Prelude
 
-import Aeson (class DecodeAeson, class EncodeAeson)
-import Cardano.AsCbor (class AsCbor)
+import Aeson
+  ( class DecodeAeson
+  , class EncodeAeson
+  , decodeAeson
+  , fromString
+  )
+import Cardano.AsCbor (class AsCbor, encodeCbor)
 import Cardano.Serialization.Lib
   ( fromBytes
   , plutusScript_fromBytesWithVersion
@@ -15,35 +20,52 @@ import Cardano.Serialization.Lib as Csl
 import Cardano.Types.Language (Language(PlutusV1, PlutusV2))
 import Cardano.Types.Language as Language
 import Cardano.Types.ScriptHash (ScriptHash)
+import Data.Array.NonEmpty as NEA
 import Data.ByteArray (ByteArray)
+import Data.Either (hush)
+import Data.Function (on)
 import Data.Generic.Rep (class Generic)
+import Data.Maybe (fromJust)
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Show.Generic (genericShow)
 import Data.Tuple.Nested (type (/\), (/\))
+import Partial.Unsafe (unsafePartial)
 import Test.QuickCheck (class Arbitrary)
-import Test.QuickCheck.Arbitrary (genericArbitrary)
+import Test.QuickCheck.Gen (oneOf)
 
 -- | Corresponds to "Script" in Plutus
-newtype PlutusScript = PlutusScript (ByteArray /\ Language)
+newtype PlutusScript = PlutusScript (Csl.PlutusScript /\ Language)
 
 derive instance Generic PlutusScript _
 derive instance Newtype PlutusScript _
-derive newtype instance Eq PlutusScript
-derive newtype instance Ord PlutusScript
 derive newtype instance DecodeAeson PlutusScript
 derive newtype instance EncodeAeson PlutusScript
 
+instance Eq PlutusScript where
+  eq = eq `on` encodeCbor
+
+instance Ord PlutusScript where
+  compare = compare `on` encodeCbor
+
 instance Arbitrary PlutusScript where
-  arbitrary = genericArbitrary
+  arbitrary = oneOf $ NEA.cons'
+    ( pure $ unsafePartial $ fromJust $ map plutusV1Script $ hush
+        $ decodeAeson
+        $ fromString "4d01000033222220051200120011"
+    )
+    [ pure $ unsafePartial $ fromJust $ map plutusV2Script $ hush
+        $ decodeAeson
+        $ fromString "4d010000deadbeef33222220051200120011"
+    ]
 
 instance Show PlutusScript where
   show = genericShow
 
 plutusV1Script :: ByteArray -> PlutusScript
-plutusV1Script ba = PlutusScript (ba /\ PlutusV1)
+plutusV1Script ba = PlutusScript (plutusScript_fromBytesWithVersion ba (Language.toCsl PlutusV1) /\ PlutusV1)
 
 plutusV2Script :: ByteArray -> PlutusScript
-plutusV2Script ba = PlutusScript (ba /\ PlutusV2)
+plutusV2Script ba = PlutusScript (plutusScript_fromBytesWithVersion ba (Language.toCsl PlutusV2) /\ PlutusV2)
 
 instance AsCbor PlutusScript where
   encodeCbor = toCsl >>> toBytes >>> wrap
@@ -53,8 +75,8 @@ hash :: PlutusScript -> ScriptHash
 hash = toCsl >>> plutusScript_hash >>> wrap
 
 toCsl :: PlutusScript -> Csl.PlutusScript
-toCsl (PlutusScript (bytes /\ lang)) =
-  plutusScript_fromBytesWithVersion bytes $ Language.toCsl lang
+toCsl (PlutusScript (script /\ _lang)) =
+  script
 
 fromCsl :: Csl.PlutusScript -> PlutusScript
-fromCsl ps = PlutusScript (toBytes ps /\ Language.fromCsl (plutusScript_languageVersion ps))
+fromCsl ps = PlutusScript (ps /\ Language.fromCsl (plutusScript_languageVersion ps))
diff --git a/src/Cardano/Types/TransactionBody.purs b/src/Cardano/Types/TransactionBody.purs
@@ -48,7 +48,7 @@ import Cardano.Types.Certificate as Certificate
 import Cardano.Types.Coin (Coin)
 import Cardano.Types.Coin as Coin
 import Cardano.Types.Ed25519KeyHash (Ed25519KeyHash)
-import Cardano.Types.Internal.Helpers (withNonEmptyArray)
+import Cardano.Types.Internal.Helpers (clone, withNonEmptyArray)
 import Cardano.Types.Mint (Mint)
 import Cardano.Types.Mint as Mint
 import Cardano.Types.NetworkId (NetworkId)
@@ -172,7 +172,10 @@ toCsl
   -- auxiliaryDataHash
   for_ auxiliaryDataHash $ transactionBody_setAuxiliaryDataHash tb <<< unwrap
   -- validityStartInterval
-  for_ validityStartInterval $ transactionBody_setValidityStartIntervalBignum tb <<< unwrap <<< unwrap
+  for_ validityStartInterval $ transactionBody_setValidityStartIntervalBignum tb
+    <<< clone
+    <<< unwrap
+    <<< unwrap
   -- mint
   for_ mint $ transactionBody_setMint tb <<< Mint.toCsl
   -- scriptDataHash