Merge branch 'master' of github.com:input-output-hk/cardano-ledger-sp…

…ecs into event-logger

alonzo/impl/src/Cardano/Ledger/Alonzo.hs

@@ -22,7 +22,7 @@ module Cardano.Ledger.Alonzo
   )
 where
 
-import Cardano.Ledger.Alonzo.Data (AuxiliaryData (..), getPlutusData)
+import Cardano.Ledger.Alonzo.Data (AuxiliaryData (..))
 import Cardano.Ledger.Alonzo.Genesis
 import Cardano.Ledger.Alonzo.PParams
   ( PParams,
@@ -40,7 +40,7 @@ import qualified Cardano.Ledger.Alonzo.Rules.Utxow as Alonzo (AlonzoUTXOW)
 import Cardano.Ledger.Alonzo.Scripts (Script (..), isPlutusScript)
 import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..))
 import Cardano.Ledger.Alonzo.TxBody (TxBody, TxOut (..))
-import Cardano.Ledger.Alonzo.TxInfo (validPlutusdata, validScript)
+import Cardano.Ledger.Alonzo.TxInfo (validScript)
 import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq (..), hashTxSeq)
 import Cardano.Ledger.Alonzo.TxWitness (TxWitness)
 import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..), ValidateAuxiliaryData (..))
@@ -236,10 +236,9 @@ instance (CC.Crypto c) => UsesPParams (AlonzoEra c) where
 
 instance CC.Crypto c => ValidateAuxiliaryData (AlonzoEra c) c where
   hashAuxiliaryData x = AuxiliaryDataHash (hashAnnotated x)
-  validateAuxiliaryData (AuxiliaryData metadata scrips plutusdata) =
+  validateAuxiliaryData (AuxiliaryData metadata scrips) =
     all validMetadatum metadata
       && all validScript scrips
-      && all (validPlutusdata . getPlutusData) plutusdata
 
 instance CC.Crypto c => EraModule.SupportsSegWit (AlonzoEra c) where
   type TxSeq (AlonzoEra c) = Alonzo.TxSeq (AlonzoEra c)

alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs

@@ -26,7 +26,7 @@ module Cardano.Ledger.Alonzo.Data
     getPlutusData,
     dataHashSize,
     -- $
-    AuxiliaryData (AuxiliaryData, scripts, dats, txMD),
+    AuxiliaryData (AuxiliaryData, scripts, txMD),
     AuxiliaryDataHash (..),
     -- $
     ppPlutusData,
@@ -58,7 +58,6 @@ import Cardano.Ledger.Pretty
     ppMap,
     ppMetadatum,
     ppPair,
-    ppSet,
     ppSexp,
     ppStrictSeq,
     ppWord64,
@@ -82,8 +81,6 @@ import Data.Maybe (mapMaybe)
 import Data.MemoBytes (Mem, MemoBytes (..), memoBytes)
 import Data.Sequence.Strict (StrictSeq)
 import qualified Data.Sequence.Strict as StrictSeq
-import Data.Set (Set)
-import qualified Data.Set as Set
 import Data.Typeable (Typeable)
 import Data.Word (Word64)
 import GHC.Generics (Generic)
@@ -150,8 +147,7 @@ instance (CC.Crypto c) => HeapWords (StrictMaybe (DataHash c)) where
 
 data AuxiliaryDataRaw era = AuxiliaryDataRaw
   { txMD' :: !(Map Word64 Metadatum),
-    scripts' :: !(StrictSeq (Core.Script era)),
-    dats' :: !(Set (Data era))
+    scripts' :: !(StrictSeq (Core.Script era))
   }
   deriving (Generic)
 
@@ -170,26 +166,23 @@ instance
   ) =>
   ToCBOR (AuxiliaryDataRaw era)
   where
