Merge pull request #2215 from input-output-hk/jc/utxow-examples

Alonzo UTXOW examples

alonzo/impl/cardano-ledger-alonzo.cabal

@@ -72,6 +72,7 @@ library
     shelley-spec-ledger,
     small-steps,
     strict-containers,
+    text,
     transformers
   hs-source-dirs:
     src
@@ -90,7 +91,8 @@ library test
     plutus-tx,
     QuickCheck,
     shelley-spec-ledger-test,
-    shelley-spec-ledger
+    shelley-spec-ledger,
+    text,
   hs-source-dirs:
     test/lib
 
@@ -104,6 +106,7 @@ test-suite cardano-ledger-alonzo-test
   other-modules:
     Test.Cardano.Ledger.Alonzo.Golden
     Test.Cardano.Ledger.Alonzo.Serialisation.Tripping
+    Test.Cardano.Ledger.Alonzo.Examples.Utxow
     Test.Cardano.Ledger.Alonzo.Serialisation.CDDL
   build-depends:
     base16-bytestring,
@@ -114,8 +117,13 @@ test-suite cardano-ledger-alonzo-test
     cardano-ledger-core,
     cardano-ledger-shelley-ma-test,
     containers,
+    data-default-class,
+    plutus-core,
     plutus-tx,
+    plutus-ledger-api,
     QuickCheck,
+    small-steps,
+    small-steps-test,
     shelley-spec-ledger,
     shelley-spec-ledger-test,
     strict-containers,

alonzo/impl/cddl-files/alonzo.cddl

@@ -254,7 +254,7 @@ language = 0 ; Plutus v1
 
 costmdls = { * language => cost_model } ; New
 
-cost_model = { * bytes  => integer } ; New
+cost_model = { * text  => integer } ; New
 
 transaction_metadatum =
     { * transaction_metadatum => transaction_metadatum }

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

@@ -104,7 +104,8 @@ instance (CC.Crypto c) => Shelley.ValidateScript (AlonzoEra c) where
       timelock
     where
       vhks = Set.map witKeyHash (txwitsVKey' (wits' tx))
-  validateScript (PlutusScript _) _tx = False
+  -- TODO check if instead we should filter plutus scripts before calling
+  validateScript (PlutusScript _) _tx = True
 
 -- To run a PlutusScript use Cardano.Ledger.Alonzo.TxInfo(runPLCScript)
 -- To run any Alonzo Script use Cardano.Ledger.Alonzo.PlutusScriptApi(evalScripts)

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

@@ -188,7 +188,7 @@ data UtxoPredicateFailure era
   | -- | The UTxO entries which have the wrong kind of script
     ScriptsNotPaidUTxO
       !(UTxO era)
-  | ExUnitsTooSmallUTxO
+  | ExUnitsTooBigUTxO
       !ExUnits
       -- ^ Max EXUnits from the protocol parameters
       !ExUnits
@@ -371,7 +371,7 @@ utxoTransition = do
 
   let maxTxEx = getField @"_maxTxExUnits" pp
       totExunits = getField @"totExunits" tx
-  pointWiseExUnits (<=) totExunits maxTxEx ?! ExUnitsTooSmallUTxO maxTxEx totExunits
+  pointWiseExUnits (<=) totExunits maxTxEx ?! ExUnitsTooBigUTxO maxTxEx totExunits
 
   -- This does not appear in the Alonzo specification. But the test should be in every Era.
   -- Bootstrap (i.e. Byron) addresses have variable sized attributes in them.
@@ -497,8 +497,8 @@ encFail (FeeNotBalancedUTxO a b) =
   Sum FeeNotBalancedUTxO 13 !> To a !> To b
 encFail (ScriptsNotPaidUTxO a) =
   Sum ScriptsNotPaidUTxO 14 !> To a
-encFail (ExUnitsTooSmallUTxO a b) =
-  Sum ExUnitsTooSmallUTxO 15 !> To a !> To b
+encFail (ExUnitsTooBigUTxO a b) =
+  Sum ExUnitsTooBigUTxO 15 !> To a !> To b
 encFail (FeeContainsNonADA a) =
   Sum FeeContainsNonADA 16 !> To a
 
