Skip to content

Commit 0350341

Browse files
Jimbo4350Jimbo4350
committed
WIP
1 parent 7074c45 commit 0350341

File tree

14 files changed

+201
-112
lines changed

14 files changed

+201
-112
lines changed

‎cardano-api/cardano-api.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -196,9 +196,9 @@ library gen
196196
, cardano-ledger-alonzo-test
197197
, cardano-ledger-byron-test ^>= 1.4
198198
, cardano-ledger-core ^>= 0.1
199+
, cardano-ledger-shelley ^>= 0.1
199200
, containers
200201
, hedgehog
201-
, cardano-ledger-shelley ^>= 0.1
202202
, text
203203

204204
test-suite cardano-api-test

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

+17-5
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ module Test.Gen.Cardano.Api.Typed
2727
, genUTxO
2828

2929
-- * Scripts
30+
, genHashableScriptData
3031
, genReferenceScript
3132
, genScript
3233
, genSimpleScript
@@ -109,13 +110,14 @@ import Cardano.Api hiding (txIns)
109110
import qualified Cardano.Api as Api
110111
import Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
111112
WitnessNetworkIdOrByronAddress (..))
112-
import Cardano.Api.Shelley (Hash (ScriptDataHash), KESPeriod (KESPeriod),
113+
import Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod),
113114
OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
114115
PlutusScript (PlutusScriptSerialised), ProtocolParameters (ProtocolParameters),
115116
ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
116117
StakeCredential (StakeCredentialByKey), StakePoolKey,
117118
refInsScriptsAndInlineDatsSupportedInEra)
118119

120+
119121
import Data.ByteString (ByteString)
120122
import qualified Data.ByteString as BS
121123
import qualified Data.ByteString.Short as SBS
@@ -220,6 +222,16 @@ genPlutusScript _ =
220222
-- We make no attempt to create a valid script
221223
PlutusScriptSerialised . SBS.toShort <$> Gen.bytes (Range.linear 0 32)
222224

225+
226+
genHashableScriptData :: Gen HashableScriptData
227+
genHashableScriptData = do
228+
sd <- genScriptData
229+
case deserialiseFromCBOR AsHashableScriptData $ serialiseToCBOR sd of
230+
Left e -> error $ "genHashableScriptData: " <> show e
231+
Right r -> return r
232+
233+
234+
{-# DEPRECATED genScriptData "Use genHashableScriptData" #-}
223235
genScriptData :: Gen ScriptData
224236
genScriptData =
225237
Gen.recursive
@@ -891,13 +903,13 @@ genTxOutDatumHashTxContext era = case era of
891903
AlonzoEra -> Gen.choice
892904
[ pure TxOutDatumNone
893905
, TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData
894-
, TxOutDatumInTx ScriptDataInAlonzoEra <$> genScriptData
906+
, TxOutDatumInTx ScriptDataInAlonzoEra <$> genHashableScriptData
895907
]
896908
BabbageEra -> Gen.choice
897909
[ pure TxOutDatumNone
898910
, TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
899-
, TxOutDatumInTx ScriptDataInBabbageEra <$> genScriptData
900-
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
911+
, TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData
912+
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
901913
]
902914

903915
genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era)
@@ -913,7 +925,7 @@ genTxOutDatumHashUTxOContext era = case era of
913925
BabbageEra -> Gen.choice
914926
[ pure TxOutDatumNone
915927
, TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
916-
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genScriptData
928+
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
917929
]
918930

919931
mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a

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

