Preserve original CBOR bytes of ScriptData which has now been wrapp…

…ed with

the `HashableScriptData` type. Prior to this commit we were constructing
transactions with `toAlonzoData` which created a ledger `Data`
value without using the original bytes. Although the content is the same
this can result in the re-encoded value differing slightly and therefore
resulting in differing script data hashes. See:
IntersectMBO/cardano-ledger#2943 for more
details.

cardano-api/cardano-api.cabal

@@ -196,9 +196,9 @@ library gen
                       , cardano-ledger-alonzo-test
                       , cardano-ledger-byron-test ^>= 1.4
                       , cardano-ledger-core ^>= 0.1
+                      , cardano-ledger-shelley ^>= 0.1
                       , containers
                       , hedgehog
-                      , cardano-ledger-shelley ^>= 0.1
                       , text
 
 test-suite cardano-api-test

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -27,6 +27,7 @@ module Test.Gen.Cardano.Api.Typed
   , genUTxO
 
     -- * Scripts
+  , genHashableScriptData
   , genReferenceScript
   , genScript
   , genSimpleScript
@@ -109,13 +110,14 @@ import           Cardano.Api hiding (txIns)
 import qualified Cardano.Api as Api
 import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
                    WitnessNetworkIdOrByronAddress (..))
-import           Cardano.Api.Shelley (Hash (ScriptDataHash), KESPeriod (KESPeriod),
+import           Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod),
                    OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
                    PlutusScript (PlutusScriptSerialised), ProtocolParameters (ProtocolParameters),
                    ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
                    StakeCredential (StakeCredentialByKey), StakePoolKey,
                    refInsScriptsAndInlineDatsSupportedInEra)
 
+
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
@@ -220,6 +222,16 @@ genPlutusScript _ =
     -- We make no attempt to create a valid script
     PlutusScriptSerialised . SBS.toShort <$> Gen.bytes (Range.linear 0 32)
 
+
+genHashableScriptData :: Gen HashableScriptData
+genHashableScriptData = do
+  sd <- genScriptData
+  case deserialiseFromCBOR AsHashableScriptData $ serialiseToCBOR sd of
+    Left e -> error $ "genHashableScriptData: " <> show e
+    Right r -> return r
+
+
+{-# DEPRECATED genScriptData "Use genHashableScriptData" #-}
 genScriptData :: Gen ScriptData
 genScriptData =
     Gen.recursive
@@ -891,13 +903,13 @@ genTxOutDatumHashTxContext era = case era of
     AlonzoEra  -> Gen.choice
                     [ pure TxOutDatumNone
                     , TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData
-                    , TxOutDatumInTx ScriptDataInAlonzoEra <$> genScriptData
+                    , TxOutDatumInTx ScriptDataInAlonzoEra <$> genHashableScriptData
                     ]
     BabbageEra -> Gen.choice
                     [ pure TxOutDatumNone
                     , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
-                    , TxOutDatumInTx ScriptDataInBabbageEra <$> genScriptData
-                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
+                    , TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData
+                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
                     ]
 
 genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era)
@@ -913,7 +925,7 @@ genTxOutDatumHashUTxOContext era = case era of
     BabbageEra -> Gen.choice
                     [ pure TxOutDatumNone
                     , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
-                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
+                    , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
                     ]
 
 mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a

cardano-api/src/Cardano/Api.hs