@@ -525,7 +525,7 @@ decFail 11 = SumD TriesToForgeADA
 decFail 12 = SumD (OutputTooBigUTxO) <! D (decodeList fromCBOR)
 decFail 13 = SumD FeeNotBalancedUTxO <! From <! From
 decFail 14 = SumD ScriptsNotPaidUTxO <! From
-decFail 15 = SumD ExUnitsTooSmallUTxO <! From <! From
+decFail 15 = SumD ExUnitsTooBigUTxO <! From <! From
 decFail 16 = SumD FeeContainsNonADA <! From
 decFail n = Invalid n
 

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

@@ -16,7 +16,7 @@ module Cardano.Ledger.Alonzo.Rules.Utxow where
 -- import Shelley.Spec.Ledger.UTxO(UTxO(..))
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..))
-import Cardano.Ledger.Alonzo.Data (Data, DataHash)
+import Cardano.Ledger.Alonzo.Data (DataHash)
 import Cardano.Ledger.Alonzo.PParams (PParams)
 import Cardano.Ledger.Alonzo.PlutusScriptApi (checkScriptData, language, scriptsNeeded)
 import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUTXO)
@@ -192,7 +192,6 @@ type ShelleyStyleWitnessNeeds era =
 --   (in addition to ShelleyStyleWitnessNeeds)
 type AlonzoStyleAdditions era =
   ( HasField "datahash" (Core.TxOut era) (StrictMaybe (DataHash (Crypto era))), -- BE SURE AND ADD THESE INSTANCES
-    HasField "txdatahash" (Core.Tx era) (Map.Map (DataHash (Crypto era)) (Data era)),
     HasField "wppHash" (Core.TxBody era) (StrictMaybe (WitnessPPDataHash (Crypto era))),
     HasField "txnetworkid" (Core.TxBody era) (StrictMaybe Network)
   )
@@ -259,7 +258,7 @@ alonzoStyleWitness = do
             SJust h <- [getField @"datahash" output],
             isTwoPhaseScriptAddress @era tx (getField @"address" output)
         ]
