Merge pull request #763 from IntersectMBO/jordan/new-scripts-api

Introduce new witness api

Author: Jimbo4350

cardano-api/cardano-api.cabal

@@ -77,8 +77,6 @@ library
     Cardano.Api.Internal.Eon.ShelleyBasedEra
     Cardano.Api.Internal.Eras
     Cardano.Api.Internal.Error
-    Cardano.Api.Internal.Experimental.Eras
-    Cardano.Api.Internal.Experimental.Tx
     Cardano.Api.Internal.Fees
     Cardano.Api.Internal.Genesis
     Cardano.Api.Internal.GenesisParameters
@@ -206,6 +204,15 @@ library
     Cardano.Api.Internal.Eon.ShelleyToMaryEra
     Cardano.Api.Internal.Eras.Case
     Cardano.Api.Internal.Eras.Core
+    Cardano.Api.Internal.Experimental.Eras
+    Cardano.Api.Internal.Experimental.Plutus.IndexedPlutusScriptWitness
+    Cardano.Api.Internal.Experimental.Plutus.Script
+    Cardano.Api.Internal.Experimental.Plutus.ScriptWitness
+    Cardano.Api.Internal.Experimental.Plutus.Shim.LegacyScripts
+    Cardano.Api.Internal.Experimental.Simple.Script
+    Cardano.Api.Internal.Experimental.Tx
+    Cardano.Api.Internal.Experimental.Witness.AnyWitness
+    Cardano.Api.Internal.Experimental.Witness.TxScriptWitnessRequirements
     Cardano.Api.Internal.Feature
     Cardano.Api.Internal.Governance.Actions.ProposalProcedure
     Cardano.Api.Internal.Governance.Actions.VotingProcedure
@@ -255,6 +262,7 @@ library
     Cardano.Api.Internal.SerialiseUsing
     Cardano.Api.Internal.SpecialByron
     Cardano.Api.Internal.StakePoolMetadata
+    Cardano.Api.Internal.Tx.BuildTxWith
     Cardano.Api.Internal.Tx.UTxO
     Cardano.Api.Internal.TxIn
     Cardano.Api.Internal.TxMetadata

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

@@ -169,6 +169,7 @@ import qualified Data.ByteString.Base16 as Base16
 import           Data.Ratio (Ratio, (%))
 import           Data.String
 import Test.Gen.Cardano.Api.Hardcoded
+import Data.Typeable
 import           Data.Word (Word16, Word32, Word64)
 import           GHC.Exts (IsList (..))
 import           GHC.Stack
@@ -708,7 +709,7 @@ genTxWithdrawals =
           ]
     )
 
-genTxCertificates :: CardanoEra era -> Gen (TxCertificates BuildTx era)
+genTxCertificates :: Typeable era => CardanoEra era -> Gen (TxCertificates BuildTx era)
 genTxCertificates =
   inEonForEra
     (pure TxCertificatesNone)
@@ -721,7 +722,7 @@ genTxCertificates =
           ]
     )
 
-genCertificate :: forall era. ShelleyBasedEra era -> Gen (Certificate era)
+genCertificate :: forall era. Typeable era => ShelleyBasedEra era -> Gen (Certificate era)
 genCertificate sbe =
   Gen.choice
     $ catMaybes
@@ -878,7 +879,7 @@ genPolicyAssets = do
     (,) <$> genAssetName <*> genPositiveQuantity
   pure $ fromList assetQuantities
 
-genTxBodyContent :: ShelleyBasedEra era -> Gen (TxBodyContent BuildTx era)
+genTxBodyContent :: Typeable era => ShelleyBasedEra era -> Gen (TxBodyContent BuildTx era)
 genTxBodyContent sbe = do
   let era = toCardanoEra sbe
   txIns <-
@@ -999,7 +1000,8 @@ genWitnessesByron = Gen.list (Range.constant 1 10) genByronKeyWitness
 
 -- | This generator validates generated 'TxBodyContent' and backtracks when the generated body
 -- fails the validation. That also means that it is quite slow.
-genValidTxBody :: ShelleyBasedEra era
+genValidTxBody :: Typeable era 
+               => ShelleyBasedEra era
                -> Gen (TxBody era, TxBodyContent BuildTx era) -- ^ validated 'TxBody' and 'TxBodyContent'
 genValidTxBody sbe =
   Gen.mapMaybe
@@ -1010,7 +1012,7 @@ genValidTxBody sbe =
     (genTxBodyContent sbe)
 
 -- | Partial! This function will throw an error when the generated transaction is invalid.
-genTxBody :: HasCallStack => ShelleyBasedEra era -> Gen (TxBody era)
+genTxBody :: (HasCallStack, Typeable era) => ShelleyBasedEra era -> Gen (TxBody era)
 genTxBody era = do
   res <- Api.createTransactionBody era <$> genTxBodyContent era
   case res of
