WIP: New TxBodyContent

cardano-api/cardano-api.cabal

@@ -72,6 +72,7 @@ library
     Cardano.Api.Era
     Cardano.Api.Error
     Cardano.Api.Experimental
+    Cardano.Api.Experimental.AnyScriptWitness
     Cardano.Api.Experimental.Certificate
     Cardano.Api.Experimental.Era
     Cardano.Api.Experimental.Plutus
@@ -229,13 +230,13 @@ library
     Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
     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.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
@@ -306,6 +307,7 @@ library gen
     Test.Gen.Cardano.Api
     Test.Gen.Cardano.Api.Byron
     Test.Gen.Cardano.Api.Era
+    Test.Gen.Cardano.Api.Experimental
     Test.Gen.Cardano.Api.Hardcoded
     Test.Gen.Cardano.Api.Metadata
     Test.Gen.Cardano.Api.Orphans
@@ -343,6 +345,7 @@ library gen
     hedgehog-extras,
     hedgehog-quickcheck,
     iproute,
+    ordered-containers,
     quickcheck-instances,
     random,
     tasty,
@@ -388,6 +391,7 @@ test-suite cardano-api-test
     hedgehog-quickcheck,
     microlens,
     mtl,
+    ordered-containers,
     ouroboros-consensus,
     ouroboros-consensus-protocol,
     raw-strings-qq,

cardano-api/gen/Test/Gen/Cardano/Api/Experimental.hs

@@ -0,0 +1,89 @@
+module Test.Gen.Cardano.Api.Experimental
+  ( genScriptWitnessedTxCertificates
+  , genScriptWitnessedTxIn
+  , genScriptWitnessedTxMintValue
+  , genScriptWitnessedTxProposals
+  , genScriptWitnesssedTxVotingProcedures
+  , genScriptWitnessedTxWithdrawals
+  )
+where
+
+import Cardano.Api (TxIn)
+import Cardano.Api.Experimental
+import Cardano.Api.Experimental.AnyScriptWitness
+import Cardano.Api.Experimental.Tx
+import Cardano.Api.Ledger qualified as L
+
+import Data.Map.Ordered.Strict qualified as OMap
+
+import Test.Gen.Cardano.Api.Typed (genExecutionUnits, genHashableScriptData, genTxIn)
+
+import Hedgehog (Gen)
+import Hedgehog.Gen qualified as Gen
+
+genAnyWitness :: Gen (AnyWitness era)
+genAnyWitness =
+  Gen.choice
+    [ return AnyKeyWitnessPlaceholder
+    , AnySimpleScriptWitness <$> genAnySimpleScriptWitness
+    , Gen.choice
+        [ genAnyPlutusScriptWitnessV1
+        , genAnyPlutusScriptWitnessV2
+        , genAnyPlutusScriptWitnessV3
+        , genAnyPlutusScriptWitnessV4
+        ]
+    ]
+
+genAnyPlutusScriptWitnessV1 :: Gen (AnyWitness era)
+genAnyPlutusScriptWitnessV1 =
+  AnyPlutusScriptWitness <$> fmap AnyPlutusMintingScriptWitness (genPlutusScriptWitness L.SPlutusV1)
+
+genAnyPlutusScriptWitnessV2 :: Gen (AnyWitness era)
+genAnyPlutusScriptWitnessV2 =
+  AnyPlutusScriptWitness <$> error "TODO" -- genPlutusScriptWitness L.SPlutusV2
+
+genAnyPlutusScriptWitnessV3 :: Gen (AnyWitness era)
+genAnyPlutusScriptWitnessV3 =
+  AnyPlutusScriptWitness <$> error "TODO" -- genPlutusScriptWitness L.SPlutusV3
+
+genAnyPlutusScriptWitnessV4 :: Gen (AnyWitness era)
+genAnyPlutusScriptWitnessV4 =
+  AnyPlutusScriptWitness <$> error "TODO" -- genPlutusScriptWitness L.SPlutusV4
+
+genAnySimpleScriptWitness :: Gen (SimpleScriptOrReferenceInput era)
+genAnySimpleScriptWitness = SReferenceScript <$> genTxIn
+
+-- TODO: <|> (SScript <$> genSimpleScriptWitness)
+
+genPlutusScriptWitness :: L.SLanguage lang -> Gen (PlutusScriptWitness lang purpose era)
+genPlutusScriptWitness l =
+  PlutusScriptWitness l
+    <$> genPlutusScript
+    <*> genMaybeDatum
+    <*> genHashableScriptData
+    <*> genExecutionUnits
+
+genPlutusScript :: Gen (PlutusScriptOrReferenceInput era lang)
+genPlutusScript = PReferenceScript <$> genTxIn
+
+genMaybeDatum :: Gen (PlutusScriptDatum lang purpose)
+genMaybeDatum = return NoScriptDatum -- TODO: Write proper generator
+
+genScriptWitnessedTxIn :: Gen (TxIn, AnyWitness era)
+genScriptWitnessedTxIn = do
+  (,) <$> genTxIn <*> genAnyWitness
+
+genScriptWitnessedTxMintValue :: Gen (TxMintValue era)
+genScriptWitnessedTxMintValue = return $ TxMintValue mempty
+
+genScriptWitnessedTxCertificates :: Gen (TxCertificates era)
+genScriptWitnessedTxCertificates = return $ TxCertificates OMap.empty
+
+genScriptWitnessedTxWithdrawals :: Gen (TxWithdrawals era)
+genScriptWitnessedTxWithdrawals = return $ TxWithdrawals mempty
+
+genScriptWitnesssedTxVotingProcedures :: Gen (TxVotingProcedures era)
+genScriptWitnesssedTxVotingProcedures = return $ TxVotingProcedures (L.VotingProcedures mempty) mempty
+
+genScriptWitnessedTxProposals :: Gen (TxProposalProcedures era)
+genScriptWitnessedTxProposals = return $ TxProposalProcedures OMap.empty

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -157,6 +157,7 @@ import Cardano.Api hiding (txIns)
 import Cardano.Api qualified as Api
 import Cardano.Api.Byron qualified as Byron
 import Cardano.Api.Experimental qualified as Exp
