Add Dijkstra era support to experimental eras

Author: carbolymer

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

@@ -26,6 +26,7 @@ module Cardano.Api.Experimental.Era
   , DeprecatedEra (..)
   , EraCommonConstraints
   , obtainCommonConstraints
+  , obtainConwayConstraints
   , eraToSbe
   , eraToBabbageEraOnwards
   , sbeToEra
@@ -289,7 +290,10 @@ obtainCommonConstraints
   -> a
 obtainCommonConstraints = \case
   ConwayEra -> id
-  _ -> const $ error "obtainCommonConstraints: Dijkstra era not yet supported"
+  DijkstraEra -> id
+
+obtainConwayConstraints :: Era ConwayEra -> (EraConwayConstraints => a) -> a
+obtainConwayConstraints ConwayEra a = a
 
 type EraCommonConstraints era =
   ( L.AllegraEraScript (LedgerEra era)
@@ -298,7 +302,6 @@ type EraCommonConstraints era =
   , L.BabbageEraTxBody (LedgerEra era)
   , L.ConwayEraTxBody (LedgerEra era)
   , L.ConwayEraTxCert (LedgerEra era)
-  , L.TxCert (LedgerEra era) ~ L.ConwayTxCert (LedgerEra era)
   , L.Era (LedgerEra era)
   , L.EraScript (LedgerEra era)
   , L.EraTx (LedgerEra era)
@@ -308,11 +311,16 @@ type EraCommonConstraints era =
   , FromCBOR (ChainDepState (ConsensusProtocol era))
   , L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era)
   , PraosProtocolSupportsNode (ConsensusProtocol era)
-  , L.ShelleyEraTxCert (LedgerEra era)
   , ShelleyLedgerEra era ~ LedgerEra era
   , ToJSON (ChainDepState (ConsensusProtocol era))
   , L.HashAnnotated (Ledger.TxBody (LedgerEra era)) L.EraIndependentTxBody
   , Api.IsCardanoEra era
   , Api.IsShelleyBasedEra era
   , IsEra era
   )
+
+type EraConwayConstraints =
+  ( EraCommonConstraints ConwayEra
+  , L.TxCert (LedgerEra ConwayEra) ~ L.ConwayTxCert (LedgerEra ConwayEra)
+  , L.ShelleyEraTxCert (LedgerEra ConwayEra)
+  )

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

@@ -83,8 +83,9 @@ instance
     shelleyBasedEraConstraints (shelleyBasedEra @era) $ Certificate <$> CBOR.decodeFull' bs
 
 convertToOldApiCertificate :: Era era -> Certificate (LedgerEra era) -> Api.Certificate era
-convertToOldApiCertificate e (Certificate cert) =
-  obtainCommonConstraints e $ Api.ConwayCertificate (convert e) cert
+convertToOldApiCertificate e@ConwayEra (Certificate cert) =
+  obtainConwayConstraints e $ Api.ConwayCertificate (convert e) cert
+convertToOldApiCertificate DijkstraEra _ = error "Dijkstra era not supported yet"
 
 convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (LedgerEra era)
 convertToNewCertificate era (Api.ConwayCertificate _ cert) =
@@ -113,8 +114,8 @@ getStakeCred
          Api.BuildTx
          (Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era))
      )
-getStakeCred e (Certificate cert, witness) = do
-  let oldApiCert = obtainCommonConstraints e $ Api.ConwayCertificate (convert e) cert
+getStakeCred e@ConwayEra (Certificate cert, witness) = do
+  let oldApiCert = obtainConwayConstraints e $ Api.ConwayCertificate (convert e) cert
       mStakeCred = Api.selectStakeCredentialWitness oldApiCert
       wit =
         case witness of
@@ -127,6 +128,7 @@ getStakeCred e (Certificate cert, witness) = do
             Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
               newToOldPlutusCertificateScriptWitness e psw
   (oldApiCert, pure $ (,wit) <$> mStakeCred)
+getStakeCred DijkstraEra _ = error "Dijkstra era not supported yet"
 
 newToOldSimpleScriptWitness
   :: L.AllegraEraScript (LedgerEra era)

cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs

@@ -64,6 +64,8 @@ module Cardano.Api.Ledger.Internal.Reexport
   , fromEraCBOR
   , ppMinFeeAL
   , ppMinUTxOValueL
+  -- Dijkstra
+  , DijkstraPlutusPurpose (..)
   -- Conway
   , Anchor (..)
   , Committee (..)
@@ -320,6 +322,7 @@ import Cardano.Ledger.Core
   )
 import Cardano.Ledger.Credential (Credential (..), credToText)
 import Cardano.Ledger.DRep (DRep (..), drepAnchorL, drepDepositL, drepExpiryL)
+import Cardano.Ledger.Dijkstra.Scripts (DijkstraPlutusPurpose (..))
 import Cardano.Ledger.Hashes
   ( ADDRHASH
   , SafeHash
@@ -339,7 +342,6 @@ import Cardano.Ledger.Keys
 import Cardano.Ledger.Mary.Value (MultiAsset (..))
 import Cardano.Ledger.Plutus.Data (Data (..), unData)
 import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary)
-import Cardano.Ledger.State (PoolMetadata (..), PoolParams (..), StakePoolRelay (..))
 import Cardano.Ledger.Shelley.API
   ( ChainAccountState (..)
   , GenDelegPair (..)
@@ -348,7 +350,6 @@ import Cardano.Ledger.Shelley.API
   , WitVKey (..)
   , hashKey
   , hashVerKeyVRF
-  , ChainAccountState (..)
   )
 import Cardano.Ledger.Shelley.Genesis
   ( ShelleyGenesisStaking (..)
@@ -365,6 +366,7 @@ import Cardano.Ledger.Shelley.TxCert
   , ShelleyEraTxCert (..)
   , ShelleyTxCert (..)
   )
+import Cardano.Ledger.State (PoolMetadata (..), PoolParams (..), StakePoolRelay (..))
 import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
 import Cardano.Protocol.Crypto (Crypto, StandardCrypto)
 import Cardano.Slotting.Slot (EpochNo (..))

cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs

@@ -395,12 +395,12 @@ newtype PoolState era = PoolState L.QueryPoolStateResult
 
 decodePoolState
   :: forall era
-   . ()
-  => Core.Era (ShelleyLedgerEra era)
-  => SerialisedPoolState
+   . ShelleyBasedEra era
+  -> SerialisedPoolState
   -> Either DecoderError (PoolState era)
-decodePoolState (SerialisedPoolState (Serialised ls)) =
-  PoolState <$> decodeFull (Core.eraProtVerLow @(ShelleyLedgerEra era)) ls
+decodePoolState sbe (SerialisedPoolState (Serialised ls)) =
+  shelleyBasedEraConstraints sbe $
+    PoolState <$> decodeFull (Core.eraProtVerLow @(ShelleyLedgerEra era)) ls
 
 newtype SerialisedPoolDistribution era
   = SerialisedPoolDistribution