-  toCBOR (AuxiliaryDataRaw s d m) =
-    encode (encodeRaw s d m)
+  toCBOR (AuxiliaryDataRaw m s) =
+    encode (encodeRaw m s)
 
 encodeRaw ::
   ( Core.Script era ~ Script era,
-    Typeable (Crypto era),
-    Typeable era
+    Typeable (Crypto era)
   ) =>
   Map Word64 Metadatum ->
   StrictSeq (Core.Script era) ->
-  Set (Data era) ->
   Encode ('Closed 'Sparse) (AuxiliaryDataRaw era)
-encodeRaw metadata allScripts dataSet =
+encodeRaw metadata allScripts =
   ( Tag 259 $
       Keyed
-        (\m tss pss d -> AuxiliaryDataRaw m (StrictSeq.fromList $ tss <> pss) d)
+        (\m tss pss -> AuxiliaryDataRaw m (StrictSeq.fromList $ tss <> pss))
         !> Omit null (Key 0 $ mapEncode metadata)
         !> Omit null (Key 1 $ E (encodeFoldable . mapMaybe getTimelock) timelocks)
         !> Omit null (Key 2 $ E (encodeFoldable . mapMaybe getPlutus) plutusScripts)
-        !> Omit null (Key 3 $ setEncode dataSet)
   )
   where
     getTimelock (TimelockScript x) = Just x
@@ -226,7 +219,6 @@ instance
           ( Ann (Emit AuxiliaryDataRaw)
               <*! Ann (D mapFromCBOR)
               <*! Ann (Emit StrictSeq.empty)
-              <*! Ann (Emit Set.empty)
           )
       decodeShelleyMA =
         decode
@@ -237,7 +229,6 @@ instance
                         <$> decodeStrictSeq
                           (fmap TimelockScript <$> fromCBOR)
                   )
-              <*! Ann (Emit Set.empty)
           )
       decodeAlonzo =
         decode $
@@ -254,14 +245,10 @@ instance
         fieldA
           (\x ad -> ad {scripts' = scripts' ad <> (PlutusScript <$> x)})
           (D (decodeStrictSeq fromCBOR))
