Merge pull request #2099 from input-output-hk/jc/restrict-shelley-ma-…

…ouput-size restrict output size in Shelley-MA
IntersectMBO · Jan 15, 2021 · 2fa3d24 · 2fa3d24
2 parents 721d350 + aec21cb
commit 2fa3d24
Show file tree

Hide file tree

Showing 2 changed files with 73 additions and 2 deletions.
diff --git a/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs b/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs
@@ -114,6 +114,8 @@ data UtxoPredicateFailure era
   | OutputBootAddrAttrsTooBig
       ![Core.TxOut era] -- list of supplied bad transaction outputs
   | TriesToForgeADA
+  | OutputTooBigUTxO
+      ![Core.TxOut era] -- list of supplied bad transaction outputs
   deriving (Generic)
 
 deriving stock instance
@@ -250,6 +252,18 @@ utxoTransition = do
           outputs
   null outputsTooSmall ?! OutputTooSmallUTxO outputsTooSmall
 
+  let outputsTooBig =
+        filter
+          ( \out ->
+              let v = getField @"value" out
+               in Val.size v > 4000
+              -- TODO this is arbitrary, but sufficiently below the current
+              -- max transaction size. We will make it a protocol parameter
+              -- in the Alonzo era.
+          )
+          outputs
+  null outputsTooBig ?! OutputTooBigUTxO outputsTooBig
+
   -- Bootstrap (i.e. Byron) addresses have variable sized attributes in them.
   -- It is important to limit their overall size.
   let outputsAttrsTooBig =
@@ -369,6 +383,9 @@ instance
       encodeListLen 2 <> toCBOR (10 :: Word8)
         <> encodeFoldable outs
     TriesToForgeADA -> encodeListLen 1 <> toCBOR (11 :: Word8)
+    OutputTooBigUTxO outs ->
+      encodeListLen 2 <> toCBOR (12 :: Word8)
+        <> encodeFoldable outs
 
 instance
   ( TransValue FromCBOR era,
@@ -420,4 +437,7 @@ instance
           outs <- decodeList fromCBOR
           pure (2, OutputBootAddrAttrsTooBig outs)
         11 -> pure (1, TriesToForgeADA)
+        12 -> do
+          outs <- decodeList fromCBOR
+          pure (2, OutputTooBigUTxO outs)
         k -> invalidKey k
diff --git a/shelley-ma/shelley-ma-test/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs b/shelley-ma/shelley-ma-test/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TypeApplications #-}
+
 -- |
 -- Module      : Test.Cardano.Ledger.Mary.Examples.MultiAssets
 -- Description : Multi-Assets Examples
@@ -15,6 +16,7 @@ import Cardano.Ledger.Mary.Value
     PolicyID (..),
     Value (..),
   )
+import Cardano.Ledger.ShelleyMA.Rules.Utxo (UtxoPredicateFailure (..))
 import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..), ValidityInterval (..))
 import Cardano.Ledger.ShelleyMA.TxBody (TxBody (..))
 import Cardano.Ledger.Val ((<+>), (<->))
@@ -97,7 +99,7 @@ pp =
   emptyPParams
     { _minfeeA = 0,
       _minfeeB = 1,
-      _maxTxSize = 1024,
+      _maxTxSize = 16384,
       _minUTxOValue = Coin 100
     }
 
@@ -137,6 +139,9 @@ policyFailure p =
       ]
     ]
 
+outTooSmallFailure :: TxOut MaryTest -> Either [[PredicateFailure (LEDGER MaryTest)]] (UTxO MaryTest)
+outTooSmallFailure out = Left [[UtxowFailure (UtxoFailure (OutputTooBigUTxO [out]))]]
+
 ----------------------------------------------------
 -- Introduce a new Token Bundle, Purple Tokens
 --
@@ -536,6 +541,46 @@ testNegEx2 = do
     Left (ErrorCall _) -> pure ()
     Right _ -> assertFailure $ "constructed negative TxOut Value"
 
+--
+-- Create a Value that is too big
+--
+
+smallValue :: Value TestCrypto
+smallValue =
+  Value 0 $
+    Map.singleton purplePolicyId (Map.fromList [(plum, 13), (amethyst, 2)])
+
+smallOut :: TxOut MaryTest
+smallOut = TxOut Cast.aliceAddr $ smallValue <+> (Val.inject (aliceInitCoin <-> (feeEx <+> Coin 100)))
+
+bigValue :: Value TestCrypto
+bigValue =
+  Value 0 $
+    Map.singleton
+      purplePolicyId
+      (Map.fromList $ map (\x -> ((AssetName . BS.pack . show $ x), 1)) [1 .. 97 :: Int])
+
+bigOut :: TxOut MaryTest
+bigOut = TxOut Cast.aliceAddr $ bigValue <+> (Val.inject (Coin 100))
+
+txbodyWithBigValue :: TxBody MaryTest
+txbodyWithBigValue =
+  makeTxb
+    [TxIn bootstrapTxId 0]
+    [smallOut, bigOut]
+    unboundedInterval
+    (bigValue <+> smallValue)
+
+txBigValue :: Tx MaryTest
+txBigValue =
+  Tx
+    txbodyWithBigValue
+    mempty
+      { addrWits = makeWitnessesVKey (hashAnnotated txbodyWithBigValue) [asWitness Cast.alicePay],
+        scriptWits = Map.fromList [(policyID purplePolicyId, purplePolicy)]
+      }
+    SNothing
+
 --
 -- Multi-Assets Test Group
 --
@@ -622,5 +667,11 @@ multiAssetsExample =
               (ledgerEnv $ SlotNo 3)
               (Right expectedUTxONegEx1),
           testCase "no negative outputs" testNegEx2
-        ]
+        ],
+      testCase "value too big" $
+        testMaryNoDelegLEDGER
+          initUTxO
+          txBigValue
+          (ledgerEnv $ SlotNo 0)
+          (outTooSmallFailure bigOut)
     ]