Fix serialization of (Plutus) 'Data'

  The Cardano ledger does not enforce a single serialization format for
  most of the binary data that can end up on-chain. In CBOR,
  data-structures like lists or maps can be encoded in two ways: finite
  (using an explicit length) or indefinite (using begin/end markers).

  For example, the list [14] can be encoded either as:

  ```
  8114  # finite; 81 = 80 + 01, indicates a list of length 1

  # OR

  9F14FF # indefinite; 9F marks the beginning of the list and FF the end).
  ```

  This means that, a same Haskell (or simply, unmarshalled) data-type
  can have multiple binary representations. The ledger copes with that
  by memoizing the original binary representation of decoded data,
  therefore avoiding to reserialize any data into a _different_
  representation. Ogmios, and basically any program manipulating binary
  data from the chain MUST also use the same strategy.

  There is an example case with the following transaction on the
  testnet:

  <https://testnet.cexplorer.io/tx/c8b91a27976836f5ba349275bba3f0b81eb1d51aaf31a4340035ce450fdf83a7>

  which carries the following datum (<https://testnet.cexplorer.io/datum/06269f665176dc65b334d685b2f64826c092875ca77e15007b5f690ecc9db1af>)

  ```
  D8798441FFD87982D87982D87982D87981581CC279A3FB3B4E62BBC78E2887
  83B58045D4AE82A18867D8352D02775AD87981D87981D87981581C121FD22E
  0B57AC206FEFC763F8BFA0771919F5218B40691EEA4514D0D87A80D87A801A
  002625A0D87983D879801A000F4240D879811A000FA92E
  ```

  Now, the datum reported by CExplorer (using cardano-db-sync) and
  Ogmios (before this commit) is:

  ```
  D8799F41FFD8799FD8799FD8799FD8799F581CC279A3FB3B4E62BBC78E2887
  83B58045D4AE82A18867D8352D02775AFFD8799FD8799FD8799F581C121FD2
  2E0B57AC206FEFC763F8BFA0771919F5218B40691EEA4514D0FFFFFFFFD87A
  80FFD87A80FF1A002625A0D8799FD879801A000F4240D8799F1A000FA92EFF
  FFFF
  ```

  Both binary representation deserializes to the same high-level
  data-type, but the former uses finite data-structure in binary,
  whereas the latter uses indefinite structures.

  If one tries to re-calculate the hash digest of the reported datum,
  one obtains (obviously) something different than expected by the
  ledger. That's because this raw datum has been re-serialized by the
  programs consuming it from the chain whereas the hash calculated and
  used by the ledger is therefore the one corresponding to the original
  (finite data-structures) datum!

  This is tricky to reason about and also tricky to discover because,
  even property tests couldn't catch that (since the ledger's arbitrary
  instances do generate data only in the indefinite form!).

  Given the output of CExplorer, it seems that cardano-db-sync is also
  affected by this bug, and possibly more client applications down the
  line. Moreover, hardware devices are serializing all data using
  finite structures, creating this discrepency for applications
  interacting / using hardware integration.

Author: KtorZ

server/ogmios.cabal

@@ -137,6 +137,7 @@ tests:
     dependencies:
     - aeson
     - aeson-pretty
+    - base16
     - bytestring
     - cardano-client
     - cardano-ledger-alonzo

server/package.yaml