@@ -1049,15 +1051,15 @@ genScriptValidity :: Gen ScriptValidity
 genScriptValidity = Gen.element [ScriptInvalid, ScriptValid]
 
 genTx
-  :: ()
+  :: Typeable era
   => ShelleyBasedEra era
   -> Gen (Tx era)
 genTx era =
   makeSignedTransaction
     <$> genWitnesses era
     <*> (fst <$> genValidTxBody era)
 
-genWitnesses :: ShelleyBasedEra era -> Gen [KeyWitness era]
+genWitnesses :: Typeable era => ShelleyBasedEra era -> Gen [KeyWitness era]
 genWitnesses sbe = do
   bsWits <- Gen.list (Range.constant 0 10) (genShelleyBootstrapWitness sbe)
   keyWits <- Gen.list (Range.constant 0 10) (genShelleyKeyWitness sbe)
@@ -1102,7 +1104,7 @@ genWitnessNetworkIdOrByronAddress =
     ]
 
 genShelleyBootstrapWitness
-  :: ()
+  :: Typeable era
   => ShelleyBasedEra era
   -> Gen (KeyWitness era)
 genShelleyBootstrapWitness sbe =
@@ -1111,8 +1113,10 @@ genShelleyBootstrapWitness sbe =
     <*> (fst <$> genValidTxBody sbe)
     <*> genSigningKey AsByronKey
 
+ 
 genShelleyKeyWitness
   :: ()
+  => Typeable era
   => ShelleyBasedEra era
   -> Gen (KeyWitness era)
 genShelleyKeyWitness sbe =
@@ -1121,7 +1125,7 @@ genShelleyKeyWitness sbe =
     <*> genShelleyWitnessSigningKey
 
 genShelleyWitness
-  :: ()
+  :: Typeable era
   => ShelleyBasedEra era
   -> Gen (KeyWitness era)
 genShelleyWitness sbe =
@@ -1142,7 +1146,7 @@ genShelleyWitnessSigningKey =
     ]
 
 genCardanoKeyWitness
-  :: ()
+  :: Typeable era
   => ShelleyBasedEra era
   -> Gen (KeyWitness era)
 genCardanoKeyWitness = genShelleyWitness

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

@@ -10,6 +10,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- | Certificates embedded in transactions
 module Cardano.Api.Internal.Certificate
@@ -71,6 +72,7 @@ module Cardano.Api.Internal.Certificate
   , AsType (..)
 
     -- * Internal functions
+  , certificateToTxCert
   , filterUnRegCreds
   , filterUnRegDRepCreds
   , isDRepRegOrUpdateCert
@@ -99,6 +101,7 @@ import Cardano.Api.Internal.StakePoolMetadata
 import Cardano.Api.Internal.Utils (noInlineMaybeToStrictMaybe)
 import Cardano.Api.Internal.Value
 
+import Cardano.Ledger.Api qualified as L
 import Cardano.Ledger.BaseTypes (strictMaybe)
 import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Keys qualified as Ledger
@@ -111,6 +114,7 @@ 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)
@@ -129,13 +133,15 @@ data Certificate era where
   --   6. Genesis delegation
   --   7. MIR certificates
   ShelleyRelatedCertificate
-    :: ShelleyToBabbageEra era
+    :: Typeable era
+    => ShelleyToBabbageEra era
     -> Ledger.ShelleyTxCert (ShelleyLedgerEra era)
     -> Certificate era
   -- Conway onwards
   -- TODO: Add comments about the new types of certificates
   ConwayCertificate
-    :: ConwayEraOnwards era
+    :: Typeable era
+    => ConwayEraOnwards era
     -> Ledger.ConwayTxCert (ShelleyLedgerEra era)
     -> Certificate era
   deriving anyclass SerialiseAsCBOR
@@ -146,6 +152,28 @@ 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 Typeable era => HasTypeProxy (Certificate era) where
   data AsType (Certificate era) = AsCertificate
   proxyToAsType _ = AsCertificate
@@ -198,6 +226,20 @@ instance
     ConwayCertificate _ (Ledger.ConwayTxCertPool Ledger.RegPool{}) -> "Pool registration"
     ConwayCertificate _ (Ledger.ConwayTxCertPool Ledger.RetirePool{}) -> "Pool retirement"
 
+certificateToTxCert :: Certificate era -> L.TxCert (ShelleyLedgerEra era)
+certificateToTxCert c =
+  case c of
+    ShelleyRelatedCertificate eon cert ->
+      case eon of
+        ShelleyToBabbageEraShelley -> cert
+        ShelleyToBabbageEraAllegra -> cert
+        ShelleyToBabbageEraMary -> cert
+        ShelleyToBabbageEraAlonzo -> cert
+        ShelleyToBabbageEraBabbage -> cert
+    ConwayCertificate eon cert ->
+      case eon of
+        ConwayEraOnwardsConway -> cert
+
 -- ----------------------------------------------------------------------------
 -- Stake pool parameters
 --
