Merge #2774

2774: CLI Alonzo script support r=dcoutts a=dcoutts



Co-authored-by: Duncan Coutts <duncan@well-typed.com>

cardano-api/cardano-api.cabal

@@ -72,6 +72,7 @@ library
                         Cardano.Api.ProtocolParameters
                         Cardano.Api.Query
                         Cardano.Api.Script
+                        Cardano.Api.ScriptData
                         Cardano.Api.SerialiseBech32
                         Cardano.Api.SerialiseCBOR
                         Cardano.Api.SerialiseJSON

cardano-api/src/Cardano/Api.hs

@@ -16,6 +16,7 @@ module Cardano.Api (
     ShelleyEra,
     AllegraEra,
     MaryEra,
+    AlonzoEra,
     CardanoEra(..),
     IsCardanoEra(..),
     AnyCardanoEra(..),
@@ -105,6 +106,7 @@ module Cardano.Api (
     -- ** Multi-asset values
     Quantity(..),
     PolicyId(..),
+    scriptPolicyId,
     AssetName(..),
     AssetId(..),
     Value,
@@ -198,6 +200,7 @@ module Cardano.Api (
     TxMetadataSupportedInEra(..),
     AuxScriptsSupportedInEra(..),
     TxExtraKeyWitnessesSupportedInEra(..),
+    ScriptDataSupportedInEra(..),
     WithdrawalsSupportedInEra(..),
     CertificatesSupportedInEra(..),
     UpdateProposalSupportedInEra(..),
@@ -215,6 +218,7 @@ module Cardano.Api (
     withdrawalsSupportedInEra,
     certificatesSupportedInEra,
     updateProposalSupportedInEra,
+    scriptDataSupportedInEra,
 
     -- * Signing transactions
     -- | Creating transaction witnesses one by one, or all in one go.
@@ -310,12 +314,14 @@ module Cardano.Api (
 
     -- * Use of a script in an era as a witness
     WitCtxTxIn, WitCtxMint, WitCtxStake,
+    WitCtx(..),
     ScriptWitness(..),
     Witness(..),
     KeyWitnessInCtx(..),
     ScriptWitnessInCtx(..),
     ScriptDatum(..),
     ScriptRedeemer,
+    scriptWitnessScript,
 
     -- *** Languages supported in each era
     ScriptLanguageInEra(..),
@@ -332,10 +338,26 @@ module Cardano.Api (
 
     -- ** Plutus scripts
     PlutusScript,
+    examplePlutusScriptAlwaysSucceeds,
+    examplePlutusScriptAlwaysFails,
 
-    -- ** Script data
+    -- * Script data
     ScriptData(..),
 
+    -- ** Validation
+    ScriptDataRangeError (..),
+    validateScriptData,
+
+    -- ** Conversion to\/from JSON
+    ScriptDataJsonSchema (..),
+    scriptDataFromJson,
+    scriptDataToJson,
+    ScriptDataJsonError (..),
+    ScriptDataJsonSchemaError (..),
+
+    -- * Script execution units
+    ExecutionUnits(..),
+
     -- ** Script addresses
     -- | Making addresses from scripts.
     ScriptHash,
@@ -545,6 +567,7 @@ import           Cardano.Api.OperationalCertificate
 import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.Query (SlotsInEpoch(..), SlotsToEpochEnd(..), slotToEpoch)
 import           Cardano.Api.Script
+import           Cardano.Api.ScriptData
 import           Cardano.Api.SerialiseBech32
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseJSON

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

@@ -33,6 +33,7 @@ module Cardano.Api.Script (
 
     -- * Use of a script in an era as a witness
     WitCtxTxIn, WitCtxMint, WitCtxStake,
+    WitCtx(..),
     ScriptWitness(..),
     Witness(..),
     KeyWitnessInCtx(..),
@@ -55,6 +56,8 @@ module Cardano.Api.Script (
 
     -- * The Plutus script language
     PlutusScript(..),
+    examplePlutusScriptAlwaysSucceeds,
+    examplePlutusScriptAlwaysFails,
 
     -- * Script data
     ScriptData(..),
@@ -92,7 +95,6 @@ module Cardano.Api.Script (
 import           Prelude
 
 import           Data.Word (Word64)
-import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import           Data.ByteString.Short (ShortByteString)
 import qualified Data.ByteString.Short as SBS
@@ -104,6 +106,7 @@ import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
 import           Data.Typeable (Typeable)
+import           Numeric.Natural (Natural)
 
 import           Data.Aeson (Value (..), object, (.:), (.=))
 import qualified Data.Aeson as Aeson
@@ -124,23 +127,22 @@ import           Cardano.Slotting.Slot (SlotNo)
 
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Era  as Ledger
-import qualified Cardano.Ledger.SafeHash as Ledger
 
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as Timelock
 import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
 import qualified Cardano.Ledger.Keys as Shelley
 import qualified Shelley.Spec.Ledger.Scripts as Shelley
 
-import qualified Cardano.Ledger.Alonzo.Data as Alonzo
 import qualified Cardano.Ledger.Alonzo.Language as Alonzo
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 
-import qualified Plutus.V1.Ledger.Api as Plutus
+import qualified Plutus.V1.Ledger.Examples as Plutus
 
 import           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Hash
 import           Cardano.Api.KeysShelley
+import           Cardano.Api.ScriptData
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseJSON
 import           Cardano.Api.SerialiseRaw
@@ -599,6 +601,17 @@ data WitCtxMint
 --
 data WitCtxStake
 
+
+-- | This GADT provides a value-level representation of all the witness
+-- contexts. This enables pattern matching on the context to allow them to be
+-- treated in a non-uniform way.
+--
+data WitCtx witctx where
+     WitCtxTxIn  :: WitCtx WitCtxTxIn
+     WitCtxMint  :: WitCtx WitCtxMint
+     WitCtxStake :: WitCtx WitCtxStake
+
+
 -- | A /use/ of a script within a transaction body to witness that something is
 -- being used in an authorised manner. That can be
 --
@@ -653,6 +666,8 @@ instance Eq (ScriptWitness witctx era) where
 
     (==)  _ _ = False
 
+type ScriptRedeemer = ScriptData
+
 data ScriptDatum witctx where
      ScriptDatumForTxIn    :: ScriptData -> ScriptDatum WitCtxTxIn
      NoScriptDatumForMint  ::               ScriptDatum WitCtxMint
@@ -704,77 +719,6 @@ deriving instance Eq   (ScriptWitnessInCtx witctx)
 deriving instance Show (ScriptWitnessInCtx witctx)
 
 
--- ----------------------------------------------------------------------------
--- Script data
---
-
-type ScriptRedeemer = ScriptData
-
-data ScriptData = ScriptDataConstructor Integer [ScriptData]
-                | ScriptDataMap         [(ScriptData, ScriptData)]
-                | ScriptDataList        [ScriptData]
-                | ScriptDataNumber      Integer
-                | ScriptDataBytes       BS.ByteString
-  deriving (Eq, Ord, Show)
-  -- Note the order of constructors is the same as the Plutus definitions
-  -- so that the Ord instance is consistent with the Plutus one.
-  -- This is checked by prop_ord_distributive_ScriptData
-
-instance HasTypeProxy ScriptData where
-    data AsType ScriptData = AsScriptData
-    proxyToAsType _ = AsScriptData
-
-toAlonzoData :: ScriptData -> Alonzo.Data ledgerera
-toAlonzoData = Alonzo.Data . toPlutusData
-
-fromAlonzoData :: Alonzo.Data ledgerera -> ScriptData
-fromAlonzoData = fromPlutusData . Alonzo.getPlutusData
-
-
-toPlutusData :: ScriptData -> Plutus.Data
-toPlutusData (ScriptDataConstructor int xs)
-                                  = Plutus.Constr int
-                                      [ toPlutusData x | x <- xs ]
-toPlutusData (ScriptDataMap  kvs) = Plutus.Map
-                                      [ (toPlutusData k, toPlutusData v)
-                                      | (k,v) <- kvs ]
-toPlutusData (ScriptDataList  xs) = Plutus.List
-                                      [ toPlutusData x | x <- xs ]
-toPlutusData (ScriptDataNumber n) = Plutus.I n
-toPlutusData (ScriptDataBytes bs) = Plutus.B bs
-
-fromPlutusData :: Plutus.Data -> ScriptData
-fromPlutusData (Plutus.Constr int xs)
-                                = ScriptDataConstructor int
-                                    [ fromPlutusData x | x <- xs ]
-fromPlutusData (Plutus.Map kvs) = ScriptDataMap
-                                    [ (fromPlutusData k, fromPlutusData v)
-                                    | (k,v) <- kvs ]
-fromPlutusData (Plutus.List xs) = ScriptDataList
-                                    [ fromPlutusData x | x <- xs ]
-fromPlutusData (Plutus.I     n) = ScriptDataNumber n
-fromPlutusData (Plutus.B    bs) = ScriptDataBytes bs
-
-
-newtype instance Hash ScriptData =
-    ScriptDataHash (Alonzo.DataHash StandardCrypto)
-  deriving stock (Eq, Ord)
-  deriving (Show, IsString) via UsingRawBytesHex (Hash ScriptData)
-
-instance SerialiseAsRawBytes (Hash ScriptData) where
-    serialiseToRawBytes (ScriptDataHash dh) =
-      Crypto.hashToBytes (Ledger.extractHash dh)
-
-    deserialiseFromRawBytes (AsHash AsScriptData) bs =
-      ScriptDataHash . Ledger.unsafeMakeSafeHash <$> Crypto.hashFromBytes bs
-
-instance ToJSON (Hash ScriptData) where
-    toJSON = toJSON . serialiseToRawBytesHexText
-
-instance Aeson.ToJSONKey (Hash ScriptData) where
-    toJSONKey = Aeson.toJSONKeyText serialiseToRawBytesHexText
-
-
 -- ----------------------------------------------------------------------------
 -- Script execution units
 --
@@ -997,6 +941,49 @@ instance (IsPlutusScriptLanguage lang, Typeable lang) =>
         PlutusScriptV1 -> "PlutusScriptV1"
 
 
+-- | An example Plutus script that always succeeds, irrespective of inputs.
+--
+-- For example, if one were to use this for a payment address then it would
+-- allow anyone to spend from it.
+--
+-- The exact script depends on the context in which it is to be used.
+--
+examplePlutusScriptAlwaysSucceeds :: WitCtx witctx
+                                  -> PlutusScript PlutusScriptV1
+examplePlutusScriptAlwaysSucceeds =
+    PlutusScriptSerialised
+  . Plutus.alwaysSucceedingNAryFunction
+  . scriptArityForWitCtx
+
+-- | An example Plutus script that always fails, irrespective of inputs.
+--
+-- For example, if one were to use this for a payment address then it would
+-- be impossible for anyone to ever spend from it.
+--
+-- The exact script depends on the context in which it is to be used.
+--
+examplePlutusScriptAlwaysFails :: WitCtx witctx
+                               -> PlutusScript PlutusScriptV1
+examplePlutusScriptAlwaysFails =
+    PlutusScriptSerialised
+  . Plutus.alwaysFailingNAryFunction
+  . scriptArityForWitCtx
+
+-- | The expected arity of the Plutus function, depending on the context in
+-- which it is used.
+--
+-- The script inputs consist of
+--
+-- * the optional datum (for txins)
+-- * the redeemer
+-- * the Plutus representation of the tx and environment
+--
+scriptArityForWitCtx :: WitCtx witctx -> Natural
+scriptArityForWitCtx WitCtxTxIn  = 3
+scriptArityForWitCtx WitCtxMint  = 2
+scriptArityForWitCtx WitCtxStake = 2
+
+
 -- ----------------------------------------------------------------------------
 -- Conversion functions
 --