+6
Original file line numberDiff line numberDiff line change
@@ -399,6 +399,10 @@ module Cardano.Api (
399399
examplePlutusScriptAlwaysFails,
400400

401401
-- ** Script data
402+
HashableScriptData,
403+
hashScriptDataBytes,
404+
getOriginalScriptDataBytes,
405+
getScriptData,
402406
ScriptData(..),
403407
hashScriptData,
404408

@@ -412,6 +416,8 @@ module Cardano.Api (
412416
scriptDataToJson,
413417
ScriptDataJsonError (..),
414418
ScriptDataJsonSchemaError (..),
419+
ScriptDataJsonBytesError,
420+
scriptDataJsonToHashable,
415421

416422
-- ** Script execution units
417423
ExecutionUnits(..),

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

+5-5
Original file line numberDiff line numberDiff line change
@@ -792,13 +792,13 @@ instance Eq (ScriptWitness witctx era) where
792792

793793
(==) _ _ = False
794794

795-
type ScriptRedeemer = ScriptData
795+
type ScriptRedeemer = HashableScriptData
796796

797797
data ScriptDatum witctx where
798-
ScriptDatumForTxIn :: ScriptData -> ScriptDatum WitCtxTxIn
799-
InlineScriptDatum :: ScriptDatum WitCtxTxIn
800-
NoScriptDatumForMint :: ScriptDatum WitCtxMint
801-
NoScriptDatumForStake :: ScriptDatum WitCtxStake
798+
ScriptDatumForTxIn :: HashableScriptData -> ScriptDatum WitCtxTxIn
799+
InlineScriptDatum :: ScriptDatum WitCtxTxIn
800+
NoScriptDatumForMint :: ScriptDatum WitCtxMint
801+
NoScriptDatumForStake :: ScriptDatum WitCtxStake
802802

803803
deriving instance Eq (ScriptDatum witctx)
804804
deriving instance Show (ScriptDatum witctx)

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

+97-24
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,16 @@
11
{-# LANGUAGE DerivingVia #-}
22
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE InstanceSigs #-}
34
{-# LANGUAGE ScopedTypeVariables #-}
45
{-# LANGUAGE TypeApplications #-}
56
{-# LANGUAGE TypeFamilies #-}
67

78
module Cardano.Api.ScriptData (
89
-- * Script data
10+
HashableScriptData,
11+
hashScriptDataBytes,
12+
getOriginalScriptDataBytes,
13+
getScriptData,
914
ScriptData(..),
1015

1116
-- * Script data hashes
@@ -23,6 +28,9 @@ module Cardano.Api.ScriptData (
2328
ScriptDataJsonSchemaError (..),
2429
scriptDataFromJsonDetailedSchema,
2530
scriptDataToJsonDetailedSchema,
31+
ScriptBytesError(..),
32+
ScriptDataJsonBytesError(..),
33+
scriptDataJsonToHashable,
2634

2735
-- * Internal conversion functions
2836
toPlutusData,
@@ -35,11 +43,15 @@ module Cardano.Api.ScriptData (
3543
Hash(..),
3644
) where
3745

46+
import qualified Cardano.Binary as CBOR
47+
import Codec.Serialise.Class (Serialise (..))
3848
import Data.Bifunctor (first)
49+
import Data.ByteString (ByteString)
3950
import qualified Data.ByteString as BS
4051
import qualified Data.ByteString.Base16 as Base16
4152
import qualified Data.ByteString.Char8 as BSC
4253
import qualified Data.ByteString.Lazy.Char8 as LBS
54+
import qualified Data.ByteString.Short as SB
4355
import qualified Data.Char as Char
4456
import Data.Either.Combinators
4557
import qualified Data.List as List
@@ -77,14 +89,35 @@ import Cardano.Api.Keys.Shelley
7789
import Cardano.Api.SerialiseCBOR
7890
import Cardano.Api.SerialiseJSON
7991
import Cardano.Api.SerialiseRaw
80-
import qualified Cardano.Binary as CBOR
81-
8292
import Cardano.Api.SerialiseUsing
8393
import Cardano.Api.TxMetadata (pBytes, pSigned, parseAll)
84-
import Codec.Serialise.Class (Serialise (..))
94+
95+
-- Original script data bytes
96+
data HashableScriptData
97+
= HashableScriptData
98+
!BS.ByteString -- ^ Original 'ScriptData' bytes
99+
!ScriptData
100+
deriving (Eq, Show)
101+
102+
instance HasTypeProxy HashableScriptData where
103+
data AsType HashableScriptData = AsHashableScriptData
104+
proxyToAsType _ = AsHashableScriptData
105+
106+
instance SerialiseAsCBOR HashableScriptData where
107+
serialiseToCBOR (HashableScriptData _ sd) = CBOR.serialize' sd
108+
deserialiseFromCBOR AsHashableScriptData bs =
109+
HashableScriptData bs
110+
<$> CBOR.decodeFullDecoder "ScriptData" fromCBOR (LBS.fromStrict bs)
111+
112+
113+
getOriginalScriptDataBytes :: HashableScriptData -> BS.ByteString
114+
getOriginalScriptDataBytes (HashableScriptData bs _) = bs
115+
116+
getScriptData :: HashableScriptData -> ScriptData
117+
getScriptData (HashableScriptData _ sd) = sd
85118

86119
-- ----------------------------------------------------------------------------
87-
-- Script data
120+
-- Script data - Only used for rendering
88121
--
89122

90123
data ScriptData = ScriptDataConstructor
@@ -131,24 +164,41 @@ instance ToCBOR ScriptData where
131164
toCBOR = encode @Plutus.Data . toPlutusData
132165

133166
instance FromCBOR ScriptData where
167+
fromCBOR :: CBOR.Decoder s ScriptData
134168
fromCBOR = fromPlutusData <$> decode @Plutus.Data
135169

136-
hashScriptData :: ScriptData -> Hash ScriptData
137-
hashScriptData = ScriptDataHash
138-
. Alonzo.hashData
139-
. (toAlonzoData :: ScriptData -> Alonzo.Data StandardAlonzo)
170+
hashScriptDataBytes :: HashableScriptData -> Hash ScriptData
171+
hashScriptDataBytes =
172+
(ScriptDataHash . Alonzo.hashData) . (toAlonzoData :: HashableScriptData -> Alonzo.Data StandardAlonzo)
140173

174+
{-# DEPRECATED hashScriptData "Use hashScriptDataBytes" #-}
175+
hashScriptData :: HashableScriptData -> Hash ScriptData
176+
hashScriptData = hashScriptDataBytes
141177

142178
-- ----------------------------------------------------------------------------
143179
-- Conversion functions
144180
--
145181

146-
toAlonzoData :: ScriptData -> Alonzo.Data ledgerera
147-
toAlonzoData = Alonzo.Data . toPlutusData
182+
newtype ScriptBytesError = ScriptBytesError String deriving Show
183+
184+
-- There is a subtlety here. We must use the original bytes
185+
-- when converting to and from `HashableScriptData`/`Data`. This
186+
-- avoids problems that arise due to reserialization of the script
187+
-- data i.e differing script data hashes due to the re-encoding being slightly
188+
-- different to the original encoding. See: https://github.com/input-output-hk/cardano-ledger/issues/2943
148189

149-
fromAlonzoData :: Alonzo.Data ledgerera -> ScriptData
150-
fromAlonzoData = fromPlutusData . Alonzo.getPlutusData
190+
toAlonzoData :: HashableScriptData -> Alonzo.Data ledgerera
191+
toAlonzoData =
192+
either
193+
(\ e -> error $ "toAlonzoData: " <> show e)
194+
Alonzo.binaryDataToData
195+
. first ScriptBytesError . Alonzo.makeBinaryData . SB.toShort . getOriginalScriptDataBytes
151196

197+
fromAlonzoData :: Alonzo.Data ledgerera -> HashableScriptData
198+
fromAlonzoData d =
199+
HashableScriptData
200+
(Ledger.originalBytes d)
201+
(fromPlutusData $ Alonzo.getPlutusData d)
152202

153203
toPlutusData :: ScriptData -> Plutus.Data
154204
toPlutusData (ScriptDataConstructor int xs)
@@ -327,10 +377,10 @@ data ScriptDataJsonSchema =
327377
--
328378
scriptDataFromJson :: ScriptDataJsonSchema
329379
-> Aeson.Value
330-
-> Either ScriptDataJsonError ScriptData
380+
-> Either ScriptDataJsonError HashableScriptData
331381
scriptDataFromJson schema v = do
332382
d <- first (ScriptDataJsonSchemaError v) (scriptDataFromJson' v)
333-
first (ScriptDataRangeError v) (validateScriptData d)
383+
first (ScriptDataRangeError v) (validateScriptData $ getScriptData d)
334384
return d
335385
where
336386
scriptDataFromJson' =
@@ -347,7 +397,7 @@ scriptDataFromJson schema v = do
347397
-- See 'ScriptDataJsonSchema' for the details.
348398
--
349399
scriptDataToJson :: ScriptDataJsonSchema
350-
-> ScriptData
400+
-> HashableScriptData
351401
-> Aeson.Value
352402
scriptDataToJson schema =
353403
case schema of
@@ -359,8 +409,8 @@ scriptDataToJson schema =
359409
-- JSON conversion using the the "no schema" style
360410
--
361411

362-
scriptDataToJsonNoSchema :: ScriptData -> Aeson.Value
363-
scriptDataToJsonNoSchema = conv
412+
scriptDataToJsonNoSchema :: HashableScriptData -> Aeson.Value
413+
scriptDataToJsonNoSchema = conv . getScriptData
364414
where
365415
conv :: ScriptData -> Aeson.Value
366416
conv (ScriptDataNumber n) = Aeson.Number (fromInteger n)
@@ -400,8 +450,8 @@ scriptDataToJsonNoSchema = conv
400450

401451
scriptDataFromJsonNoSchema :: Aeson.Value
402452
-> Either ScriptDataJsonSchemaError
403-
ScriptData
404-
scriptDataFromJsonNoSchema = conv
453+
HashableScriptData
454+
scriptDataFromJsonNoSchema = fmap (\sd -> HashableScriptData (serialiseToCBOR sd) sd) . conv
405455
where
406456
conv :: Aeson.Value
407457
-> Either ScriptDataJsonSchemaError ScriptData
@@ -445,14 +495,37 @@ scriptDataFromJsonNoSchema = conv
445495
-- be encoded as CBOR bytestrings.
446496
bytesPrefix :: Text
447497
bytesPrefix = "0x"
448-
498+
data ScriptDataJsonBytesError
499+
= ScriptDataJsonBytesErrorAesonDecode String
500+
| ScriptDataJsonBytesErrorValue ScriptDataJsonError
501+
| ScriptDataJsonBytesErrorInvalid ScriptDataRangeError
502+
deriving Show
503+
instance Error ScriptDataJsonBytesError where
504+
displayError (ScriptDataJsonBytesErrorAesonDecode e) =
505+
"Error decoding ScriptData JSON bytes: " <> e
506+
displayError (ScriptDataJsonBytesErrorValue e) =
507+
"Error decoding ScriptData JSON value: " <> show e
508+
displayError (ScriptDataJsonBytesErrorInvalid e) =
509+
"ScriptData is invalid: " <> show e
510+
511+
-- | This allows us to take JSON formatted ScriptData and encode it in the CDDL format
512+
-- whilst preserving the original bytes.
513+
scriptDataJsonToHashable
514+
:: ScriptDataJsonSchema
515+
-> ByteString -- ^ JSON encoded ScriptData
516+
-> Either ScriptDataJsonBytesError HashableScriptData
517+
scriptDataJsonToHashable schema jsonScriptDataBytes = do
518+
scriptDataVal <- first ScriptDataJsonBytesErrorAesonDecode $ Aeson.eitherDecode' $ LBS.fromStrict jsonScriptDataBytes
519+
sData <- first ScriptDataJsonBytesErrorValue $ scriptDataFromJson schema scriptDataVal
520+
first ScriptDataJsonBytesErrorInvalid $ validateScriptData $ getScriptData sData
521+
return sData
449522

450523
-- ----------------------------------------------------------------------------
451524
-- JSON conversion using the "detailed schema" style
452525
--
453526

454-
scriptDataToJsonDetailedSchema :: ScriptData -> Aeson.Value
455-
scriptDataToJsonDetailedSchema = conv
527+
scriptDataToJsonDetailedSchema :: HashableScriptData -> Aeson.Value
528+
scriptDataToJsonDetailedSchema = conv . getScriptData
456529
where
457530
conv :: ScriptData -> Aeson.Value
458531
conv (ScriptDataNumber n) = singleFieldObject "int"
@@ -481,8 +554,8 @@ scriptDataToJsonDetailedSchema = conv
481554

482555
scriptDataFromJsonDetailedSchema :: Aeson.Value
483556
-> Either ScriptDataJsonSchemaError
484-
ScriptData
485-
scriptDataFromJsonDetailedSchema = conv
557+
HashableScriptData
558+
scriptDataFromJsonDetailedSchema = fmap (\sd -> HashableScriptData (serialiseToCBOR sd) sd) . conv
486559
where
487560
conv :: Aeson.Value
488561
-> Either ScriptDataJsonSchemaError ScriptData

0 commit comments

Comments
 (0)