SCP-2758: Encode out-of-range integers as bigints (IntersectMBO#3936)

Previously `fromIntegral :: Integer -> Word64` would silently
wrap integers which were out of range. Instead we now encode
out-of-range integers as big integers, which is more honest *and* will
fail to deserialise, making this a "soft" way of failing, rather than
calling error.

Author: michaelpj

plutus-core/plutus-core/src/PlutusCore/Data.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase         #-}
 {-# LANGUAGE MultiWayIf         #-}
 {-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE TypeApplications   #-}
 {-# LANGUAGE ViewPatterns       #-}
 
 module PlutusCore.Data (Data (..)) where
@@ -112,7 +113,13 @@ encodeData = \case
     -- See Note [CBOR alternative tags]
     Constr i ds | 0 <= i && i < 7   -> CBOR.encodeTag (fromIntegral (121 + i)) <> encode ds
     Constr i ds | 7 <= i && i < 128 -> CBOR.encodeTag (fromIntegral (1280 + (i - 7))) <> encode ds
-    Constr i ds | otherwise         -> CBOR.encodeTag 102 <> CBOR.encodeListLen 2 <> CBOR.encodeWord64 (fromIntegral i) <> encode ds
+    Constr i ds | otherwise         ->
+                  let tagEncoding = if fromIntegral (minBound @Word64) <= i && i <= fromIntegral (maxBound @Word64)
+                                    then CBOR.encodeWord64 (fromIntegral i)
+                                    -- This is a "correct"-ish encoding of the tag, but it will *not* deserialise, since we insist on a
+                                    -- 'Word64' when we deserialise. So this is really a "soft" failure, without using 'error' or something.
+                                    else CBOR.encodeInteger i
+                  in CBOR.encodeTag 102 <> CBOR.encodeListLen 2 <> tagEncoding <> encode ds
     Map es                          -> CBOR.encodeMapLen (fromIntegral $ length es) <> mconcat [ encode t <> encode t' | (t, t') <-es ]
     List ds                         -> encode ds
     I i                             -> encodeInteger i
@@ -255,7 +262,6 @@ decodeConstr = CBOR.decodeTag64 >>= \case
   decodeConstrExtended = do
     len <- CBOR.decodeListLenOrIndef
     i <- CBOR.decodeWord64
-    unless (i >= 0) $ fail ("Invalid negative constructor tag: " ++ show i)
     args <- decodeListOf decodeData
     case len of
       Nothing -> do

plutus-tx/test/Spec.hs

@@ -9,6 +9,7 @@ import qualified Codec.Serialise     as Serialise
 import           Control.Exception   (ErrorCall, catch)
 import qualified Data.ByteString     as BS
 import           Data.Either         (isLeft)
+import           Data.Word
 import           Hedgehog            (MonadGen, Property, PropertyT, annotateShow, assert, forAll, property, tripping)
 import qualified Hedgehog.Gen        as Gen
 import qualified Hedgehog.Range      as Range
@@ -123,7 +124,7 @@ sixtyFourByteInteger = 2^((64 :: Integer) *8)
 genData :: MonadGen m => m Data
 genData =
     let st = Gen.subterm genData id
-        positiveInteger = Gen.integral (Range.linear 0 100000)
+        constrIndex = fromIntegral <$> (Gen.integral @_ @Word64 Range.linearBounded)
         reasonableInteger = Gen.integral (Range.linear (-100000) 100000)
         -- over 64 bytes
         reallyBigInteger = Gen.integral (Range.linear sixtyFourByteInteger (sixtyFourByteInteger * 2))
@@ -138,7 +139,7 @@ genData =
         , I <$> reallyBigInteger
         , I <$> reallyBigNInteger
         , B <$> someBytes ]
-        [ Constr <$> positiveInteger <*> constructorArgList
+        [ Constr <$> constrIndex <*> constructorArgList
         , List <$> constructorArgList
         , Map <$> kvMapList
         ]