+import Cardano.Api.Experimental.AnyScriptWitness
 import Cardano.Api.Ledger qualified as L
 import Cardano.Api.Parser.Text qualified as P
 import Cardano.Api.Tx qualified as A
@@ -1572,7 +1573,7 @@ genIndexedPlutusScriptWitness = do
   Exp.IndexedPlutusScriptWitness
     <$> genWitnessable
     <*> genPlutusPurpose index witnessable
-    <*> genPlutusScriptWitness
+    <*> fmap (AnyPlutusSpendingScriptWitness . PlutusSpendingScriptWitnessV3) genPlutusScriptWitness
 
 genPlutusPurpose
   :: Word32

cardano-api/src/Cardano/Api/Certificate/Internal.hs

@@ -10,7 +10,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 
 -- | Certificates embedded in transactions
 module Cardano.Api.Certificate.Internal
@@ -105,7 +104,6 @@ import Data.Maybe
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
-import Data.Type.Equality (TestEquality (..))
 import Data.Typeable
 import GHC.Exts (IsList (..), fromString)
 import Network.Socket (PortNumber)
@@ -145,27 +143,27 @@ deriving instance Ord (Certificate era)
 
 deriving instance Show (Certificate era)
 
-instance TestEquality Certificate where
-  testEquality (ShelleyRelatedCertificate _ c) (ShelleyRelatedCertificate _ c') =
-    shelleyCertTypeEquality c c'
-  testEquality (ConwayCertificate _ c) (ConwayCertificate _ c') =
-    conwayCertTypeEquality c c'
-  testEquality ShelleyRelatedCertificate{} ConwayCertificate{} = Nothing
-  testEquality ConwayCertificate{} ShelleyRelatedCertificate{} = Nothing
-
-conwayCertTypeEquality
-  :: (Typeable eraA, Typeable eraB)
-  => Ledger.ConwayTxCert (ShelleyLedgerEra eraA)
-  -> Ledger.ConwayTxCert (ShelleyLedgerEra eraB)
-  -> Maybe (eraA :~: eraB)
-conwayCertTypeEquality _ _ = eqT
-
-shelleyCertTypeEquality
-  :: (Typeable eraA, Typeable eraB)
-  => Ledger.ShelleyTxCert (ShelleyLedgerEra eraA)
-  -> Ledger.ShelleyTxCert (ShelleyLedgerEra eraB)
-  -> Maybe (eraA :~: eraB)
-shelleyCertTypeEquality _ _ = eqT
+-- instance TestEquality Certificate where
+--  testEquality (ShelleyRelatedCertificate _ c) (ShelleyRelatedCertificate _ c') =
+--    shelleyCertTypeEquality c c'
+--  testEquality (ConwayCertificate _ c) (ConwayCertificate _ c') =
+--    conwayCertTypeEquality c c'
+--  testEquality ShelleyRelatedCertificate{} ConwayCertificate{} = Nothing
+--  testEquality ConwayCertificate{} ShelleyRelatedCertificate{} = Nothing
+
+-- conwayCertTypeEquality
+--   :: (Typeable eraA, Typeable eraB)
+--   => Ledger.ConwayTxCert (ShelleyLedgerEra eraA)
+--   -> Ledger.ConwayTxCert (ShelleyLedgerEra eraB)
+--   -> Maybe (eraA :~: eraB)
+-- conwayCertTypeEquality _ _ = eqT
+--
+-- shelleyCertTypeEquality
+--   :: (Typeable eraA, Typeable eraB)
+--   => Ledger.ShelleyTxCert (ShelleyLedgerEra eraA)
+--   -> Ledger.ShelleyTxCert (ShelleyLedgerEra eraB)
+--   -> Maybe (eraA :~: eraB)
+-- shelleyCertTypeEquality _ _ = eqT
 
 instance Typeable era => HasTypeProxy (Certificate era) where
   data AsType (Certificate era) = AsCertificate

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

@@ -27,6 +27,8 @@ module Cardano.Api.Experimental
 
     -- ** Transaction fee related
   , estimateBalancedTxBody
+  , evaluateTransactionFee
+  , collectTxBodyScriptWitnesses
 
     -- ** Era-related
   , BabbageEra
@@ -100,6 +102,5 @@ import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
 import Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
 import Cardano.Api.Experimental.Simple.Script
 import Cardano.Api.Experimental.Tx
-import Cardano.Api.Experimental.Tx.Internal.Compatible
 import Cardano.Api.Experimental.Tx.Internal.Fee
 import Cardano.Api.Tx.Internal.Fee (evaluateTransactionExecutionUnitsShelley)