Guard against overflows in Shelley TxIns

- makeByronTransactionBody guards against overflows in the transaction indices, but makeShelleyTransactionBody does not. - Add appropriate guards to makeShelleyTransactionBody.
IntersectMBO · Jan 7, 2022 · d29e17e · d29e17e
1 parent 28c34d8
commit d29e17e
Showing 1 changed file with 16 additions and 0 deletions.
diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs
@@ -2240,6 +2240,16 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) =
       txScriptValidity = TxScriptValidityNone
     }
 
+guardShelleyTxInsOverflow :: [TxIn] -> Either TxBodyError ()
+guardShelleyTxInsOverflow txIns = do
+    ins' <- NonEmpty.nonEmpty txIns ?! TxBodyEmptyTxIns
+    for_ ins' $ \txin@(TxIn _ (TxIx txix)) ->
+      guard (txix <= maxShelleyTxInIx) ?! TxBodyInIxOverflow txin
+
+    where
+        maxShelleyTxInIx :: Word
+        maxShelleyTxInIx = fromIntegral (maxBound :: Word32)
+
 makeShelleyTransactionBody :: ()
   => ShelleyBasedEra era
   -> TxBodyContent BuildTx era
@@ -2264,6 +2274,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraShelley
                                                          (txOutInAnyEra txout)
       | let maxTxOut = fromIntegral (maxBound :: Word64) :: Lovelace
       , txout@(TxOut _ (TxOutAdaOnly AdaOnlyInShelleyEra v) _) <- txOuts ]
+    guardShelleyTxInsOverflow (map fst txIns)
     case txMetadata of
       TxMetadataNone      -> return ()
       TxMetadataInEra _ m -> first TxBodyMetadataError (validateTxMetadata m)
@@ -2333,6 +2344,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAllegra
       | let maxTxOut = fromIntegral (maxBound :: Word64) :: Lovelace
       , txout@(TxOut _ (TxOutAdaOnly AdaOnlyInAllegraEra v) _) <- txOuts
       ]
+    guardShelleyTxInsOverflow (map fst txIns)
     case txMetadata of
       TxMetadataNone      -> return ()
       TxMetadataInEra _ m -> validateTxMetadata m ?!. TxBodyMetadataError
@@ -2419,6 +2431,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraMary
                 []  -> Right ()
                 q:_ -> Left (TxBodyOutputOverflow q (txOutInAnyEra txout))
       ]
+    guardShelleyTxInsOverflow (map fst txIns)
     case txMetadata of
       TxMetadataNone      -> return ()
       TxMetadataInEra _ m -> validateTxMetadata m ?!. TxBodyMetadataError
@@ -2514,6 +2527,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo
                 []  -> Right ()
                 q:_ -> Left (TxBodyOutputOverflow q (txOutInAnyEra txout))
       ]
+    guardShelleyTxInsOverflow (map fst txIns)
     case txMetadata of
       TxMetadataNone      -> return ()
       TxMetadataInEra _ m -> validateTxMetadata m ?!. TxBodyMetadataError
@@ -2523,6 +2537,8 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo
     case txInsCollateral of
       TxInsCollateralNone | not (Set.null languages)
         -> Left TxBodyEmptyTxInsCollateral
+      TxInsCollateral _ collateralTxIns
+        -> guardShelleyTxInsOverflow collateralTxIns
       _ -> return ()
     case txProtocolParams of
       BuildTxWith Nothing | not (Set.null languages)