WIP: Redeemers

cardano-api/src/Cardano/Api.hs

@@ -163,6 +163,7 @@ module Cardano.Api (
 
     -- ** Transaction outputs
     TxOut(TxOut),
+    TxOutDatumHash(..),
     TxOutValue(..),
     serialiseAddressForTxOut,
 

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

@@ -33,6 +33,8 @@ module Cardano.Api.Script (
     WitCtxTxIn, WitCtxMint, WitCtxStake,
     ScriptWitness(..),
     ScriptExecutionUnits(..),
+    Redeemer(..),
+    fromScriptExecutionUnits,
     Witness(..),
     KeyWitnessInCtx(..),
     ScriptWitnessInCtx(..),
@@ -101,6 +103,7 @@ import           Cardano.Slotting.Slot (SlotNo)
 
 import qualified Cardano.Ledger.Core as Ledger
 
+import qualified Cardano.Ledger.Alonzo.Data as Alonzo
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as Timelock
 import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
@@ -496,13 +499,6 @@ instance SerialiseAsCBOR ScriptInAnyLang where
 instance HasTextEnvelope ScriptInAnyLang where
     textEnvelopeType _ = "Script"
 
--- ----------------------------------------------------------------------------
--- Plutus script datum. All transaction outputs that are locked by Plutus scripts must include
--- the hash of an additional “datum”. The datum can be used to encode state, for example.
-
-newtype ScriptDatum = ScriptDatum ()
-       deriving newtype (Eq, Ord, Show)
-
 -- ----------------------------------------------------------------------------
 -- Scripts in the context of a ledger era
 --
@@ -690,10 +686,23 @@ data ScriptWitness witctx era where
                          -> PlutusScriptVersion  lang
                          -> PlutusScript         lang
                          -> ScriptExecutionUnits
+                         -> ScriptDatum witctx
+                         -> Redeemer era
                          -> ScriptWitness witctx era
 
 deriving instance Show (ScriptWitness witctx era)
 
+data ScriptDatum witctx where
+     ScriptDatumForTxIn    :: Datum -> ScriptDatum WitCtxTxIn
+     NoScriptDatumForMint  :: ScriptDatum WitCtxMint
+     NoScriptDatumForStake :: ScriptDatum WitCtxStake
+
+deriving instance Show (ScriptDatum witctx)
+deriving instance Eq (ScriptDatum witctx)
+
+-- Placeholder for Data era in ledger specs
+newtype Datum = Datum () deriving (Eq, Show)
+
 -- The GADT in the SimpleScriptWitness constructor requires a custom instance
 instance Eq (ScriptWitness witctx era) where
     (==) (SimpleScriptWitness langInEra  version  script)
@@ -703,14 +712,16 @@ instance Eq (ScriptWitness witctx era) where
         Nothing   -> False
         Just Refl -> version == version' && script == script'
 
-    (==) (PlutusScriptWitness langInEra  version  script execUnits)
-         (PlutusScriptWitness langInEra' version' script' execUnits') =
+    (==) (PlutusScriptWitness langInEra  version  script execUnits datum redeemer)
+         (PlutusScriptWitness langInEra' version' script' execUnits' datum' redeemer') =
       case testEquality (languageOfScriptLanguageInEra langInEra)
                         (languageOfScriptLanguageInEra langInEra') of
         Nothing   -> False
         Just Refl ->    version   == version'
                      && script    == script'
                      && execUnits == execUnits'
+                     && datum     == datum'
+                     && redeemer  == redeemer'
 
     (==)  _ _ = False
 
@@ -734,6 +745,19 @@ data ExecutionUnitsSupportedInEra era where
 deriving instance Show (ExecutionUnitsSupportedInEra era)
 deriving instance Eq (ExecutionUnitsSupportedInEra era)
 
+_toScriptExecutionUnits :: Alonzo.ExUnits -> ScriptExecutionUnits
+_toScriptExecutionUnits (Alonzo.ExUnits mMem mSteps) = ScriptExecutionUnits mMem mSteps
+
+fromScriptExecutionUnits :: ScriptExecutionUnits -> Alonzo.ExUnits
+fromScriptExecutionUnits (ScriptExecutionUnits mMem mSteps) = Alonzo.ExUnits mMem mSteps
+
+data Redeemer era where
+  Redeemer :: Alonzo.Data (ShelleyLedgerEra era) -> Redeemer era
+
+deriving instance Show (Redeemer era)
+deriving instance Eq (Redeemer era)
+
+
 -- ----------------------------------------------------------------------------
 -- The kind of witness to use, key (signature) or script
 --
@@ -747,7 +771,7 @@ data Witness witctx era where
                    -> ScriptWitness      witctx era
                    -> Witness            witctx era
 
-deriving instance Eq   (Witness witctx era)
+deriving instance Eq   (Witness wiScriptWitnesstctx era)
 deriving instance Show (Witness witctx era)
 
 data KeyWitnessInCtx witctx where

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

@@ -53,6 +53,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 
 import           Data.Functor.Identity (Identity)
+import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Vector as Vector
@@ -84,6 +85,7 @@ import qualified Cardano.Crypto.Signing as Byron
 --
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
 
+import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
 import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo
 import qualified Cardano.Ledger.Core as Ledger
@@ -448,11 +450,12 @@ getTxBody (ShelleyTx era tx) =
                                                 _txwitsBoot
                                                 txscripts
                                                 _txdats
-                                                _txrdmrs,
-                                Alonzo.isValidating = isValidating,
+                                                txrdmrs,
+                                Alonzo.isValidating = _isValidating,
                                 Alonzo.auxiliaryData = auxiliaryData
                               } = ShelleyTxBody era txbody (Map.elems txscripts)
-                                                (strictMaybeToMaybe auxiliaryData) (Just isValidating)
+                                                (strictMaybeToMaybe auxiliaryData)
+                                                (Just txrdmrs)
     getAlonzoTxBody _ = error "Why is GHC asking for TxConstr?"
 
 getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
@@ -518,12 +521,15 @@ makeSignedTransaction witnesses (ByronTxBody txbody) =
       (unAnnotated txbody)
       (Vector.fromList [ w | ByronKeyWitness w <- witnesses ])
 
-makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata isValid) =
+makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata mRdmrMap) =
     case era of
       ShelleyBasedEraShelley -> ShelleyTx era $ makeShelleySignedTransaction txbody
       ShelleyBasedEraAllegra -> ShelleyTx era $ makeShelleySignedTransaction txbody
       ShelleyBasedEraMary    -> ShelleyTx era $ makeShelleySignedTransaction txbody
