cardano-api: Add limit for tx input index as 2^32

Making transaction body: add index bound checking. Test: do not generate input indices more than 2^32. Rationale: 2^32 is enough for tx input indices as a transaction can't have 2^32 inputs. Tx body roundtrip tests found indices overflow when they are more than 2^32.
IntersectMBO · Sep 14, 2021 · d92587f · d92587f
1 parent bf80fba
commit d92587f
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 5 deletions.
diff --git a/cardano-api/gen/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Gen/Cardano/Api/Typed.hs
@@ -373,7 +373,7 @@ genTxId :: Gen TxId
 genTxId = TxId <$> genShelleyHash
 
 genTxIndex :: Gen TxIx
-genTxIndex = TxIx <$> Gen.word Range.constantBounded
+genTxIndex = TxIx . fromIntegral <$> Gen.word32 Range.constantBounded
 
 genTxOutValue :: CardanoEra era -> Gen (TxOutValue era)
 genTxOutValue era =

diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs
@@ -142,7 +142,7 @@ import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
 import           Data.Bifunctor (first)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LBS
-import           Data.Foldable (toList)
+import           Data.Foldable (for_, toList)
 import           Data.Function (on)
 import           Data.List (intercalate, sortBy)
 import qualified Data.List.NonEmpty as NonEmpty
@@ -155,7 +155,7 @@ import qualified Data.Set as Set
 import           Data.String (IsString)
 import           Data.Text (Text)
 import qualified Data.Text as Text
-import           Data.Word (Word64)
+import           Data.Word (Word32, Word64)
 import           GHC.Generics
 
 import           Cardano.Binary (Annotated (..), reAnnotate, recoverBytes)
@@ -1551,6 +1551,7 @@ data TxBodyError =
      | TxBodyAuxDataHashInvalidError
      | TxBodyMintBeforeMaryError
      | TxBodyMissingProtocolParams
+     | TxBodyInIxOverflow TxIn
      deriving Show
 
 instance Error TxBodyError where
@@ -1580,6 +1581,10 @@ instance Error TxBodyError where
     displayError TxBodyMissingProtocolParams =
       "Transaction uses Plutus scripts but does not provide the protocol " ++
       "parameters to hash"
+    displayError (TxBodyInIxOverflow txin) =
+      "Transaction input index is too big, " ++
+      "acceptable value is up to 2^32-1, " ++
+      "in input " ++ show txin
 
 
 makeTransactionBody :: forall era.
@@ -1963,8 +1968,10 @@ fromLedgerTxMintValue era body =
 makeByronTransactionBody :: TxBodyContent BuildTx ByronEra
                          -> Either TxBodyError (TxBody ByronEra)
 makeByronTransactionBody TxBodyContent { txIns, txOuts } = do
-    ins'  <- NonEmpty.nonEmpty txIns      ?! TxBodyEmptyTxIns
-    let ins'' = NonEmpty.map (toByronTxIn . fst) ins'
+    ins' <- NonEmpty.nonEmpty (map fst txIns) ?! TxBodyEmptyTxIns
+    for_ ins' $ \txin@(TxIn _ (TxIx txix)) ->
+      guard (txix <= maxByronTxInIx) ?! TxBodyInIxOverflow txin
+    let ins'' = fmap toByronTxIn ins'
 
     outs'  <- NonEmpty.nonEmpty txOuts    ?! TxBodyEmptyTxOuts
     outs'' <- traverse
@@ -1977,6 +1984,9 @@ makeByronTransactionBody TxBodyContent { txIns, txOuts } = do
             (Byron.UnsafeTx ins'' outs'' (Byron.mkAttributes ()))
             ()
   where
+    maxByronTxInIx :: Word
+    maxByronTxInIx = fromIntegral (maxBound :: Word32)
+
     classifyRangeError :: TxOut ByronEra -> TxBodyError
     classifyRangeError
       txout@(TxOut (AddressInEra ByronAddressInAnyEra ByronAddress{})