WIP

Author: Jimbo4350

cardano-api/cardano-api.cabal

@@ -227,15 +227,18 @@ library
     Cardano.Api.Experimental.Plutus.Internal.Script
     Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
     Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
+    Cardano.Api.Experimental.Script
     Cardano.Api.Experimental.Serialise.TextEnvelope.Internal
     Cardano.Api.Experimental.Tx.Internal.AnyWitness
-    Cardano.Api.Experimental.Tx.Internal.Body
+    Cardano.Api.Experimental.Tx.Internal.BodyContent.New
+    Cardano.Api.Experimental.Tx.Internal.BodyContent.Old
     Cardano.Api.Experimental.Tx.Internal.Certificate
     Cardano.Api.Experimental.Tx.Internal.Certificate.Compatible
     Cardano.Api.Experimental.Tx.Internal.Certificate.Type
     Cardano.Api.Experimental.Tx.Internal.Compatible
     Cardano.Api.Experimental.Tx.Internal.Fee
     Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
+    Cardano.Api.Experimental.Tx.Internal.Type
     Cardano.Api.Genesis.Internal
     Cardano.Api.Genesis.Internal.Parameters
     Cardano.Api.Governance.Internal.Action.ProposalProcedure

cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs

@@ -92,7 +92,7 @@ data PlutusScriptPurpose
   | -- | Witnesses a vote
     VotingScript
 
-data NoScriptDatum = NoScriptDatumAllowed deriving Show
+data NoScriptDatum = NoScriptDatumAllowed deriving (Eq, Show)
 
 -- | The PlutusScriptDatum type family is used to determine if a script datum is allowed
 -- for a given plutus script purpose and version. This change was proposed in CIP-69
@@ -130,6 +130,55 @@ data PlutusScriptDatum (lang :: L.Language) (purpose :: PlutusScriptPurpose) whe
   NoScriptDatum
     :: PlutusScriptDatum lang purpose
 
+instance Eq (PlutusScriptDatum L.PlutusV1 SpendingScript) where
+  (==) (SpendingScriptDatum d1) (SpendingScriptDatum d2) = d1 == d2
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum L.PlutusV2 SpendingScript) where
+  (==) (SpendingScriptDatum d1) (SpendingScriptDatum d2) = d1 == d2
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum L.PlutusV3 SpendingScript) where
+  (==) (SpendingScriptDatum d1) (SpendingScriptDatum d2) = d1 == d2
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum L.PlutusV4 SpendingScript) where
+  (==) (SpendingScriptDatum d1) (SpendingScriptDatum d2) = d1 == d2
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum lang MintingScript) where
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum lang WithdrawingScript) where
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum lang CertifyingScript) where
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum lang ProposingScript) where
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
+instance Eq (PlutusScriptDatum lang VotingScript) where
+  (==) InlineDatum InlineDatum = True
+  (==) NoScriptDatum NoScriptDatum = True
+  (==) _ _ = False
+
 instance Show (PlutusScriptDatum lang purpose) where
   show = \case
     SpendingScriptDatum _d -> "Datum"

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

@@ -0,0 +1,13 @@
+{-# LANGUAGE GADTs #-}
+
+module Cardano.Api.Experimental.Script
+  ( AnyScript (..)
+  )
+where
+
+import Cardano.Api.Experimental.Plutus.Internal.Script
+import Cardano.Api.Experimental.Simple.Script
+
+data AnyScript era where
+  SimpleScript :: SimpleScriptOrReferenceInput era -> AnyScript era
+  PlutusScript :: PlutusScriptOrReferenceInput lang era -> AnyScript era

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

@@ -146,27 +146,28 @@ module Cardano.Api.Experimental.Tx
   )
 where
 
-import Cardano.Api.Era.Internal.Core (ToCardanoEra (toCardanoEra), forEraInEon)
-import Cardano.Api.Era.Internal.Eon.Convert
+import Cardano.Api.Era.Internal.Core qualified as Api
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
-import Cardano.Api.Era.Internal.Feature
 import Cardano.Api.Experimental.Era
 import Cardano.Api.Experimental.Tx.Internal.AnyWitness
-import Cardano.Api.Experimental.Tx.Internal.Body
+import Cardano.Api.Experimental.Tx.Internal.BodyContent.Old
+  ( extractAllIndexedPlutusScriptWitnesses
+  , makeUnsignedTx
+  )
 import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
+import Cardano.Api.Experimental.Tx.Internal.Type
 import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
-import Cardano.Api.Ledger.Internal.Reexport (StrictMaybe (..), maybeToStrictMaybe)
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
 import Cardano.Api.Pretty (docToString, pretty)
+import Cardano.Api.ProtocolParameters
 import Cardano.Api.Serialise.Raw
   ( SerialiseAsRawBytes (..)
   , SerialiseAsRawBytesError (SerialiseAsRawBytesError)
   )
-import Cardano.Api.Tx.Internal.Body
 import Cardano.Api.Tx.Internal.Sign
 
 import Cardano.Crypto.Hash qualified as Hash