-      auxDataField 3 =
-        fieldAA
-          (\x ad -> ad {dats' = x})
-          (setDecodeA From)
       auxDataField n = field (\_ t -> t) (Invalid n)
 
 emptyAuxData :: AuxiliaryDataRaw era
-emptyAuxData = AuxiliaryDataRaw mempty mempty mempty
+emptyAuxData = AuxiliaryDataRaw mempty mempty
 
 -- ================================================================================
 -- Version with serialized bytes.
@@ -295,15 +282,14 @@ pattern AuxiliaryData ::
   ) =>
   Map Word64 Metadatum ->
   StrictSeq (Core.Script era) ->
-  Set (Data era) ->
   AuxiliaryData era
-pattern AuxiliaryData {txMD, scripts, dats} <-
-  AuxiliaryDataConstr (Memo (AuxiliaryDataRaw txMD scripts dats) _)
+pattern AuxiliaryData {txMD, scripts} <-
+  AuxiliaryDataConstr (Memo (AuxiliaryDataRaw txMD scripts) _)
   where
-    AuxiliaryData m s d =
+    AuxiliaryData m s =
       AuxiliaryDataConstr
         ( memoBytes
-            (encodeRaw m s d)
+            (encodeRaw m s)
         )
 
 {-# COMPLETE AuxiliaryData #-}
@@ -325,7 +311,7 @@ ppData (DataConstr (Memo x _)) = ppSexp "Data" [ppPlutusData x]
 instance PrettyA (Data era) where prettyA = ppData
 
 ppAuxiliaryData :: (PrettyA (Core.Script era)) => AuxiliaryData era -> PDoc
-ppAuxiliaryData (AuxiliaryDataConstr (Memo (AuxiliaryDataRaw m s d) _)) =
-  ppSexp "AuxiliaryData" [ppMap ppWord64 ppMetadatum m, ppStrictSeq prettyA s, ppSet ppData d]
+ppAuxiliaryData (AuxiliaryDataConstr (Memo (AuxiliaryDataRaw m s) _)) =
+  ppSexp "AuxiliaryData" [ppMap ppWord64 ppMetadatum m, ppStrictSeq prettyA s]
 
 instance (PrettyA (Core.Script era)) => PrettyA (AuxiliaryData era) where prettyA = ppAuxiliaryData

alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs

@@ -37,7 +37,7 @@ import Cardano.Ledger.Alonzo.Tx
   )
 import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo (TxBody (..), TxOut (..), vldt')
 import Cardano.Ledger.Alonzo.TxInfo (runPLCScript, txInfo, valContext)
-import Cardano.Ledger.Alonzo.TxWitness (TxWitness (txwitsVKey'), txscripts')
+import Cardano.Ledger.Alonzo.TxWitness (TxWitness (txwitsVKey'), txscripts', unTxDats)
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
@@ -99,7 +99,7 @@ getData tx (UTxO m) sp = case sp of
         case getField @"datahash" txout of
           SNothing -> []
           SJust hash ->
-            case Map.lookup hash (txdats' (getField @"wits" tx)) of
+            case Map.lookup hash (unTxDats $ txdats' (getField @"wits" tx)) of
               Nothing -> []
               Just d -> [d]
 

alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs

@@ -33,7 +33,7 @@ import Cardano.Ledger.Alonzo.Tx
     isTwoPhaseScriptAddress,
   )
 import Cardano.Ledger.Alonzo.TxBody (WitnessPPDataHash)
-import Cardano.Ledger.Alonzo.TxWitness (TxWitness (..))
+import Cardano.Ledger.Alonzo.TxWitness (TxWitness (..), unTxDats)
 import Cardano.Ledger.BaseTypes
   ( ShelleyBase,
     StrictMaybe (..),
@@ -95,11 +95,8 @@ import Shelley.Spec.Ledger.UTxO (UTxO, txinLookup)
 data AlonzoPredFail era
   = WrappedShelleyEraFailure !(UtxowPredicateFailure era)
   | UnRedeemableScripts ![(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-  | DataHashSetsDontAgree
+  | MissingRequiredDatums
       !(Set (DataHash (Crypto era)))
-      -- ^ from the Tx
-      !(Set (DataHash (Crypto era)))
-      -- ^ from the UTxO restricted to the Tx inputs
   | PPViewHashesDontMatch
       !(StrictMaybe (WitnessPPDataHash (Crypto era)))
       -- ^ The PPHash in the TxBody
@@ -151,7 +148,7 @@ encodePredFail ::
   Encode 'Open (AlonzoPredFail era)
 encodePredFail (WrappedShelleyEraFailure x) = Sum WrappedShelleyEraFailure 0 !> E toCBOR x
 encodePredFail (UnRedeemableScripts x) = Sum UnRedeemableScripts 1 !> To x
-encodePredFail (DataHashSetsDontAgree x y) = Sum DataHashSetsDontAgree 2 !> To x !> To y
+encodePredFail (MissingRequiredDatums x) = Sum MissingRequiredDatums 2 !> To x
 encodePredFail (PPViewHashesDontMatch x y) = Sum PPViewHashesDontMatch 3 !> To x !> To y
 encodePredFail (MissingRequiredSigners x) = Sum MissingRequiredSigners 4 !> To x
 encodePredFail (UnspendableUTxONoDatumHash x) = Sum UnspendableUTxONoDatumHash 5 !> To x
@@ -176,7 +173,7 @@ decodePredFail ::
   Decode 'Open (AlonzoPredFail era)
 decodePredFail 0 = SumD WrappedShelleyEraFailure <! D fromCBOR
 decodePredFail 1 = SumD UnRedeemableScripts <! From
-decodePredFail 2 = SumD DataHashSetsDontAgree <! From <! From
+decodePredFail 2 = SumD MissingRequiredDatums <! From
 decodePredFail 3 = SumD PPViewHashesDontMatch <! From <! From
 decodePredFail 4 = SumD MissingRequiredSigners <! From
 decodePredFail 5 = SumD UnspendableUTxONoDatumHash <! From
@@ -264,9 +261,10 @@ alonzoStyleWitness = do
             isTwoPhaseScriptAddress @era tx (getField @"address" output)
         ]
     SJust utxoHashes -> do
-      let txHashes = domain (txdats . wits $ tx)
+      let txHashes = domain (unTxDats . txdats . wits $ tx)
           inputHashes = Set.fromList utxoHashes
-      txHashes == inputHashes ?! DataHashSetsDontAgree txHashes inputHashes
+          unmatchedInputHashes = eval (inputHashes ➖ txHashes)
+      Set.null unmatchedInputHashes ?! MissingRequiredDatums unmatchedInputHashes
 
   {-  ∀ sph ∈ scriptsNeeded utxo tx, checkScriptData tx utxo  ph  -}
   let sphs :: [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
@@ -289,7 +287,7 @@ alonzoStyleWitness = do
             (not . isNativeScript @era) script,
             Just l <- [language @era script]
         ]
-      computedPPhash = hashWitnessPPData pp (Set.fromList languages) (txrdmrs . wits $ tx)
+      computedPPhash = hashWitnessPPData pp (Set.fromList languages) (txrdmrs . wits $ tx) (txdats . wits $ tx)
       bodyPPhash = getField @"wppHash" txbody
   bodyPPhash == computedPPhash ?! PPViewHashesDontMatch bodyPPhash computedPPhash
 

alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs

@@ -72,6 +72,7 @@ import Cardano.Binary
   ( FromCBOR (..),
     ToCBOR (toCBOR),
     encodeListLen,
+    serialize',
     serializeEncoding,
   )
 import Cardano.Ledger.Alonzo.Data (Data, DataHash, hashData)
@@ -93,10 +94,13 @@ import Cardano.Ledger.Alonzo.TxBody
 import Cardano.Ledger.Alonzo.TxWitness
   ( RdmrPtr (..),
     Redeemers (..),
+    TxDats (..),
     TxWitness (..),
+    nullDats,
     ppTxWitness,
     txrdmrs,
     unRedeemers,
+    unTxDats,
   )
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Compactible
@@ -114,7 +118,7 @@ import Cardano.Ledger.Pretty
   )
 import Cardano.Ledger.SafeHash
   ( HashAnnotated,
-    SafeToHash,
+    SafeToHash (..),
     hashAnnotated,
   )
 import Cardano.Ledger.Val (Val (coin, (<+>), (<×>)))
@@ -127,7 +131,6 @@ import Data.Maybe.Strict
     maybeToStrictMaybe,
     strictMaybeToMaybe,
   )
-import Data.MemoBytes (Mem, MemoBytes (Memo), memoBytes)
 import Data.Sequence.Strict (StrictSeq)
 import qualified Data.Sequence.Strict as StrictSeq
 import Data.Set (Set)
@@ -219,7 +222,7 @@ instance
   c ~ Crypto era =>
   HasField "txdatahash" (ValidatedTx era) (Map.Map (DataHash c) (Data era))
   where
-  getField = txdats' . wits
+  getField = unTxDats . txdats' . wits
 
 -- =========================================================
 -- Figure 2: Definitions for Transactions
@@ -233,62 +236,41 @@ getCoin txout = coin (getField @"value" txout)
 -- In order to hash 2 things we make a newtype WitnessPPData which will be
 -- a MemoBytes of these two things (WitnessPPDataRaw), so that we can hash it.
 
-data WitnessPPDataRaw era
-  = WitnessPPDataRaw
+data WitnessPPData era
+  = WitnessPPData
       !(Redeemers era) -- From the witnesses
+      !(TxDats era)
       !(Set (LangDepView era)) -- From the Porotocl parameters
   deriving (Show, Eq, Generic, Typeable)
 
-deriving instance Typeable era => NoThunks (WitnessPPDataRaw era)
+deriving instance Typeable era => NoThunks (WitnessPPData era)
 
-instance Era era => ToCBOR (WitnessPPDataRaw era) where
-  toCBOR (WitnessPPDataRaw m s) = encode (Rec WitnessPPDataRaw !> To m !> To s)
+-- WitnessPPData is not transmitted over the network. The bytes are independently
+-- reconstructed by all nodes. There are no original bytes to preserve.
+-- Instead, we must use a reproducable serialization
+instance Era era => SafeToHash (WitnessPPData era) where
+  originalBytes (WitnessPPData m d l) =
+    -- TODO: double check that canonical encodings are used for the langDepView (l)
+    if nullDats d
+      then originalBytes m <> serialize' l
+      else originalBytes m <> originalBytes d <> serialize' l
 
-instance Era era => FromCBOR (Annotator (WitnessPPDataRaw era)) where
-  fromCBOR =
-    decode
-      ( Ann (RecD WitnessPPDataRaw)
-          <*! From
-          <*! setDecodeA (Ann From)
-      )
-
-newtype WitnessPPData era = WitnessPPDataConstr (MemoBytes (WitnessPPDataRaw era))
-  deriving (Show, Eq)
-  deriving newtype (ToCBOR, SafeToHash)
-
-deriving via
-  (Mem (WitnessPPDataRaw era))
-  instance
-    Era era => FromCBOR (Annotator (WitnessPPData era))
-
-pattern WitnessPPData ::
-  Era era =>
-  Redeemers era ->
-  Set (LangDepView era) ->
-  WitnessPPData era
-pattern WitnessPPData r s <-
-  WitnessPPDataConstr (Memo (WitnessPPDataRaw r s) _)
-  where
-    WitnessPPData r s =
-      WitnessPPDataConstr
-        . memoBytes
-        $ (Rec WitnessPPDataRaw !> To r !> setEncode s)
-
-instance (c ~ Crypto era) => HashAnnotated (WitnessPPData era) EraIndependentWitnessPPData c
+instance (Era era, c ~ Crypto era) => HashAnnotated (WitnessPPData era) EraIndependentWitnessPPData c
 
 hashWitnessPPData ::
   forall era.
   Era era =>
   PParams era ->
   Set Language ->
   Redeemers era ->
+  TxDats era ->
   StrictMaybe (WitnessPPDataHash (Crypto era))
-hashWitnessPPData pp langs rdmrs =
+hashWitnessPPData pp langs rdmrs dats =
   if (Map.null $ unRedeemers rdmrs) && Set.null langs
     then SNothing
     else
       let newset = mapLangSet (getLanguageView pp) langs
-       in SJust (hashAnnotated (WitnessPPData rdmrs newset))
+       in SJust (hashAnnotated (WitnessPPData rdmrs dats newset))
   where
     mapLangSet :: (Language -> LangDepView era) -> (Set Language -> Set (LangDepView era))
     mapLangSet f = Set.foldr (\x acc -> Set.insert (f x) acc) mempty

alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs

@@ -24,7 +24,7 @@ import Cardano.Ledger.Alonzo.TxBody
     wdrls',
   )
 import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo (TxBody (..), TxOut (..))
-import Cardano.Ledger.Alonzo.TxWitness (TxWitness)
+import Cardano.Ledger.Alonzo.TxWitness (TxWitness, unTxDats)
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core as Core (TxBody, TxOut, Value)
@@ -316,7 +316,7 @@ txInfo ei sysS utxo tx =
     fee = txfee' tbody
     forge = mint' tbody
     interval = vldt' tbody
-    datpairs = Map.toList (txdats' _witnesses)
+    datpairs = Map.toList (unTxDats $ txdats' _witnesses)
 
 -- ===============================================================
 -- From the specification, Figure 7 "Script Validation, cont."