Merge pull request #119 from input-output-hk/jordan/incorporate-ledge…

…r-certificates Incorporate remaining ledger certificates
IntersectMBO · Jul 17, 2023 · 7f2718f · 7f2718f
2 parents 1fb9aee + da9be77
commit 7f2718f
Show file tree

Hide file tree

Showing 10 changed files with 712 additions and 488 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -91,6 +91,7 @@ library internal
                         Cardano.Api.ProtocolParameters
                         Cardano.Api.Query
                         Cardano.Api.Query.Expr
+                        Cardano.Api.ReexposeLedger
                         Cardano.Api.Script
                         Cardano.Api.ScriptData
                         Cardano.Api.SerialiseBech32
@@ -193,6 +194,11 @@ library
                         Cardano.Api.ChainSync.ClientPipelined
                         Cardano.Api.Crypto.Ed25519Bip32
                         Cardano.Api.Shelley
+                        -- TODO: Eliminate Cardano.Api.Ledger when 
+                        -- cardano-api only depends on modules 
+                        -- exposed by cardano-api-ledger  
+                        Cardano.Api.Ledger 
+
 
   build-depends:        bytestring
                       , cardano-api:internal

diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
@@ -590,22 +590,43 @@ genTxCertificates :: CardanoEra era -> Gen (TxCertificates BuildTx era)
 genTxCertificates era =
   case certificatesSupportedInEra era of
     Nothing -> pure TxCertificatesNone
-    Just supported -> do
-      certs <- Gen.list (Range.constant 0 3) genCertificate
-      Gen.choice
-        [ pure TxCertificatesNone
-        , pure (TxCertificates supported certs $ BuildTxWith mempty)
-          -- TODO: Generate certificates
-        ]
+    Just supported ->
+      case cardanoEraStyle era of
+        LegacyByronEra -> pure TxCertificatesNone
+        ShelleyBasedEra sbe -> do
+          certs <- Gen.list (Range.constant 0 3) $ genCertificate sbe
+          Gen.choice
+            [ pure TxCertificatesNone
+            , pure (TxCertificates supported certs $ BuildTxWith mempty)
+              -- TODO: Generate certificates
+            ]
 
 -- TODO: Add remaining certificates
-genCertificate :: Gen (Certificate era)
-genCertificate =
+-- TODO: This should be parameterised on ShelleyBasedEra
+genCertificate :: ShelleyBasedEra era -> Gen (Certificate era)
+genCertificate sbe =
   Gen.choice
-    [ StakeAddressRegistrationCertificate <$> genStakeCredential
-    , StakeAddressDeregistrationCertificate <$> genStakeCredential
+    [ makeStakeAddressRegistrationCertificate <$> genStakeAddressRequirements sbe
+    , makeStakeAddressUnregistrationCertificate <$> genStakeAddressRequirements sbe
     ]
 
+genStakeAddressRequirements :: ShelleyBasedEra era -> Gen (StakeAddressRequirements era)
+genStakeAddressRequirements sbe =
+  case sbe of
+    ShelleyBasedEraShelley ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraShelley <$> genStakeCredential
+    ShelleyBasedEraAllegra ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraAllegra <$> genStakeCredential
+    ShelleyBasedEraMary ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraMary <$> genStakeCredential
+    ShelleyBasedEraAlonzo ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraAlonzo <$> genStakeCredential
+    ShelleyBasedEraBabbage ->
+      StakeAddrRegistrationPreConway AtMostBabbageEraBabbage <$> genStakeCredential
+    ShelleyBasedEraConway ->
+      StakeAddrRegistrationConway ConwayEraOnwardsConway <$> genLovelace <*> genStakeCredential
+
+
 genTxUpdateProposal :: CardanoEra era -> Gen (TxUpdateProposal era)
 genTxUpdateProposal era =
   case updateProposalSupportedInEra era of