@@ -373,7 +415,8 @@ data GenesisKeyDelegationRequirements era where
     -> Hash VrfKey
     -> GenesisKeyDelegationRequirements era
 
-makeGenesisKeyDelegationCertificate :: GenesisKeyDelegationRequirements era -> Certificate era
+makeGenesisKeyDelegationCertificate
+  :: Typeable era => GenesisKeyDelegationRequirements era -> Certificate era
 makeGenesisKeyDelegationCertificate
   ( GenesisKeyDelegationRequirements
       atMostEra
@@ -394,7 +437,7 @@ data MirCertificateRequirements era where
     -> MirCertificateRequirements era
 
 makeMIRCertificate
-  :: ()
+  :: Typeable era
   => MirCertificateRequirements era
   -> Certificate era
 makeMIRCertificate (MirCertificateRequirements atMostEra mirPot mirTarget) =
@@ -410,7 +453,7 @@ data DRepRegistrationRequirements era where
     -> DRepRegistrationRequirements era
 
 makeDrepRegistrationCertificate
-  :: ()
+  :: Typeable era
   => DRepRegistrationRequirements era
   -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
   -> Certificate era
@@ -427,7 +470,7 @@ data CommitteeHotKeyAuthorizationRequirements era where
     -> CommitteeHotKeyAuthorizationRequirements era
 
 makeCommitteeHotKeyAuthorizationCertificate
-  :: ()
+  :: Typeable era
   => CommitteeHotKeyAuthorizationRequirements era
   -> Certificate era
 makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequirements cOnwards coldKeyCredential hotKeyCredential) =
@@ -443,7 +486,7 @@ data CommitteeColdkeyResignationRequirements era where
     -> CommitteeColdkeyResignationRequirements era
 
 makeCommitteeColdkeyResignationCertificate
-  :: ()
+  :: Typeable era
   => CommitteeColdkeyResignationRequirements era
   -> Certificate era
 makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyCred anchor) =
@@ -461,7 +504,7 @@ data DRepUnregistrationRequirements era where
     -> DRepUnregistrationRequirements era
 
 makeDrepUnregistrationCertificate
-  :: ()
+  :: Typeable era
   => DRepUnregistrationRequirements era
   -> Certificate era
 makeDrepUnregistrationCertificate (DRepUnregistrationRequirements conwayOnwards vcred deposit) =
@@ -488,7 +531,8 @@ data DRepUpdateRequirements era where
     -> DRepUpdateRequirements era
 
 makeDrepUpdateCertificate
-  :: DRepUpdateRequirements era
+  :: Typeable era
+  => DRepUpdateRequirements era
   -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
   -> Certificate era
 makeDrepUpdateCertificate (DRepUpdateRequirements conwayOnwards vcred) mAnchor =

cardano-api/src/Cardano/Api/Internal/Eon/AlonzoEraOnwards.hs

@@ -29,6 +29,7 @@ import Cardano.Binary
 import Cardano.Crypto.Hash.Blake2b qualified as Blake2b
 import Cardano.Crypto.Hash.Class qualified as C
 import Cardano.Crypto.VRF qualified as C
+import Cardano.Ledger.Allegra.Scripts qualified as L
 import Cardano.Ledger.Alonzo.Plutus.Context qualified as Plutus
 import Cardano.Ledger.Alonzo.Scripts qualified as L
 import Cardano.Ledger.Alonzo.Tx qualified as L
@@ -103,6 +104,7 @@ type AlonzoEraOnwardsConstraints era =
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.MaryEraTxBody (ShelleyLedgerEra era)
+  , L.NativeScript (ShelleyLedgerEra era) ~ L.Timelock (ShelleyLedgerEra era)
   , Plutus.EraPlutusContext (ShelleyLedgerEra era)
   , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
   , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)

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

@@ -32,6 +32,7 @@ module Cardano.Api.Internal.Experimental.Eras
   )
 where
 
+import Cardano.Api.Internal.Eon.AlonzoEraOnwards
 import Cardano.Api.Internal.Eon.BabbageEraOnwards
 import Cardano.Api.Internal.Eon.Convert
 import Cardano.Api.Internal.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra)
@@ -219,6 +220,11 @@ instance Convert Era ShelleyBasedEra where
     BabbageEra -> ShelleyBasedEraBabbage
     ConwayEra -> ShelleyBasedEraConway
 
+instance Convert Era AlonzoEraOnwards where
+  convert = \case
+    BabbageEra -> AlonzoEraOnwardsBabbage
+    ConwayEra -> AlonzoEraOnwardsConway
+
 instance Convert Era BabbageEraOnwards where
   convert = \case
     BabbageEra -> BabbageEraOnwardsBabbage