Ensure out-of-bounds voting weight is handled

test/Test/Cardano/Catalyst/Registration.hs

@@ -10,10 +10,12 @@ import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.HashMap.Strict as HM
 import           Data.List (sort)
+import           Data.Word (Word32)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text.Encoding as T
 import qualified Data.Vector as Vector
 import           Hedgehog (property, tripping, (===))
+import           Data.Maybe (fromMaybe)
 import qualified Hedgehog as H
 import           Hedgehog.Internal.Property (forAllT)
 import           Test.Tasty (TestTree, testGroup)
@@ -34,6 +36,7 @@ tests = testGroup "Vote Metadata type tests"
       , testProperty "JSON roundrip RewardsAddress" prop_rewardsAddress_json_roundtrips
       , testProperty "Vote/fromTxMetadata/handles empty lists" prop_vote_empty_delegations
       , testProperty "Vote/fromTxMetadata/handles negative purpose" prop_vote_negative_purpose
+      , testProperty "Vote/fromTxMetadata/handles out-of-bounds weight" prop_vote_weight_exceeds_range
       ]
   ]
 
@@ -48,6 +51,69 @@ prop_vote_txMetadata_roundtrips = property $ do
 
   tripping a voteToTxMetadata voteFromTxMetadata
 
+prop_vote_weight_exceeds_range :: H.Property
+prop_vote_weight_exceeds_range = H.property $ do
+  skey <- forAllT $ Gen.genVoteSigningKey
+  let verKey = getStakeVerificationKey skey
+  rewardsAddress <- forAllT Gen.genRewardsAddress
+  slotNo <- forAllT Gen.genSlotNo
+  votePurpose <- forAllT Gen.genVotePurpose
+
+  badWeight <- forAllT $
+    Gen.choice [ Gen.int64 (Range.linear
+                             minBound
+                             (fromIntegral (minBound :: Word32) - 1)
+                           )
+               , Gen.int64 (Range.linear
+                             (fromIntegral (maxBound :: Word32) + 1)
+                             maxBound
+                           )
+               ]
+  votePub <- forAllT $ Gen.genVotingKeyPublic
+  let
+    ds = Api.TxMetaList
+      [ Api.TxMetaList
+        [ Api.TxMetaBytes $ Api.serialiseToRawBytes votePub
+        , Api.TxMetaNumber $ fromIntegral badWeight
+        ]
+      ]
+
+  let
+    regoMeta =
+      Api.TxMetadata $ M.fromList
+        [ ( 61284, Api.TxMetaMap $
+            [ ( Api.TxMetaNumber 1
+              , ds
+              )
+            , ( Api.TxMetaNumber 2
+              , Api.TxMetaBytes $ Api.serialiseToRawBytes verKey
+              )
+            , ( Api.TxMetaNumber 3
+              , Api.TxMetaBytes $ Api.serialiseToRawBytes rewardsAddress
+              )
+            , ( Api.TxMetaNumber 4
+              , Api.TxMetaNumber slotNo
+              )
+            , ( Api.TxMetaNumber 5
+              , Api.TxMetaNumber $ fromMaybe 0 votePurpose
+              )
+            ]
+          )
+        ]
+    sig = Api.serialiseToCBOR regoMeta `sign` skey
+    sigMeta = Api.TxMetadata $ M.fromList
+      [ ( 61285, Api.TxMetaMap
+          [ ( Api.TxMetaNumber 1
+            , Api.TxMetaBytes $ Crypto.rawSerialiseSigDSIGN sig
+            )
+          ]
+        )
+      ]
+
+  voteFromTxMetadata (regoMeta <> sigMeta)
+    ===
+    Left (MetadataParseFailure RegoDelegations "delegation weight exceeded range from 0 to 2^32-1")
+
 prop_vote_negative_purpose :: H.Property
 prop_vote_negative_purpose = H.property $ do
   ds <- forAllT $ Gen.genDelegations