Test original bytes

IntersectMBO · Sep 11, 2022 · 6df2635 · 6df2635
1 parent 902847b
commit 6df2635
Show file tree

Hide file tree

Showing 5 changed files with 73 additions and 18 deletions.
diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/ScriptsExamples.hs
@@ -20,8 +20,16 @@ module Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples
   , alwaysMintScriptStake
   , scriptHash
   , assetNames
+  , plutusData2
+  , plutusDataEncLen
+  , plutusDataEncIndef
   ) where
 
+import           Codec.CBOR.Write (toStrictByteString)
+import           Codec.Serialise
+import           Codec.Serialise.Encoding
+import           Data.ByteString.Short
+
 import           Cardano.Ledger.Address
 import           Cardano.Ledger.Alonzo
 import           Cardano.Ledger.Alonzo.Data
@@ -96,3 +104,12 @@ assetNames =
   , AssetName "degwte"
   , AssetName "w4yt4230\\0"
   ]
+
+plutusData2 :: [Plutus.Data]
+plutusData2 = [Plutus.I 0, Plutus.I 1]
+
+plutusDataEncLen :: ShortByteString
+plutusDataEncLen = toShort $ toStrictByteString $ mconcat (encodeListLen 2 : (encode <$> plutusData2))
+
+plutusDataEncIndef :: ShortByteString
+plutusDataEncIndef = toShort $ toStrictByteString $ encodeList plutusData2
diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs
@@ -12,6 +12,7 @@ module Cardano.Mock.Forging.Tx.Babbage
   ( BabbageUTxOIndex
   , BabbageLedgerState
   , TxOutScriptType (..)
+  , DatumType (..)
   , ReferenceScript (..)
   , consTxBody
   , addValidityInterval
@@ -20,7 +21,6 @@ module Cardano.Mock.Forging.Tx.Babbage
   , mkPaymentTx
   , mkPaymentTx'
   , scriptSucceeds
-  , hasInlineDatum
   , getInlineScript
   , mkLockByScriptTx
   , mkOutFromType
@@ -50,6 +50,7 @@ module Cardano.Mock.Forging.Tx.Babbage
 
 import           Cardano.Prelude hiding (sum, (.))
 
+import           Data.ByteString.Short (ShortByteString)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromJust)
 import qualified Data.Maybe.Strict as Strict