-import Cardano.Ledger.Alonzo.TxBody qualified as L
+import Cardano.Ledger.Alonzo.Tx qualified as L
 import Cardano.Ledger.Api qualified as L
 import Cardano.Ledger.Binary qualified as Ledger
 import Cardano.Ledger.Core qualified as Ledger
@@ -176,150 +177,11 @@ import Control.Exception (displayException)
 import Data.Bifunctor (bimap)
 import Data.ByteString.Lazy (fromStrict)
 import Data.Set qualified as Set
-import GHC.Exts (IsList (..))
 import GHC.Stack
 import Lens.Micro
 
--- | A transaction that can contain everything
--- except key witnesses.
-data UnsignedTx era
-  = L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era))
-
-instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where
-  data AsType (UnsignedTx era) = AsUnsignedTx (AsType era)
-  proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
-  proxyToAsType _ = AsUnsignedTx (asType @era)
-
-instance
-  ( HasTypeProxy era
-  , L.EraTx (LedgerEra era)
-  )
-  => SerialiseAsRawBytes (UnsignedTx era)
-  where
-  serialiseToRawBytes (UnsignedTx tx) =
-    Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
-  deserialiseFromRawBytes _ =
-    bimap wrapError UnsignedTx
-      . Ledger.decodeFullAnnotator
-        (Ledger.eraProtVerHigh @(LedgerEra era))
-        "UnsignedTx"
-        Ledger.decCBOR
-      . fromStrict
-   where
-    wrapError
-      :: Ledger.DecoderError -> SerialiseAsRawBytesError
-    wrapError = SerialiseAsRawBytesError . displayException
-
-deriving instance Eq (UnsignedTx era)
-
-deriving instance Show (UnsignedTx era)
-
 newtype UnsignedTxError
-  = UnsignedTxError TxBodyError
-
-makeUnsignedTx
-  :: Era era
-  -> TxBodyContent BuildTx era
-  -> Either TxBodyError (UnsignedTx era)
-makeUnsignedTx DijkstraEra _ = error "makeUnsignedTx: Dijkstra era not supported yet"
-makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
-  let sbe = convert era
-      aeon = convert era
-  TxScriptWitnessRequirements languages scripts datums redeemers <-
-    shelleyBasedEraConstraints sbe $
-      collectTxBodyScriptWitnessRequirements (convert era) bc
-
-  -- cardano-api types
-  let apiTxOuts = txOuts bc
-      apiScriptValidity = txScriptValidity bc
-      apiMintValue = txMintValue bc
-      apiProtocolParameters = txProtocolParams bc
-      apiCollateralTxIns = txInsCollateral bc
-      apiReferenceInputs = txInsReference bc
-      apiExtraKeyWitnesses = txExtraKeyWits bc
-      apiReturnCollateral = txReturnCollateral bc
-      apiTotalCollateral = txTotalCollateral bc
-
-      -- Ledger types
-      txins = convTxIns $ txIns bc
-      collTxIns = convCollateralTxIns apiCollateralTxIns
-      refTxIns = convReferenceInputs apiReferenceInputs
-      outs = convTxOuts sbe apiTxOuts
-      fee = convTransactionFee sbe $ txFee bc
-      withdrawals = convWithdrawals $ txWithdrawals bc
-      returnCollateral = convReturnCollateral sbe apiReturnCollateral
-      totalCollateral = convTotalCollateral apiTotalCollateral
-      certs = convCertificates sbe $ txCertificates bc
-      txAuxData = toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc)
-      scriptIntegrityHash =
-        convPParamsToScriptIntegrityHash
-          aeon
-          apiProtocolParameters
-          redeemers
-          datums
-          languages
-
-  let setMint = convMintValue apiMintValue
-      setReqSignerHashes = convExtraKeyWitnesses apiExtraKeyWitnesses
-      ledgerTxBody =
-        L.mkBasicTxBody
-          & L.inputsTxBodyL .~ txins
-          & L.collateralInputsTxBodyL .~ collTxIns
-          & L.referenceInputsTxBodyL .~ refTxIns
-          & L.outputsTxBodyL .~ outs
-          & L.totalCollateralTxBodyL .~ totalCollateral
-          & L.collateralReturnTxBodyL .~ returnCollateral
-          & L.feeTxBodyL .~ fee
-          & L.vldtTxBodyL . L.invalidBeforeL .~ convValidityLowerBound (txValidityLowerBound bc)
-          & L.vldtTxBodyL . L.invalidHereAfterL .~ convValidityUpperBound sbe (txValidityUpperBound bc)
-          & L.reqSignerHashesTxBodyL .~ setReqSignerHashes
-          & L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash
-          & L.withdrawalsTxBodyL .~ withdrawals
-          & L.certsTxBodyL .~ certs
-          & L.mintTxBodyL .~ setMint
-          & L.auxDataHashTxBodyL .~ maybe SNothing (SJust . Ledger.hashTxAuxData) txAuxData
-
-      scriptWitnesses =
-        L.mkBasicTxWits
-          & L.scriptTxWitsL
-            .~ fromList
-              [ (L.hashScript sw, sw)
-              | sw <- scripts
-              ]
-          & L.datsTxWitsL .~ datums
-          & L.rdmrsTxWitsL .~ redeemers
-
-  let eraSpecificTxBody = eraSpecificLedgerTxBody era ledgerTxBody bc
-
-  return . UnsignedTx $
-    L.mkBasicTx eraSpecificTxBody
-      & L.witsTxL .~ scriptWitnesses
-      & L.auxDataTxL .~ maybeToStrictMaybe (toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc))
-      & L.isValidTxL .~ txScriptValidityToIsValid apiScriptValidity
-
-eraSpecificLedgerTxBody
-  :: Era era
-  -> Ledger.TxBody (LedgerEra era)
-  -> TxBodyContent BuildTx era
-  -> Ledger.TxBody (LedgerEra era)
-eraSpecificLedgerTxBody era ledgerbody bc =
-  body era
- where
-  body e =
-    let propProcedures = txProposalProcedures bc
-        voteProcedures = txVotingProcedures bc
-        treasuryDonation = txTreasuryDonation bc
-        currentTresuryValue = txCurrentTreasuryValue bc
-     in obtainCommonConstraints e $
-          ledgerbody
-            & L.proposalProceduresTxBodyL
-              .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured propProcedures)
-            & L.votingProceduresTxBodyL
-              .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures)
-            & L.treasuryDonationTxBodyL
-              .~ maybe (L.Coin 0) unFeatured treasuryDonation
-            & L.currentTreasuryValueTxBodyL
-              .~ L.maybeToStrictMaybe (unFeatured =<< currentTresuryValue)
+  = UnsignedTxError String
 
 hashTxBody
   :: L.HashAnnotated (Ledger.TxBody era) L.EraIndependentTxBody