-      ShelleyBasedEraAlonzo  -> ShelleyTx era $ makeAlonzoSignedTransaction txbody
+      ShelleyBasedEraAlonzo  ->
+        case mRdmrMap of
+          Just rdmrMap -> ShelleyTx era $ makeAlonzoSignedTransaction txbody rdmrMap
+          Nothing -> error "makeSignedTransaction: Alonzo era required a redeemer map"
   where
     makeShelleySignedTransaction
       :: Ledger.Crypto ledgerera ~ StandardCrypto
@@ -534,7 +540,8 @@ makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata i
       => Shelley.UsesAuxiliary ledgerera
       => FromCBOR (CBOR.Annotator (Ledger.Script ledgerera))
       => Shelley.ValidateScript ledgerera
-      => Ledger.TxBody (ShelleyLedgerEra era) -> Shelley.Tx ledgerera
+      => Ledger.TxBody (ShelleyLedgerEra era)
+      -> Shelley.Tx ledgerera
     makeShelleySignedTransaction txbody' =
         Shelley.Tx
           txbody'
@@ -552,8 +559,9 @@ makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata i
       => ToCBOR (Ledger.TxBody ledgerera)
       => ToCBOR (Ledger.Script ledgerera)
       => Shelley.ValidateScript ledgerera
-      => Ledger.TxBody (ShelleyLedgerEra era) -> Alonzo.Tx ledgerera
-    makeAlonzoSignedTransaction txbody' =
+      => Ledger.TxBody (ShelleyLedgerEra era)
+      -> Map Alonzo.RdmrPtr (Alonzo.Data ledgerera, Alonzo.ExUnits) -> Alonzo.Tx ledgerera
+    makeAlonzoSignedTransaction txbody' rdmrMap  =
       Alonzo.Tx
         txbody'
         (Alonzo.TxWitness
@@ -562,13 +570,13 @@ makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata i
           (Map.fromList [ (Shelley.hashScript @ledgerera sw, sw)
                         | sw <- txscripts ])
           (error "Map (DataHash (Crypto ledgerera)) (Data ledgerera)")
-          (error "Map RdmrPtr (Data ledgerera, ExUnits)"))
+          rdmrMap
+        )
         -- TODO: Seems to be some discussion around the isValidating flag
-        (case isValid of
-           Just vBool -> vBool
-           Nothing -> error "makeAlonzoSignedTransaction: isValidating flag was not specified")
+        (error "IsValidating")
         (maybeToStrictMaybe txmetadata)
 
+
 makeByronKeyWitness :: forall key.
                        IsByronKey key
                     => NetworkId