@@ -12,8 +12,6 @@ import Cardano.Binary
     ( serialize' )
 import Cardano.Ledger.Crypto
     ( Crypto )
-import Codec.Serialise
-    ( serialise )
 import Data.ByteString.Base16
     ( encodeBase16 )
 import GHC.Records
@@ -200,10 +198,11 @@ encodeCostModels =
     encodeMap stringifyLanguage encodeCostModel . Al.unCostModels
 
 encodeData
-    :: Al.Data era
+    :: Ledger.Era era
+    => Al.Data era
     -> Json
-encodeData (Al.Data datum) =
-    encodeByteStringBase16 (toStrict (serialise datum))
+encodeData =
+    encodeByteStringBase16 . serialize'
 
 encodeDataHash
     :: Crypto crypto
@@ -381,7 +380,7 @@ encodeProposedPPUpdates (Sh.ProposedPPUpdates m) =
     encodeMap Shelley.stringifyKeyHash (encodePParams' encodeStrictMaybe) m
 
 encodeRedeemers
-    :: Ledger.Era era
+    :: forall era. (Ledger.Era era)
     => Al.Redeemers era
     -> Json
 encodeRedeemers (Al.Redeemers redeemers) =

server/src/Ogmios/Data/Json/Alonzo.hs

@@ -140,6 +140,8 @@ import Ogmios.Data.Protocol.TxSubmission
     )
 import Ouroboros.Consensus.Cardano.Block
     ( CardanoEras, GenTx, HardForkApplyTxErr (..) )
+import Ouroboros.Consensus.Shelley.Eras
+    ( StandardAlonzo )
 import Ouroboros.Network.Block
     ( Point (..), Tip (..) )
 import Ouroboros.Network.Protocol.LocalStateQuery.Type
@@ -154,6 +156,7 @@ import Test.Generators
     , genBlockNo
     , genBoundResult
     , genCompactGenesisResult
+    , genData
     , genDelegationAndRewardsResult
     , genEpochResult
     , genEvaluateTxResponse
@@ -210,6 +213,7 @@ import Test.QuickCheck
     , conjoin
     , counterexample
     , elements
+    , forAll
     , forAllBlind
     , forAllShrinkBlind
     , genericShrink
@@ -226,17 +230,20 @@ import Test.QuickCheck.Arbitrary.Generic
 import qualified Ogmios.Data.Json.Alonzo as Alonzo
 import qualified Ogmios.Data.Json.Babbage as Babbage
 
+import qualified Cardano.Ledger.Alonzo.Data as Ledger
 import qualified Codec.Json.Wsp.Handler as Wsp
 import qualified Data.Aeson as Json
 import qualified Data.Aeson.Encode.Pretty as Json
 import qualified Data.Aeson.Types as Json
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.Text.Encoding as T
 import qualified Test.QuickCheck as QC
 
-jsonifierToAeson
+encodingToValue
     :: Json
     -> Json.Value
-jsonifierToAeson =
+encodingToValue =
     fromJust . Json.decodeStrict . jsonToByteString
 
 -- | Generate arbitrary value of a data-type and verify they match a given
@@ -251,7 +258,7 @@ validateToJSON gen encode (n, vectorFilePath) ref = parallel $ do
     runIO $ generateTestVectors (n, vectorFilePath) gen encode
     refs <- runIO $ unsafeReadSchemaRef ref
     specify (toString $ getSchemaRef ref) $ forAllBlind gen
-        (prop_validateToJSON (jsonifierToAeson . encode) refs)
+        (prop_validateToJSON (encodingToValue . encode) refs)
 
 -- | Similar to 'validateToJSON', but also check that the produce value can be
 -- decoded back to the expected form.
@@ -268,7 +275,7 @@ validateFromJSON gen (encode, decode) (n, vectorFilePath) ref = parallel $ do
     specify (toString $ getSchemaRef ref) $ forAllBlind gen $ \a ->
         let leftSide = decodeWith decode (jsonToByteString (encode a)) in
         conjoin
-        [ prop_validateToJSON (jsonifierToAeson . encode) refs a
+        [ prop_validateToJSON (encodingToValue . encode) refs a
         , leftSide == Just a
             & counterexample (decodeUtf8 $ Json.encodePretty $ inefficientEncodingToValue $ encode a)
             & counterexample ("Got:  " <> show leftSide)
@@ -312,7 +319,6 @@ spec = do
                 Json.Success (UTxOInBabbageEra utxo') ->
                     utxo' === utxo
                         & counterexample (decodeUtf8 $ Json.encodePretty encoded)
-
         specify "Golden: Utxo_1.json" $ do
             json <- decodeFileThrow "Utxo_1.json"
             case Json.parse (decodeUtxo @StandardCrypto) json of
@@ -355,6 +361,21 @@ spec = do
                 Json.Success UTxOInBabbageEra{} ->
                     fail "successfully decoded an invalid payload( as Babbage Utxo)?"
 
+        context "Data / BinaryData" $ do
+            prop "arbitrary" $
+                forAll genData propBinaryDataRoundtrip
+
+            prop "Golden (1)" $
+                propBinaryDataRoundtrip $ unsafeDataFromBytes
+                    "D8668219019E8201D8668219010182D866821903158140D8668219020C\
+                    \83230505"
+
+            prop "Golden (2)" $
+                propBinaryDataRoundtrip $ unsafeDataFromBytes
+                    "D8798441FFD87982D87982D87982D87981581CC279A3FB3B4E62BBC78E\
+                    \288783B58045D4AE82A18867D8352D02775AD87981D87981D87981581C\
+                    \121FD22E0B57AC206FEFC763F8BFA0771919F5218B40691EEA4514D0D8\
+                    \7A80D87A801A002625A0D87983D879801A000F4240D879811A000FA92E"
 
     context "validate chain-sync request/response against JSON-schema" $ do
         validateFromJSON
@@ -862,6 +883,31 @@ instance Arbitrary SerializedTx where
           \ce8473e990d61c1506f6"
         ]
 
+
+propBinaryDataRoundtrip :: Ledger.Data StandardAlonzo -> Property
+propBinaryDataRoundtrip dat =
+    let json = jsonToByteString (Alonzo.encodeData @StandardAlonzo dat)
+     in case B16.decodeBase16 . T.encodeUtf8 <$> Json.decode (toLazy json) of
+            Just (Right bytes) ->
+                let
+                    dataFromBytes = Ledger.makeBinaryData (toShort bytes)
+                    originalData  = Ledger.dataToBinaryData dat
+                  in conjoin
+                    [ dataFromBytes
+                        === Right originalData
+                    , (Ledger.hashBinaryData <$> dataFromBytes)
+                        === Right (Ledger.hashBinaryData originalData)
+                    ] & counterexample (decodeUtf8 json)
+            _ ->
+                property False
+
+unsafeDataFromBytes :: ByteString -> Ledger.Data era
+unsafeDataFromBytes =
+    either (error . show) Ledger.binaryDataToData
+    . Ledger.makeBinaryData
+    . either error toShort
+    . B16.decodeBase16
+
 --
 -- Local State Query
 --
@@ -911,10 +957,10 @@ validateQuery json parser (n, vectorFilepath) resultRef =
                 -- max success. In the end, the property run 1 time per era!
                 runQuickCheck $ withMaxSuccess 20 $ forAllBlind
                     (genResult Proxy)
-                    (prop_validateToJSON (jsonifierToAeson . encodeQueryResponse) resultRefs)
+                    (prop_validateToJSON (encodingToValue . encodeQueryResponse) resultRefs)
 
                 let encodeQueryUnavailableInCurrentEra
-                        = jsonifierToAeson
+                        = encodingToValue
                         . _encodeQueryResponse encodeAcquireFailure
                         . Wsp.Response Nothing
 

server/test/unit/Ogmios/Data/JsonSpec.hs

@@ -9,6 +9,8 @@ module Test.Generators where
 
 import Ogmios.Prelude
 
+import Cardano.Ledger.Alonzo.Data
+    ( Data )
 import Cardano.Ledger.Alonzo.Tools
     ( TransactionScriptFailure (..) )
 import Cardano.Ledger.Alonzo.TxInfo
@@ -724,6 +726,11 @@ genUtxoBabbage
 genUtxoBabbage =
     reasonablySized arbitrary
 
+genData
+    :: Gen (Data era)
+genData =
+    reasonablySized arbitrary
+
 shrinkUtxo
     :: forall era.
         ( Era era