@@ -398,8 +260,8 @@ signTx era bootstrapWits shelleyKeyWits (UnsignedTx unsigned) =
 convertTxBodyToUnsignedTx
   :: HasCallStack => ShelleyBasedEra era -> TxBody era -> UnsignedTx era
 convertTxBodyToUnsignedTx sbe txbody =
-  forEraInEon
-    (toCardanoEra sbe)
+  Api.forEraInEon
+    (Api.toCardanoEra sbe)
     (error $ "convertTxBodyToUnsignedTx: Error - unsupported era " <> docToString (pretty sbe))
     ( \w -> do
         let ShelleyTx _ unsignedLedgerTx = makeSignedTransaction [] txbody

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs

@@ -1,12 +1,17 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
 module Cardano.Api.Experimental.Tx.Internal.AnyWitness
   ( -- * Any witness (key, simple script, plutus script).
     AnyWitness (..)
   , getAnyWitnessScript
+  , getAnyWitnessSimpleScript
   , getAnyWitnessPlutusLanguage
   , getAnyWitnessScriptData
+  , getPlutusDatum
   )
 where
 
@@ -22,6 +27,7 @@ import Cardano.Api.Experimental.Simple.Script
   ( SimpleScript (SimpleScript)
   , SimpleScriptOrReferenceInput (..)
   )
+import Cardano.Api.Internal.Orphans.Misc ()
 import Cardano.Api.Ledger qualified as L
 import Cardano.Api.Plutus.Internal.ScriptData
 
@@ -51,6 +57,34 @@ data AnyWitness era where
 
 deriving instance Show (AnyWitness era)
 
+instance Eq (AnyWitness era) where
+  AnyKeyWitnessPlaceholder == AnyKeyWitnessPlaceholder = True
+  (AnySimpleScriptWitness s1) == (AnySimpleScriptWitness s2) = s1 == s2
+  (AnyPlutusScriptWitness (PlutusScriptWitness l1 s1 d1 r1 e1)) == (AnyPlutusScriptWitness (PlutusScriptWitness l2 s2 d2 r2 e2)) =
+    case (l1, l2) of
+      (L.SPlutusV1, L.SPlutusV1) -> case (d1, d2) of
+        (InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
+        (_, _) -> False
+      (L.SPlutusV2, L.SPlutusV2) -> case (d1, d2) of
+        (InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
+        (_, _) -> False
+      (L.SPlutusV3, L.SPlutusV3) -> case (d1, d2) of
+        (InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
+        (_, _) -> False
+      (L.SPlutusV4, L.SPlutusV4) -> case (d1, d2) of
+        (InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
+        (SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
+        (_, _) -> False
+      (_, _) -> False
+  _ == _ = False
+
 getAnyWitnessPlutusLanguage :: AnyWitness era -> Maybe L.Language
 getAnyWitnessPlutusLanguage AnyKeyWitnessPlaceholder = Nothing
 getAnyWitnessPlutusLanguage (AnySimpleScriptWitness _) = Nothing