@@ -97,7 +98,12 @@ type BabbageLedgerState = LedgerState (ShelleyBlock PraosStandard StandardBabbag
 
 data TxOutScriptType
   = TxOutNoInline Bool -- nothing is inlined, like in Alonzo
-  | TxOutInline Bool Bool ReferenceScript -- validScript, inlineDatum, reference script
+  | TxOutInline Bool DatumType ReferenceScript -- validScript, inlineDatum, reference script
+
+data DatumType
+  = NotInlineDatum
+  | InlineDatum
+  | InlineDatumCBOR ShortByteString
 
 data ReferenceScript
   = NoReferenceScript
@@ -195,10 +201,10 @@ scriptSucceeds st =
     TxOutNoInline sc -> sc
     TxOutInline sc _ _ -> sc
 
-hasInlineDatum :: TxOutScriptType -> Bool
-hasInlineDatum st =
+getDatum :: TxOutScriptType -> DatumType
+getDatum st =
   case st of
-    TxOutNoInline {} -> False
+    TxOutNoInline {} -> NotInlineDatum
     TxOutInline _ inl _ -> inl
 
 getInlineScript :: TxOutScriptType -> StrictMaybe Bool
@@ -227,7 +233,10 @@ mkOutFromType :: Integer -> TxOutScriptType -> TxOut StandardBabbage
 mkOutFromType amount txOutType =
     let outAddress = if scriptSucceeds txOutType then alwaysSucceedsScriptAddr else alwaysFailsScriptAddr
         datahash = hashData @StandardBabbage plutusDataList
-        dt = if hasInlineDatum txOutType then Datum (dataToBinaryData plutusDataList) else DatumHash datahash
+        dt = case getDatum txOutType of
+          NotInlineDatum -> DatumHash datahash
+          InlineDatum -> Datum (dataToBinaryData plutusDataList)
+          InlineDatumCBOR sbs -> Datum $ either error id $ makeBinaryData sbs
         scpt = case getInlineScript txOutType of
           Strict.SNothing -> Strict.SNothing
           Strict.SJust True -> Strict.SJust alwaysSucceedsScript
@@ -268,7 +277,7 @@ mkUnlockScriptTxBabbage inputIndex colInputIndex outputIndex refInput compl succ
       (mapMaybe mkScriptInp $ zip [0..] inputPairs)
       $ consPaymentTxBody inpts colInput refInpts (StrictSeq.fromList [output]) colOut (Coin fees) mempty
   where
-    collTxOutType = if compl then Just $ TxOutInline True True (ReferenceScript True)
+    collTxOutType = if compl then Just $ TxOutInline True InlineDatum (ReferenceScript True)
                     else Just $ TxOutNoInline True
 
 mkScriptInp :: (Word64, (TxIn StandardCrypto, Core.TxOut StandardBabbage))

diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage.hs
@@ -14,6 +14,7 @@ import           Control.Monad
 import           Control.Monad.Class.MonadSTM.Strict
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Short as SBS
 import qualified Data.Map as Map
 import           Data.Text (Text)
 
@@ -150,6 +151,7 @@ unitTests iom knownMigrations =
       , testGroup "Babbage inline and reference"
           [ test "spend inline datum" unlockDatumOutput
           , test "spend inline datum same block" unlockDatumOutputSameBlock
+          , test "inline datum with non canonical CBOR" inlineDatumCBOR
           , test "spend reference script" spendRefScript
           , test "spend reference script same block" spendRefScriptSameBlock
           , test "spend collateral output of invalid tx" spendCollateralOutput
@@ -1649,7 +1651,7 @@ unlockDatumOutput =
 
       -- We don't use withBabbageFindLeaderAndSubmitTx here, because we want access to the tx.
       tx0 <- withBabbageLedgerState interpreter
-        $ Babbage.mkLockByScriptTx (UTxOIndex 0) [Babbage.TxOutInline True True Babbage.NoReferenceScript] 20000 20000
+        $ Babbage.mkLockByScriptTx (UTxOIndex 0) [Babbage.TxOutInline True Babbage.InlineDatum Babbage.NoReferenceScript] 20000 20000
       void $ forgeNextAndSubmit interpreter mockServer $ MockBlock [TxBabbage tx0] (NodeId 1)
 
       let utxo0 = head (Babbage.mkUTxOBabbage tx0)
@@ -1671,7 +1673,7 @@ unlockDatumOutputSameBlock =
       -- inputs and adding unnnecessary fields to the collateral output.
       txs' <- withBabbageLedgerState interpreter $ \st -> do
         tx0 <- Babbage.mkLockByScriptTx (UTxOIndex 0)
-                [Babbage.TxOutInline True True Babbage.NoReferenceScript, Babbage.TxOutInline True False (Babbage.ReferenceScript False)]
+                [Babbage.TxOutInline True Babbage.InlineDatum Babbage.NoReferenceScript, Babbage.TxOutInline True Babbage.NotInlineDatum (Babbage.ReferenceScript False)]
                 20000 20000 st
         let utxo0 = head (Babbage.mkUTxOBabbage tx0)
         tx1 <- Babbage.mkUnlockScriptTxBabbage [UTxOPair utxo0] (UTxOIndex 1) (UTxOIndex 2)
@@ -1684,6 +1686,22 @@ unlockDatumOutputSameBlock =
   where
     testLabel = "unlockDatumOutputSameBlock"
 
+inlineDatumCBOR :: IOManager -> [(Text, Text)] -> Assertion
+inlineDatumCBOR =
+    withFullConfig babbageConfig testLabel $ \interpreter mockServer dbSync -> do
+      startDBSync  dbSync
+      void $ registerAllStakeCreds interpreter mockServer
+
+      -- We don't use withBabbageFindLeaderAndSubmitTx here, because we want access to the tx.
+      tx0 <- withBabbageLedgerState interpreter
+        $ Babbage.mkLockByScriptTx (UTxOIndex 0) [Babbage.TxOutInline True (Babbage.InlineDatumCBOR plutusDataEncLen) Babbage.NoReferenceScript] 20000 20000
+      void $ forgeNextAndSubmit interpreter mockServer $ MockBlock [TxBabbage tx0] (NodeId 1)
+
+      assertBlockNoBackoff dbSync 2
+      assertDatumCBOR dbSync $ SBS.fromShort plutusDataEncLen
+  where
+    testLabel = "inlineDatumCBOR"
+
 spendRefScript :: IOManager -> [(Text, Text)] -> Assertion
 spendRefScript =
     withFullConfig babbageConfig testLabel $ \interpreter mockServer dbSync -> do
@@ -1692,7 +1710,7 @@ spendRefScript =
 
       -- We don't use withBabbageFindLeaderAndSubmitTx here, because we want access to the tx.
       tx0 <- withBabbageLedgerState interpreter
-        $ Babbage.mkLockByScriptTx (UTxOIndex 0) [Babbage.TxOutInline True False (Babbage.ReferenceScript True)] 20000 20000
+        $ Babbage.mkLockByScriptTx (UTxOIndex 0) [Babbage.TxOutInline True Babbage.NotInlineDatum (Babbage.ReferenceScript True)] 20000 20000
       void $ forgeNextAndSubmit interpreter mockServer $ MockBlock [TxBabbage tx0] (NodeId 1)
 
       let utxo0 = head (Babbage.mkUTxOBabbage tx0)
@@ -1712,8 +1730,8 @@ spendRefScriptSameBlock =
 
       txs' <- withBabbageLedgerState interpreter $ \st -> do
         tx0 <- Babbage.mkLockByScriptTx (UTxOIndex 0)
-                [ Babbage.TxOutInline True False (Babbage.ReferenceScript True)
-                , Babbage.TxOutInline True False (Babbage.ReferenceScript False)]
+                [ Babbage.TxOutInline True Babbage.NotInlineDatum (Babbage.ReferenceScript True)
+                , Babbage.TxOutInline True Babbage.NotInlineDatum (Babbage.ReferenceScript False)]
                 20000 20000 st
         let utxo0 = head (Babbage.mkUTxOBabbage tx0)
         tx1 <- Babbage.mkUnlockScriptTxBabbage [UTxOPair utxo0] (UTxOIndex 1) (UTxOIndex 2)
@@ -1783,8 +1801,8 @@ referenceInputUnspend =
 
       txs' <- withBabbageLedgerState interpreter $ \st -> do
         tx0 <- Babbage.mkLockByScriptTx (UTxOIndex 0)
-                [ Babbage.TxOutInline True True (Babbage.ReferenceScript True)
-                , Babbage.TxOutInline True True (Babbage.ReferenceScript True)]
+                [ Babbage.TxOutInline True Babbage.InlineDatum (Babbage.ReferenceScript True)
+                , Babbage.TxOutInline True Babbage.InlineDatum (Babbage.ReferenceScript True)]
                 20000 20000 st
 
         let (utxo0 : utxo1 : _)  = Babbage.mkUTxOBabbage tx0
@@ -1806,7 +1824,7 @@ supplyScriptsTwoWays =
 
       tx0 <- withBabbageLedgerState interpreter
         $ Babbage.mkLockByScriptTx (UTxOIndex 0)
-                [ Babbage.TxOutInline True True (Babbage.ReferenceScript True)
+                [ Babbage.TxOutInline True Babbage.InlineDatum (Babbage.ReferenceScript True)
                 , Babbage.TxOutNoInline True]
                 20000 20000
       void $ forgeNextFindLeaderAndSubmit interpreter mockServer [TxBabbage tx0]
@@ -1831,7 +1849,7 @@ supplyScriptsTwoWaysSameBlock =
       txs' <- withBabbageLedgerState interpreter $ \st -> do
         -- one script referenced and one for the witnesses
         tx0 <- Babbage.mkLockByScriptTx (UTxOIndex 0)
-                [ Babbage.TxOutInline True True (Babbage.ReferenceScript True)
+                [ Babbage.TxOutInline True Babbage.InlineDatum (Babbage.ReferenceScript True)
                 , Babbage.TxOutNoInline True]
                 20000 20000 st
 
@@ -1855,7 +1873,7 @@ referenceMintingScript =
       txs' <- withBabbageLedgerState interpreter $ \st -> do
         -- one script referenced and one for the witnesses
         tx0 <- Babbage.mkLockByScriptTx (UTxOIndex 0)
-                [ Babbage.TxOutInline True True (Babbage.ReferenceScript True)]
+                [ Babbage.TxOutInline True Babbage.InlineDatum (Babbage.ReferenceScript True)]
                 20000 20000 st
 
         let utxo0 = head $ Babbage.mkUTxOBabbage tx0
@@ -1880,7 +1898,7 @@ referenceDelegation =
       txs' <- withBabbageLedgerState interpreter $ \st -> do
         -- one script referenced and one for the witnesses
         tx0 <- Babbage.mkLockByScriptTx (UTxOIndex 0)
-                [ Babbage.TxOutInline True True (Babbage.ReferenceScript True)]
+                [ Babbage.TxOutInline True Babbage.InlineDatum (Babbage.ReferenceScript True)]
                 20000 20000 st
 
         let utxo0 = head $ Babbage.mkUTxOBabbage tx0

diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs
@@ -28,6 +28,7 @@ module Test.Cardano.Db.Mock.Validate
   , assertEpochStake
   , assertEpochStakeEpoch
   , assertNonZeroFeesContract
+  , assertDatumCBOR
   , assertAlonzoCounts
   , assertScriptCert
   , assertPoolCounters
@@ -275,6 +276,15 @@ assertNonZeroFeesContract env =
           where_ (tx ^. TxValidContract ==. val False)
           pure countRows)
 
+assertDatumCBOR :: DBSyncEnv -> ByteString -> IO ()
+assertDatumCBOR env bs =
+    assertEqBackoff env q 1 defaultDelays "Datum bytes not found"
+  where
+    q :: ReaderT SqlBackend (NoLoggingT IO) Word64
+    q = maybe 0 unValue . listToMaybe <$> (select . from $ \datum -> do
+          where_ (datum ^. DatumBytes ==. val bs)
+          pure countRows)
+
 assertAlonzoCounts :: DBSyncEnv -> (Word64, Word64, Word64, Word64, Word64, Word64, Word64, Word64) -> IO ()
 assertAlonzoCounts env expected =
     assertEqBackoff env q expected defaultDelays "Unexpected Alonzo counts"

diff --git a/cardano-chain-gen/test/testfiles/fingerprint/inlineDatumCBOR b/cardano-chain-gen/test/testfiles/fingerprint/inlineDatumCBOR
@@ -0,0 +1 @@
+[1,8]