diff --git a/cardano-api/ChangeLog.md b/cardano-api/ChangeLog.md index f4313b0bc8c..c3cbf617710 100644 --- a/cardano-api/ChangeLog.md +++ b/cardano-api/ChangeLog.md @@ -16,7 +16,10 @@ - **Breaking change** - `deserialiseFromRawBytes` method of the `SerialiseAsRawBytes` type class to return `Either` instead of `Maybe`. Deprecate `eitherDeserialiseFromRawBytes`. Use `deserialiseFromRawBytes` instead. -- The `cardano-cli governance create-update-proposal` command to reject empty cost model. +- The `cardano-cli governance create-update-proposal` command to reject empty cost model ([PR4885](https://github.com/input-output-hk/cardano-node/pull/4885)) + +- **Breaking change** - Preserve ScriptData bytes with HashableScriptData ([PR4886](https://github.com/input-output-hk/cardano-node/pull/4886)) + ### Bugs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 4853eb89c1c..d172ebd7a38 100644 --- a/cardano-api/cardano-api.cabal +++ b/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 @@ -216,11 +216,13 @@ test-suite cardano-api-test , cardano-crypto-class ^>= 2.0 , cardano-crypto-test ^>= 1.4 , cardano-crypto-tests ^>= 2.0 + , cardano-ledger-alonzo ^>= 0.1 , cardano-ledger-core ^>= 0.1 , cardano-slotting ^>= 0.1 , containers , hedgehog , hedgehog-extras + , mtl , ouroboros-consensus , ouroboros-consensus-shelley , QuickCheck diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 271ec9fba98..f6cfb2f4ef8 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/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 @@ -35,6 +36,7 @@ module Test.Gen.Cardano.Api.Typed , genScriptInEra , genScriptHash , genScriptData + , genScriptDataSchema , genScriptValidity , genAssetName @@ -109,13 +111,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 +223,18 @@ genPlutusScript _ = -- We make no attempt to create a valid script PlutusScriptSerialised . SBS.toShort <$> Gen.bytes (Range.linear 0 32) +genScriptDataSchema :: Gen ScriptDataJsonSchema +genScriptDataSchema = Gen.element [ScriptDataJsonNoSchema, ScriptDataJsonDetailedSchema] + +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 +906,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 +928,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 diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 66ecc12e0d0..014ccf5477e 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/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(..), diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 78acb605b2a..995d1c68471 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/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) diff --git a/cardano-api/src/Cardano/Api/ScriptData.hs b/cardano-api/src/Cardano/Api/ScriptData.hs index f6d470a5323..0da92738e00 100644 --- a/cardano-api/src/Cardano/Api/ScriptData.hs +++ b/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,14 @@ module Cardano.Api.ScriptData ( Hash(..), ) where +import qualified Cardano.Binary as CBOR +import Codec.Serialise.Class (Serialise (..)) import Data.Bifunctor (first) 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 +88,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 origBytes _) = origBytes + 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 +163,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) @@ -195,11 +244,7 @@ validateScriptData d = | n > fromIntegral (maxBound :: Word64) || n < negate (fromIntegral (maxBound :: Word64)) ] - collect (ScriptDataBytes bs) = - [ ScriptDataBytesTooLong len - | let len = BS.length bs - , len > scriptDataByteStringMaxLength - ] + collect ScriptDataBytes{} = [] collect (ScriptDataList xs) = foldMap collect xs @@ -213,12 +258,6 @@ validateScriptData d = | n > fromIntegral (maxBound :: Word64) || n < 0 ] <> foldMap collect xs - --- | The maximum length of a script data byte string value. -scriptDataByteStringMaxLength :: Int -scriptDataByteStringMaxLength = 64 - - -- | An error in script data due to an out-of-range value. -- data ScriptDataRangeError = @@ -230,11 +269,6 @@ data ScriptDataRangeError = -- | The number is outside the maximum range of @-2^64-1 .. 2^64-1@. -- | ScriptDataConstructorOutOfRange !Integer - - -- | The length of a byte string metadatum value exceeds the maximum of - -- 64 bytes. - -- - | ScriptDataBytesTooLong !Int deriving (Eq, Show) instance Error ScriptDataRangeError where @@ -246,12 +280,7 @@ instance Error ScriptDataRangeError where "Constructor numbers in script data value " <> show n <> " is outside the range 0 .. 2^64-1." - displayError (ScriptDataBytesTooLong actualLen) = - "Byte strings in script data must consist of at most " - <> show scriptDataByteStringMaxLength - <> " bytes, but it consists of " - <> show actualLen - <> " bytes." + -- ---------------------------------------------------------------------------- @@ -327,10 +356,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 +376,7 @@ scriptDataFromJson schema v = do -- See 'ScriptDataJsonSchema' for the details. -- scriptDataToJson :: ScriptDataJsonSchema - -> ScriptData + -> HashableScriptData -> Aeson.Value scriptDataToJson schema = case schema of @@ -359,8 +388,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 +429,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 @@ -446,13 +475,35 @@ scriptDataFromJsonNoSchema = conv bytesPrefix :: Text bytesPrefix = "0x" +data ScriptDataJsonBytesError + = ScriptDataJsonBytesErrorValue ScriptDataJsonError + | ScriptDataJsonBytesErrorInvalid ScriptDataRangeError + deriving Show + +instance Error ScriptDataJsonBytesError where + 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 + -> Aeson.Value -- ^ ScriptData Value + -> Either ScriptDataJsonBytesError HashableScriptData +scriptDataJsonToHashable schema scriptDataVal = do + 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 +532,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 diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 9b3697149c9..cb6db89d8e8 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -203,6 +203,8 @@ import qualified Cardano.Crypto.Hashing as Byron import qualified Cardano.Ledger.Address as Shelley import qualified Cardano.Ledger.AuxiliaryData as Ledger +import Cardano.Ledger.Babbage.TxBody (BabbageEraTxBody (..), + BabbageTxBody (BabbageTxBody), BabbageTxOut (BabbageTxOut)) import Cardano.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe) import qualified Cardano.Ledger.Block as Ledger import qualified Cardano.Ledger.Coin as Ledger @@ -214,8 +216,6 @@ import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Era as CC import qualified Cardano.Ledger.Keys as Shelley import qualified Cardano.Ledger.SafeHash as SafeHash -import Cardano.Ledger.Babbage.TxBody (BabbageEraTxBody (..), - BabbageTxBody (BabbageTxBody), BabbageTxOut (BabbageTxOut)) import qualified Cardano.Ledger.TxIn as Ledger import Cardano.Ledger.Val (isZero) @@ -226,23 +226,23 @@ import qualified Cardano.Ledger.Shelley.Metadata as Shelley import qualified Cardano.Ledger.Shelley.Tx as Shelley import qualified Cardano.Ledger.Shelley.TxBody as Shelley -import qualified Cardano.Ledger.ShelleyMA.AuxiliaryData as Allegra +import Cardano.Ledger.Mary.Value (MaryValue) import Cardano.Ledger.ShelleyMA.AuxiliaryData (MAAuxiliaryData (..)) +import qualified Cardano.Ledger.ShelleyMA.AuxiliaryData as Allegra +import Cardano.Ledger.ShelleyMA.TxBody (MATxBody (..)) import qualified Cardano.Ledger.ShelleyMA.TxBody as Allegra import qualified Cardano.Ledger.ShelleyMA.TxBody as Mary -import Cardano.Ledger.ShelleyMA.TxBody (MATxBody (..)) -import Cardano.Ledger.Mary.Value (MaryValue) +import Cardano.Ledger.Alonzo.Data (AlonzoAuxiliaryData (AlonzoAuxiliaryData)) +import qualified Cardano.Ledger.Alonzo.Data as Alonzo import qualified Cardano.Ledger.Alonzo.Language as Alonzo import qualified Cardano.Ledger.Alonzo.PParams as Alonzo import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo -import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo -import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo -import Cardano.Ledger.Alonzo.Data (AlonzoAuxiliaryData (AlonzoAuxiliaryData)) -import qualified Cardano.Ledger.Alonzo.Data as Alonzo import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody (AlonzoTxBody), AlonzoTxOut (AlonzoTxOut)) +import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo +import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo import qualified Cardano.Ledger.Babbage.PParams as Babbage import qualified Cardano.Ledger.Babbage.TxBody as Babbage @@ -436,7 +436,7 @@ txOutToJsonValue era (TxOut addr val dat refScript) = TxOutDatumInTx' _ h _ -> "datumhash" .= toJSON h TxOutDatumInline _ datum -> - "inlineDatumhash" .= toJSON (hashScriptData datum) + "inlineDatumhash" .= toJSON (hashScriptDataBytes datum) datJsonVal :: TxOutDatum ctx era -> Aeson.Value datJsonVal d = @@ -488,14 +488,14 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where inlineDatum <- o .:? "inlineDatum" mInlineDatum <- case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of + (Just dVal, Just h) -> do + case scriptDataJsonToHashable ScriptDataJsonDetailedSchema dVal of Left err -> fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptData sData /= h + Right hashableData -> do + if hashScriptDataBytes hashableData /= h then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra sData + else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra hashableData (Nothing, Nothing) -> return TxOutDatumNone (_,_) -> fail "Should not be possible to create a tx output with either an inline datum hash or an inline datum" @@ -534,14 +534,14 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where <*> o .: "value" <*> return TxOutDatumNone <*> return ReferenceScriptNone - (Just dVal, Just dHash) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> TxOut <$> o .: "address" - <*> o .: "value" - <*> return (TxOutDatumInTx' supp dHash sData) - <*> return ReferenceScriptNone + (Just dVal, Just dHash) -> do + case scriptDataJsonToHashable ScriptDataJsonDetailedSchema dVal of + Left e -> fail $ "Error parsing ScriptData: " <> show e + Right hashableData -> + TxOut <$> o .: "address" + <*> o .: "value" + <*> return (TxOutDatumInTx' supp dHash hashableData) + <*> return ReferenceScriptNone (Nothing, Just dHash) -> TxOut <$> o .: "address" <*> o .: "value" @@ -577,14 +577,14 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where inlineDatum <- o .:? "inlineDatum" mInlineDatum <- case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptData sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra sData + (Just dVal, Just h) -> do + case scriptDataJsonToHashable ScriptDataJsonDetailedSchema dVal of + Left err -> + fail $ "Error parsing TxOut JSON: " <> displayError err + Right hashableData -> do + if hashScriptDataBytes hashableData /= h + then fail "Inline datum not equivalent to inline datum hash" + else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra hashableData (Nothing, Nothing) -> return TxOutDatumNone (_,_) -> fail "Should not be possible to create a tx output with either an inline datum hash or an inline datum" @@ -669,7 +669,8 @@ toShelleyTxOut _ (TxOut addr (TxOutValue MultiAssetInAlonzoEra value) txoutdata toShelleyTxOut era (TxOut addr (TxOutValue MultiAssetInBabbageEra value) txoutdata refScript) = let cEra = shelleyBasedToCardanoEra era in BabbageTxOut (toShelleyAddr addr) (toMaryValue value) - (toBabbageTxOutDatum txoutdata) (refScriptToShelleyScript cEra refScript) + (toBabbageTxOutDatum txoutdata) + (refScriptToShelleyScript cEra refScript) fromShelleyTxOut :: ShelleyLedgerEra era ~ ledgerera @@ -1342,7 +1343,7 @@ data TxOutDatum ctx era where -- TxOutDatumInTx' :: ScriptDataSupportedInEra era -> Hash ScriptData - -> ScriptData + -> HashableScriptData -> TxOutDatum CtxTx era -- | A transaction output that specifies the whole datum instead of the @@ -1350,7 +1351,7 @@ data TxOutDatum ctx era where -- it only exists at the transaction output. -- TxOutDatumInline :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era - -> ScriptData + -> HashableScriptData -> TxOutDatum ctx era deriving instance Eq (TxOutDatum ctx era) @@ -1377,11 +1378,11 @@ instance EraCast (TxOutDatum ctx) where pattern TxOutDatumInTx :: ScriptDataSupportedInEra era - -> ScriptData + -> HashableScriptData -> TxOutDatum CtxTx era pattern TxOutDatumInTx s d <- TxOutDatumInTx' s _ d where - TxOutDatumInTx s d = TxOutDatumInTx' s (hashScriptData d) d + TxOutDatumInTx s d = TxOutDatumInTx' s (hashScriptDataBytes d) d {-# COMPLETE TxOutDatumNone, TxOutDatumHash, TxOutDatumInTx', TxOutDatumInline #-} {-# COMPLETE TxOutDatumNone, TxOutDatumHash, TxOutDatumInTx , TxOutDatumInline #-} @@ -3163,7 +3164,7 @@ convScriptData era txOuts scriptWitnesses = , let d' = toAlonzoData d ] - scriptdata :: [ScriptData] + scriptdata :: [HashableScriptData] scriptdata = [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ] ++ [ d | (_, AnyScriptWitness @@ -3450,7 +3451,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo , let d' = toAlonzoData d ] - scriptdata :: [ScriptData] + scriptdata :: [HashableScriptData] scriptdata = [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ] ++ [ d | (_, AnyScriptWitness @@ -3559,7 +3560,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraBabbage , let d' = toAlonzoData d ] - scriptdata :: [ScriptData] + scriptdata :: [HashableScriptData] scriptdata = [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ] ++ [ d | (_, AnyScriptWitness @@ -3889,12 +3890,14 @@ calculateExecutionUnitsLovelace euPrices eUnits = -- onchain within a transaction output. -- -scriptDataToInlineDatum :: ScriptData -> Babbage.Datum ledgerera -scriptDataToInlineDatum = Babbage.Datum . Alonzo.dataToBinaryData . toAlonzoData +scriptDataToInlineDatum :: HashableScriptData -> Babbage.Datum ledgerera +scriptDataToInlineDatum d = + Babbage.Datum . Alonzo.dataToBinaryData $ toAlonzoData d binaryDataToScriptData - :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> Alonzo.BinaryData ledgerera -> ScriptData -binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInBabbageEra d = + :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era + -> Alonzo.BinaryData ledgerera -> HashableScriptData +binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInBabbageEra d = fromAlonzoData $ Alonzo.binaryDataToData d diff --git a/cardano-api/test/Test/Cardano/Api/Json.hs b/cardano-api/test/Test/Cardano/Api/Json.hs index f3ecec101e7..37354a4c47d 100644 --- a/cardano-api/test/Test/Cardano/Api/Json.hs +++ b/cardano-api/test/Test/Cardano/Api/Json.hs @@ -78,7 +78,7 @@ prop_json_roundtrip_eraInMode = H.property $ do prop_json_roundtrip_scriptdata_detailed_json :: Property prop_json_roundtrip_scriptdata_detailed_json = H.property $ do - sData <- forAll genScriptData + sData <- forAll genHashableScriptData tripping sData scriptDataToJsonDetailedSchema scriptDataFromJsonDetailedSchema tests :: TestTree diff --git a/cardano-api/test/Test/Cardano/Api/Ledger.hs b/cardano-api/test/Test/Cardano/Api/Ledger.hs index 687301172f5..7efda9962fc 100644 --- a/cardano-api/test/Test/Cardano/Api/Ledger.hs +++ b/cardano-api/test/Test/Cardano/Api/Ledger.hs @@ -1,20 +1,31 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Cardano.Api.Ledger ( tests ) where +import Cardano.Api +import Cardano.Api.Shelley + +import Control.Monad.Identity + import Cardano.Ledger.Address (deserialiseAddr, serialiseAddr) -import Hedgehog (Property) -import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) +import qualified Cardano.Ledger.Alonzo.Data as Alonzo +import Cardano.Ledger.Crypto +import Cardano.Ledger.SafeHash + +import Ouroboros.Consensus.Shelley.Eras (StandardAlonzo) + +import qualified Hedgehog as H +import qualified Hedgehog.Extras.Aeson as H +import Hedgehog.Internal.Property import Test.Cardano.Api.Genesis (exampleShelleyGenesis) import Test.Cardano.Ledger.Shelley.Serialisation.Generators.Genesis (genAddress) +import Test.Gen.Cardano.Api.Typed import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) -import qualified Hedgehog as H -import qualified Hedgehog.Extras.Aeson as H - prop_golden_ShelleyGenesis :: Property prop_golden_ShelleyGenesis = H.goldenTestJsonValuePretty exampleShelleyGenesis "test/Golden/ShelleyGenesis" @@ -27,10 +38,40 @@ prop_roundtrip_Address_CBOR = H.property $ do addr <- H.forAll (genAddress @StandardCrypto) H.tripping addr serialiseAddr deserialiseAddr +-- prop_original_scriptdata_bytes_preserved and prop_roundtrip_scriptdata_plutusdata +-- allow us to generate a 'HashableScriptData' value from JSON with the original bytes being +-- derived from a JSON 'Value'. We serialize the 'ScriptData' (derived from the 'Value') +-- to CBOR and take those as the original bytes. Under the hood ScriptData is converted to PlutusData +-- before serializing. + +prop_original_scriptdata_bytes_preserved :: Property +prop_original_scriptdata_bytes_preserved = H.property $ do + schema <- forAll genScriptDataSchema + sDataValue <- scriptDataToJson schema <$> forAll genHashableScriptData + case scriptDataJsonToHashable schema sDataValue of + Left e -> failWith Nothing $ show e + Right hScriptData -> do + let ScriptDataHash apiHash = hashScriptDataBytes hScriptData + ledgerAlonzoData = toAlonzoData hScriptData :: Alonzo.Data StandardAlonzo + -- We check that our hashScriptDataBytes is equivalent to `Alonzo.hashData` + -- This test will let us know if our 'hashScriptDataBytes' is ever broken + Alonzo.hashData ledgerAlonzoData === apiHash + + -- We also check that the original bytes are the same after the calling + -- toAlonzoData :: HashableScriptData -> Alonzo.Data ledgerera. + originalBytes ledgerAlonzoData === getOriginalScriptDataBytes hScriptData + +prop_roundtrip_scriptdata_plutusdata :: Property +prop_roundtrip_scriptdata_plutusdata = H.property $ do + sd <- getScriptData <$> forAll genHashableScriptData + H.tripping sd toPlutusData (Identity . fromPlutusData) + -- ----------------------------------------------------------------------------- tests :: TestTree tests = testGroup "Test.Cardano.Api.Ledger" [ testPropertyNamed "golden ShelleyGenesis" "golden ShelleyGenesis" prop_golden_ShelleyGenesis , testPropertyNamed "roundtrip Address CBOR" "roundtrip Address CBOR" prop_roundtrip_Address_CBOR + , testPropertyNamed "roundtrip ScriptData" "roundtrip ScriptData" prop_roundtrip_scriptdata_plutusdata + , testPropertyNamed "script data bytes preserved" "script data bytes preserved" prop_original_scriptdata_bytes_preserved ] diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs b/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs index 495a0f5921f..35b627d2a2e 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/Ord.hs @@ -49,7 +49,7 @@ prop_ord_distributive_TxMetadata = prop_ord_distributive_ScriptData :: Property prop_ord_distributive_ScriptData = - ord_distributive genScriptData toPlutusData + ord_distributive (getScriptData <$> genHashableScriptData) toPlutusData -- ----------------------------------------------------------------------------- diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Script.hs b/cardano-api/test/Test/Cardano/Api/Typed/Script.hs index e595330aabe..58759a21bfd 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Script.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/Script.hs @@ -119,7 +119,7 @@ prop_roundtrip_SimpleScriptV2_JSON = prop_roundtrip_ScriptData :: Property prop_roundtrip_ScriptData = H.property $ do - sData <- H.forAll genScriptData + sData <- H.forAll genHashableScriptData sData === fromAlonzoData (toAlonzoData sData) -- ----------------------------------------------------------------------------- diff --git a/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs b/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs index f62aeb40a9f..a16e0f67823 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/TxBody.hs @@ -50,7 +50,7 @@ prop_roundtrip_txbodycontent_txouts = matchDatum :: MonadTest m => (TxOutDatum CtxTx era, TxOutDatum CtxTx era) -> m () matchDatum = \case (TxOutDatumHash _ dh, TxOutDatumInTx _ d) -> - dh === hashScriptData d + dh === hashScriptDataBytes d (a, b) -> a === b diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index c3e0358551f..ecaf7de618a 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -17,7 +17,6 @@ module Cardano.CLI.Shelley.Parsers import Cardano.Prelude (ConvertText (..)) import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Parser as Aeson.Parser import qualified Data.Attoparsec.ByteString.Char8 as Atto import Data.Bifunctor import Data.ByteString (ByteString) @@ -342,11 +341,15 @@ pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile = \top-level strings and numbers.") ) + readerScriptData :: ReadM HashableScriptData readerScriptData = do - v <- readerJSON - case scriptDataFromJson ScriptDataJsonNoSchema v of - Left err -> fail (displayError err) - Right sd -> return sd + v <- Opt.str + case Aeson.eitherDecode v of + Left e -> fail $ "readerScriptData: " <> e + Right sDataValue -> + case scriptDataJsonToHashable ScriptDataJsonNoSchema sDataValue of + Left err -> fail (displayError err) + Right sd -> return sd pStakeAddressCmd :: Parser StakeAddressCmd pStakeAddressCmd = @@ -3307,9 +3310,6 @@ readRational = (toRational <$> readerFromAttoParser Atto.scientific) <|> readFractionAsRational -readerJSON :: Opt.ReadM Aeson.Value -readerJSON = readerFromAttoParser Aeson.Parser.json - readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a readerFromAttoParser p = Opt.eitherReader (Atto.parseOnly (p <* Atto.endOfInput) . BSC.pack) @@ -3318,8 +3318,6 @@ readerFromParsecParser :: Parsec.Parser a -> Opt.ReadM a readerFromParsecParser p = Opt.eitherReader (first formatError . Parsec.parse (p <* Parsec.eof) "") where - --TODO: the default parsec error formatting is quite good, but we could - -- customise it somewhat: formatError err = Parsec.showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs index 456bb0abb4c..76c6572dcad 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs @@ -310,6 +310,7 @@ data ScriptDataError = | ScriptDataErrorConversion !FilePath !ScriptDataJsonError | ScriptDataErrorValidation !FilePath !ScriptDataRangeError | ScriptDataErrorMetadataDecode !FilePath !CBOR.DecoderError + | ScriptDataErrorJsonBytes !ScriptDataJsonBytesError renderScriptDataError :: ScriptDataError -> Text renderScriptDataError (ScriptDataErrorFile err) = @@ -326,6 +327,9 @@ renderScriptDataError (ScriptDataErrorValidation fp sDataRangeErr) = renderScriptDataError (ScriptDataErrorMetadataDecode fp decoderErr) = Text.pack $ "Error decoding CBOR metadata at: " <> show fp <> " Error: " <> show decoderErr +renderScriptDataError (ScriptDataErrorJsonBytes e) = + Text.pack $ displayError e + readScriptDatumOrFile :: ScriptDatumOrFile witctx -> ExceptT ScriptDataError IO (ScriptDatum witctx) @@ -340,25 +344,22 @@ readScriptRedeemerOrFile :: ScriptRedeemerOrFile readScriptRedeemerOrFile = readScriptDataOrFile readScriptDataOrFile :: ScriptDataOrFile - -> ExceptT ScriptDataError IO ScriptData + -> ExceptT ScriptDataError IO HashableScriptData readScriptDataOrFile (ScriptDataValue d) = return d readScriptDataOrFile (ScriptDataJsonFile fp) = do - bs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) $ LBS.readFile fp - v <- firstExceptT (ScriptDataErrorJsonParse fp) - $ hoistEither $ Aeson.eitherDecode' bs - sd <- firstExceptT (ScriptDataErrorConversion fp) - $ hoistEither $ scriptDataFromJson ScriptDataJsonDetailedSchema v - firstExceptT (ScriptDataErrorValidation fp) - $ hoistEither $ validateScriptData sd - return sd + sDataBs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) $ LBS.readFile fp + sDataValue <- hoistEither . first (ScriptDataErrorJsonParse fp) $ Aeson.eitherDecode sDataBs + hoistEither + . first ScriptDataErrorJsonBytes + $ scriptDataJsonToHashable ScriptDataJsonNoSchema sDataValue + readScriptDataOrFile (ScriptDataCborFile fp) = do - bs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) - $ BS.readFile fp - sd <- firstExceptT (ScriptDataErrorMetadataDecode fp) - $ hoistEither $ deserialiseFromCBOR AsScriptData bs + origBs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) (BS.readFile fp) + hSd <- firstExceptT (ScriptDataErrorMetadataDecode fp) + $ hoistEither $ deserialiseFromCBOR AsHashableScriptData origBs firstExceptT (ScriptDataErrorValidation fp) - $ hoistEither $ validateScriptData sd - return sd + $ hoistEither $ validateScriptData $ getScriptData hSd + return hSd -- diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index f08ca6d043d..a12df58b1d7 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -950,7 +950,7 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do TxOutDatumByHashOf fileOrSdata -> do sData <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile fileOrSdata - pure (TxOutDatumHash sDataSupp $ hashScriptData sData, refScript) + pure (TxOutDatumHash sDataSupp $ hashScriptDataBytes sData, refScript) TxOutDatumByValue fileOrSdata -> do sData <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile fileOrSdata @@ -970,7 +970,7 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do TxOutDatumByHashOf sDataOrFile -> do sData <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumHash supp $ hashScriptData sData) + pure (TxOutDatumHash supp $ hashScriptDataBytes sData) TxOutDatumByValue sDataOrFile -> do sData <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile sDataOrFile @@ -1312,7 +1312,7 @@ mkShelleyBootstrapWitnesses mnw txBody = runTxHashScriptData :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO () runTxHashScriptData scriptDataOrFile = do d <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile scriptDataOrFile - liftIO $ BS.putStrLn $ serialiseToRawBytesHex (hashScriptData d) + liftIO $ BS.putStrLn $ serialiseToRawBytesHex (hashScriptDataBytes d) runTxGetTxId :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () runTxGetTxId txfile = do diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs index 0ad3f7830c3..ed83461bc4e 100644 --- a/cardano-cli/src/Cardano/CLI/Types.hs +++ b/cardano-cli/src/Cardano/CLI/Types.hs @@ -50,8 +50,8 @@ import Data.Word (Word64) import qualified Cardano.Chain.Slotting as Byron import Cardano.Api (AddressAny, AnyScriptLanguage, EpochNo, ExecutionUnits, Hash, - PaymentKey, PolicyId, ScriptData, SlotNo (SlotNo), TxId, TxIn, Value, WitCtxMint, - WitCtxStake, WitCtxTxIn) + HashableScriptData, PaymentKey, PolicyId, ScriptData, SlotNo (SlotNo), TxId, + TxIn, Value, WitCtxMint, WitCtxStake, WitCtxTxIn) import qualified Cardano.Ledger.Crypto as Crypto @@ -223,7 +223,7 @@ newtype ScriptFile = ScriptFile { unScriptFile :: FilePath } data ScriptDataOrFile = ScriptDataCborFile FilePath -- ^ By reference to a CBOR file | ScriptDataJsonFile FilePath -- ^ By reference to a JSON file - | ScriptDataValue ScriptData -- ^ By value + | ScriptDataValue HashableScriptData -- ^ By value deriving (Eq, Show) type ScriptRedeemerOrFile = ScriptDataOrFile