@@ -399,6 +399,10 @@ module Cardano.Api (
     examplePlutusScriptAlwaysFails,
 
     -- ** Script data
+    HashableScriptData,
+    hashScriptDataBytes,
+    getOriginalScriptDataBytes,
+    getScriptData,
     ScriptData(..),
     hashScriptData,
 
@@ -412,6 +416,8 @@ module Cardano.Api (
     scriptDataToJson,
     ScriptDataJsonError (..),
     ScriptDataJsonSchemaError (..),
+    ScriptDataJsonBytesError,
+    scriptDataJsonToHashable,
 
     -- ** Script execution units
     ExecutionUnits(..),

cardano-api/src/Cardano/Api/Script.hs

@@ -792,13 +792,13 @@ instance Eq (ScriptWitness witctx era) where
 
     (==)  _ _ = False
 
-type ScriptRedeemer = ScriptData
+type ScriptRedeemer = HashableScriptData
 
 data ScriptDatum witctx where
-     ScriptDatumForTxIn    :: ScriptData -> ScriptDatum WitCtxTxIn
-     InlineScriptDatum     ::               ScriptDatum WitCtxTxIn
-     NoScriptDatumForMint  ::               ScriptDatum WitCtxMint
-     NoScriptDatumForStake ::               ScriptDatum WitCtxStake
+     ScriptDatumForTxIn    :: HashableScriptData -> ScriptDatum WitCtxTxIn
+     InlineScriptDatum     :: ScriptDatum WitCtxTxIn
+     NoScriptDatumForMint  :: ScriptDatum WitCtxMint
+     NoScriptDatumForStake :: ScriptDatum WitCtxStake
 
 deriving instance Eq   (ScriptDatum witctx)
 deriving instance Show (ScriptDatum witctx)

cardano-api/src/Cardano/Api/ScriptData.hs

@@ -1,11 +1,16 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Cardano.Api.ScriptData (
     -- * Script data
+    HashableScriptData,
+    hashScriptDataBytes,
+    getOriginalScriptDataBytes,
+    getScriptData,
     ScriptData(..),
 
     -- * Script data hashes
@@ -23,6 +28,9 @@ module Cardano.Api.ScriptData (
     ScriptDataJsonSchemaError (..),
     scriptDataFromJsonDetailedSchema,
     scriptDataToJsonDetailedSchema,
+    ScriptBytesError(..),
+    ScriptDataJsonBytesError(..),
+    scriptDataJsonToHashable,
 
     -- * Internal conversion functions
     toPlutusData,
@@ -35,11 +43,15 @@ module Cardano.Api.ScriptData (
     Hash(..),
   ) where
 
+import qualified Cardano.Binary as CBOR
+import           Codec.Serialise.Class (Serialise (..))
 import           Data.Bifunctor (first)
+import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy.Char8 as LBS
+import qualified Data.ByteString.Short as SB
 import qualified Data.Char as Char
 import           Data.Either.Combinators
 import qualified Data.List as List
@@ -77,14 +89,35 @@ import           Cardano.Api.Keys.Shelley
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseJSON
 import           Cardano.Api.SerialiseRaw
-import qualified Cardano.Binary as CBOR
-
 import           Cardano.Api.SerialiseUsing
 import           Cardano.Api.TxMetadata (pBytes, pSigned, parseAll)
-import           Codec.Serialise.Class (Serialise (..))
+
+-- Original script data bytes
+data HashableScriptData
+  = HashableScriptData
+      !BS.ByteString -- ^ Original 'ScriptData' bytes
+      !ScriptData
+      deriving (Eq, Show)
+
+instance HasTypeProxy HashableScriptData where
+    data AsType HashableScriptData = AsHashableScriptData
+    proxyToAsType _ = AsHashableScriptData
+
+instance SerialiseAsCBOR HashableScriptData where
+    serialiseToCBOR (HashableScriptData _ sd) = CBOR.serialize' sd
+    deserialiseFromCBOR AsHashableScriptData bs =
+      HashableScriptData bs
+        <$> CBOR.decodeFullDecoder "ScriptData" fromCBOR (LBS.fromStrict bs)
+
+
+getOriginalScriptDataBytes :: HashableScriptData -> BS.ByteString
+getOriginalScriptDataBytes (HashableScriptData bs _) = bs
+
+getScriptData :: HashableScriptData -> ScriptData
+getScriptData (HashableScriptData _ sd) = sd
 
 -- ----------------------------------------------------------------------------
--- Script data
+-- Script data - Allows us to represent script data as JSON
 --
 
 data ScriptData = ScriptDataConstructor
@@ -131,24 +164,41 @@ instance ToCBOR ScriptData where
   toCBOR = encode @Plutus.Data . toPlutusData
 
 instance FromCBOR ScriptData where
+  fromCBOR :: CBOR.Decoder s ScriptData
   fromCBOR = fromPlutusData <$> decode @Plutus.Data
 
-hashScriptData :: ScriptData -> Hash ScriptData
-hashScriptData = ScriptDataHash
-               . Alonzo.hashData
-               . (toAlonzoData :: ScriptData -> Alonzo.Data StandardAlonzo)
+hashScriptDataBytes :: HashableScriptData -> Hash ScriptData
+hashScriptDataBytes  =
+  ScriptDataHash . Alonzo.hashData . (toAlonzoData :: HashableScriptData  -> Alonzo.Data StandardAlonzo)
 
+{-# DEPRECATED hashScriptData "Use hashScriptDataBytes" #-}
+hashScriptData :: HashableScriptData -> Hash ScriptData
+hashScriptData = hashScriptDataBytes
 
 -- ----------------------------------------------------------------------------
 -- Conversion functions
 --
 
-toAlonzoData :: ScriptData -> Alonzo.Data ledgerera
-toAlonzoData = Alonzo.Data . toPlutusData
+newtype ScriptBytesError = ScriptBytesError String deriving Show
+
+-- There is a subtlety here. We must use the original bytes
+-- when converting to and from `HashableScriptData`/`Data`. This
+-- avoids problems that arise due to reserialization of the script
+-- data i.e differing script data hashes due to the re-encoding being slightly
+-- different to the original encoding. See: https://github.com/input-output-hk/cardano-ledger/issues/2943
 
-fromAlonzoData :: Alonzo.Data ledgerera -> ScriptData
-fromAlonzoData = fromPlutusData . Alonzo.getPlutusData
+toAlonzoData :: HashableScriptData -> Alonzo.Data ledgerera
+toAlonzoData =
+  either
+  (\ e -> error $ "toAlonzoData: " <> show e)
+  Alonzo.binaryDataToData
+  . first ScriptBytesError . Alonzo.makeBinaryData . SB.toShort . getOriginalScriptDataBytes
 
+fromAlonzoData :: Alonzo.Data ledgerera -> HashableScriptData
+fromAlonzoData d =
+  HashableScriptData
+    (Ledger.originalBytes d)
+    (fromPlutusData $ Alonzo.getPlutusData d)
 
 toPlutusData :: ScriptData -> Plutus.Data
 toPlutusData (ScriptDataConstructor int xs)
@@ -327,10 +377,10 @@ data ScriptDataJsonSchema =
 --
 scriptDataFromJson :: ScriptDataJsonSchema
                    -> Aeson.Value
-                   -> Either ScriptDataJsonError ScriptData
+                   -> Either ScriptDataJsonError HashableScriptData
 scriptDataFromJson schema v = do
     d <- first (ScriptDataJsonSchemaError v) (scriptDataFromJson' v)
-    first (ScriptDataRangeError v) (validateScriptData d)
+    first (ScriptDataRangeError v) (validateScriptData $ getScriptData d)
     return d
   where
     scriptDataFromJson' =
@@ -347,7 +397,7 @@ scriptDataFromJson schema v = do
 -- See 'ScriptDataJsonSchema' for the details.
 --
 scriptDataToJson :: ScriptDataJsonSchema
-                 -> ScriptData
+                 -> HashableScriptData
                  -> Aeson.Value
 scriptDataToJson schema =
     case schema of
@@ -359,8 +409,8 @@ scriptDataToJson schema =
 -- JSON conversion using the the "no schema" style
 --
 
-scriptDataToJsonNoSchema :: ScriptData -> Aeson.Value
-scriptDataToJsonNoSchema = conv
+scriptDataToJsonNoSchema :: HashableScriptData -> Aeson.Value
+scriptDataToJsonNoSchema = conv . getScriptData
   where
     conv :: ScriptData -> Aeson.Value
     conv (ScriptDataNumber n) = Aeson.Number (fromInteger n)
@@ -400,8 +450,8 @@ scriptDataToJsonNoSchema = conv
 
 scriptDataFromJsonNoSchema :: Aeson.Value
                            -> Either ScriptDataJsonSchemaError
-                                     ScriptData
-scriptDataFromJsonNoSchema = conv
+                                     HashableScriptData
+scriptDataFromJsonNoSchema = fmap (\sd -> HashableScriptData (serialiseToCBOR sd) sd) . conv
   where
     conv :: Aeson.Value
          -> Either ScriptDataJsonSchemaError ScriptData
@@ -445,14 +495,37 @@ scriptDataFromJsonNoSchema = conv
 -- be encoded as CBOR bytestrings.
 bytesPrefix :: Text
 bytesPrefix = "0x"
-
+data ScriptDataJsonBytesError
+    = ScriptDataJsonBytesErrorAesonDecode String
+    | ScriptDataJsonBytesErrorValue ScriptDataJsonError
+    | ScriptDataJsonBytesErrorInvalid ScriptDataRangeError
+    deriving Show
+instance Error ScriptDataJsonBytesError where
+  displayError (ScriptDataJsonBytesErrorAesonDecode e) =
+    "Error decoding ScriptData JSON bytes: " <> e
+  displayError (ScriptDataJsonBytesErrorValue e) =
+    "Error decoding ScriptData JSON value: " <> show e
+  displayError (ScriptDataJsonBytesErrorInvalid e) =
+    "ScriptData is invalid: " <> show e
+
+-- | This allows us to take JSON formatted ScriptData and encode it in the CDDL format
+-- whilst preserving the original bytes.
+scriptDataJsonToHashable
+  :: ScriptDataJsonSchema
+  -> ByteString -- ^ JSON encoded ScriptData
+  -> Either ScriptDataJsonBytesError HashableScriptData
+scriptDataJsonToHashable schema jsonScriptDataBytes = do
+  scriptDataVal <- first ScriptDataJsonBytesErrorAesonDecode $ Aeson.eitherDecode' $ LBS.fromStrict jsonScriptDataBytes
+  sData <- first ScriptDataJsonBytesErrorValue $ scriptDataFromJson schema scriptDataVal
+  first ScriptDataJsonBytesErrorInvalid $ validateScriptData $ getScriptData sData
+  return sData
 
 -- ----------------------------------------------------------------------------
 -- JSON conversion using the "detailed schema" style
 --
 
-scriptDataToJsonDetailedSchema :: ScriptData -> Aeson.Value
-scriptDataToJsonDetailedSchema = conv
+scriptDataToJsonDetailedSchema :: HashableScriptData -> Aeson.Value
+scriptDataToJsonDetailedSchema = conv . getScriptData
   where
     conv :: ScriptData -> Aeson.Value
     conv (ScriptDataNumber n) = singleFieldObject "int"
@@ -481,8 +554,8 @@ scriptDataToJsonDetailedSchema = conv
 
 scriptDataFromJsonDetailedSchema :: Aeson.Value
                                  -> Either ScriptDataJsonSchemaError
-                                           ScriptData
-scriptDataFromJsonDetailedSchema = conv
+                                           HashableScriptData
+scriptDataFromJsonDetailedSchema = fmap (\sd -> HashableScriptData (serialiseToCBOR sd) sd) . conv
   where
     conv :: Aeson.Value
          -> Either ScriptDataJsonSchemaError ScriptData