-      txHashes = domain (getField @"txdatahash" tx)
+      txHashes = domain (txdats . wits' $ tx)
       inputHashes = Set.fromList utxoHashes
   txHashes == inputHashes ?! DataHashSetsDontAgree txHashes inputHashes
 

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

@@ -45,12 +45,12 @@ import Cardano.Ledger.Pretty
     PrettyA (..),
     ppCoin,
     ppInteger,
-    ppLong,
     ppMap,
     ppRecord,
     ppSexp,
     ppString,
     ppWord64,
+    text,
   )
 import Cardano.Ledger.SafeHash
   ( HashWithCrypto (..),
@@ -60,11 +60,11 @@ import Cardano.Ledger.SafeHash
 import Cardano.Ledger.ShelleyMA.Timelocks
 import Cardano.Ledger.Val (Val ((<+>), (<×>)))
 import Control.DeepSeq (NFData (..))
-import Data.ByteString (ByteString)
 import Data.ByteString.Short (ShortByteString, fromShort)
 import Data.Coders
 import Data.Map (Map)
 import Data.MemoBytes
+import Data.Text (Text)
 import Data.Typeable
 import Data.Word (Word64, Word8)
 import GHC.Generics (Generic)
@@ -144,7 +144,7 @@ pointWiseExUnits oper (ExUnits m1 s1) (ExUnits m2 s2) = (m1 `oper` m2) && (s1 `o
 -- Cost Model needs to preserve its serialization bytes as
 -- it is going to be hashed. Thus we make it a newtype around a MemoBytes
 
-newtype CostModel = CostModelConstr (MemoBytes (Map ByteString Integer))
+newtype CostModel = CostModelConstr (MemoBytes (Map Text Integer))
   deriving (Eq, Generic, Show, Ord)
   deriving newtype (SafeToHash)
 
@@ -153,7 +153,7 @@ newtype CostModel = CostModelConstr (MemoBytes (Map ByteString Integer))
 
 instance HashWithCrypto CostModel CostModel
 
-pattern CostModel :: Map ByteString Integer -> CostModel
+pattern CostModel :: Map Text Integer -> CostModel
 pattern CostModel m <-
   CostModelConstr (Memo m _)
   where
@@ -274,7 +274,7 @@ instance PrettyA ExUnits where prettyA = ppExUnits
 
 ppCostModel :: CostModel -> PDoc
 ppCostModel (CostModelConstr (Memo m _)) =
-  ppSexp "CostModel" [ppMap ppLong ppInteger m]
+  ppSexp "CostModel" [ppMap text ppInteger m]
 
 instance PrettyA CostModel where prettyA = ppCostModel
 

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

@@ -42,8 +42,6 @@ import Data.Maybe (mapMaybe)
 import qualified Data.Set as Set
 import Data.Typeable (Typeable)
 import GHC.Records (HasField (..))
--- Import Plutus stuff in the qualified Module P
-
 import qualified Plutus.V1.Ledger.Ada as P (adaSymbol, adaToken)
 import qualified Plutus.V1.Ledger.Address as P (Address (..))
 import qualified Plutus.V1.Ledger.Api as P
@@ -52,6 +50,7 @@ import qualified Plutus.V1.Ledger.Api as P
     ExBudget (..),
     VerboseMode (..),
     evaluateScriptRestricting,
+    validateAndCreateCostModel,
     validateScript,
   )
 import qualified Plutus.V1.Ledger.Contexts as P
@@ -74,6 +73,7 @@ import qualified Plutus.V1.Ledger.Slot as P (SlotRange)
 import qualified Plutus.V1.Ledger.Tx as P (TxOutRef (..))
 import qualified Plutus.V1.Ledger.TxId as P (TxId (..))
 import qualified Plutus.V1.Ledger.Value as P (CurrencySymbol (..), TokenName (..), Value (..), singleton, unionWith)
+import qualified PlutusCore.Evaluation.Machine.ExBudgetingDefaults as P (defaultCostModel)
 import qualified PlutusCore.Evaluation.Machine.ExMemory as P (ExCPU (..), ExMemory (..))
 import qualified PlutusTx as P (Data (..))
 import qualified PlutusTx.IsData.Class as P (IsData (..))
@@ -255,7 +255,10 @@ transDataPair :: (DataHash c, Data era) -> (P.DatumHash, P.Datum)
 transDataPair (x, y) = (transDataHash' x, P.Datum (getPlutusData y))
 
 transCostModel :: CostModel -> P.CostModel
-transCostModel (CostModel _mp) = undefined -- Map.foldlWithKey' (\ans bytes n -> Map.insert (show bytes) n ans) Map.empty mp
+transCostModel (CostModel mp) =
+  case P.validateAndCreateCostModel mp of
+    Nothing -> P.defaultCostModel -- TODO validation should be before this
+    Just cm -> cm
 
 transExUnits :: ExUnits -> P.ExBudget
 transExUnits (ExUnits mem steps) = P.ExBudget (P.ExCPU (fromIntegral steps)) (P.ExMemory (fromIntegral mem))

alonzo/impl/test/lib/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs

@@ -44,6 +44,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (mapMaybe)
 import qualified Data.Set as Set
+import qualified Data.Text as T (pack)
 import qualified PlutusTx as Plutus
 import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators (genMintValues)
 import Test.QuickCheck
@@ -192,7 +193,7 @@ instance Arbitrary Prices where
   arbitrary = Prices <$> arbitrary <*> arbitrary
 
 instance Arbitrary CostModel where
-  arbitrary = CostModel <$> arbitrary
+  arbitrary = (CostModel . (Map.mapKeys T.pack)) <$> arbitrary
 
 instance Arbitrary (PParams era) where
   arbitrary =
@@ -271,7 +272,7 @@ instance Mock c => Arbitrary (UtxoPredicateFailure (AlonzoEra c)) where
         (OutputTooBigUTxO) <$> arbitrary,
         FeeNotBalancedUTxO <$> arbitrary <*> arbitrary,
         ScriptsNotPaidUTxO <$> arbitrary,
-        ExUnitsTooSmallUTxO <$> arbitrary <*> arbitrary,
+        ExUnitsTooBigUTxO <$> arbitrary <*> arbitrary,
         FeeContainsNonADA <$> arbitrary
       ]