Merge remote-tracking branch 'origin/HEAD' into mgalazyn/feature/add-…

…witness-committe-cold-key
IntersectMBO · Oct 2, 2023 · 2bb435e · 2bb435e
2 parents b2cffec + 8a7542a
commit 2bb435e
Show file tree

Hide file tree

Showing 14 changed files with 212 additions and 236 deletions.
diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md
@@ -40,7 +40,6 @@ to the issue.
   - [ ] Code is linted with `hlint`.  See `.github/workflows/check-hlint.yml` to get the `hlint` version
   - [ ] Code is formatted with `stylish-haskell`.  See `.github/workflows/stylish-haskell.yml` to get the `stylish-haskell` version
   - [ ] Code builds on Linux, MacOS and Windows for `ghc-8.10.7` and `ghc-9.2.7`
-- [ ] The changelog section in the PR is updated to describe the change
 - [ ] Self-reviewed the diff
 
 <!-- 

diff --git a/cabal.project b/cabal.project
@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2023-08-06T23:58:58Z
-  , cardano-haskell-packages 2023-09-07T15:55:30Z
+  , cardano-haskell-packages 2023-09-28T08:17:07Z
 
 packages:
     cardano-api
@@ -41,4 +41,3 @@ write-ghc-environment-files: always
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
-
diff --git a/cardano-api/CHANGELOG.md b/cardano-api/CHANGELOG.md
@@ -1,11 +1,22 @@
 # Changelog for cardano-api
 
-# 8.23.1.0
+## 8.24.0.0
+
+- Expose Conway drep registration certificate anchor
+  (breaking, improvement)
+  [PR 284](https://github.com/input-output-hk/cardano-api/pull/284)
+
+- Add support for conway era protocol parameters.
+  Adapted `GenesisCardano` to upstream Ledger/Consensus changes.
+  (feature, breaking)
+  [PR 270](https://github.com/input-output-hk/cardano-api/pull/270)
+
+## 8.23.1.0
 
 - Parameterize `AnyEraInEon`. Add `AnyEon`
   (breaking)
 
-# 8.23.0.0
+## 8.23.0.0
 
 - New `caseAlonzoOnlyOrBabbageEraOnwards` and `alonzoEraOnlyToAlonzoEraOnwards` functions
   (feature, compatible)

diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -1,7 +1,7 @@
 cabal-version: 3.4
 
 name:                   cardano-api
-version:                8.23.1.0
+version:                8.24.0.0
 synopsis:               The cardano api
 description:            The cardano api.
 category:               Cardano,
@@ -175,18 +175,18 @@ library internal
                       , mtl
                       , network
                       , optparse-applicative-fork
-                      , ouroboros-consensus >= 0.9
-                      , ouroboros-consensus-cardano >= 0.8
-                      , ouroboros-consensus-diffusion >= 0.7
-                      , ouroboros-consensus-protocol >= 0.5.0.4
+                      , ouroboros-consensus ^>= 0.12
+                      , ouroboros-consensus-cardano ^>= 0.10
+                      , ouroboros-consensus-diffusion ^>= 0.8.0.1
+                      , ouroboros-consensus-protocol ^>= 0.5.0.7
                       , ouroboros-network
                       , ouroboros-network-api
                       , ouroboros-network-framework
                       , ouroboros-network-protocols
                       , parsec
-                      , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.9
+                      , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.11
                       , prettyprinter
-                      , prettyprinter-configurable ^>= 1.9
+                      , prettyprinter-configurable ^>= 1.11
                       , random
                       , scientific
                       , serialise
@@ -350,8 +350,8 @@ test-suite cardano-api-golden
                       , hedgehog >= 1.1
                       , hedgehog-extras ^>= 0.4.7.0
                       , microlens
-                      , plutus-core ^>= 1.9
-                      , plutus-ledger-api ^>= 1.9
+                      , plutus-core ^>= 1.11
+                      , plutus-ledger-api ^>= 1.11
                       , tasty
                       , tasty-hedgehog
                       , time

diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs
@@ -89,8 +89,11 @@ import qualified Cardano.Api.ReexposeLedger as Ledger
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.StakePoolMetadata
+import           Cardano.Api.Utils (noInlineMaybeToStrictMaybe)
 import           Cardano.Api.Value
 
+import qualified Cardano.Ledger.Conway.Governance as Ledger
+
 import           Data.ByteString (ByteString)
 import qualified Data.Foldable as Foldable
 import           Data.IP (IPv4, IPv6)
@@ -588,14 +591,15 @@ data DRepRegistrationRequirements era where
 
 makeDrepRegistrationCertificate :: ()
   => DRepRegistrationRequirements era
+  -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
   -> Certificate era
-makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards (VotingCredential vcred) deposit) =
+makeDrepRegistrationCertificate (DRepRegistrationRequirements conwayOnwards (VotingCredential vcred) deposit) anchor =
   ConwayCertificate conwayOnwards
     . Ledger.ConwayTxCertGov
     $ Ledger.ConwayRegDRep
         vcred
         (toShelleyLovelace deposit)
-        Ledger.SNothing   -- TODO: Conway era
+        (noInlineMaybeToStrictMaybe anchor)
 
 data CommitteeHotKeyAuthorizationRequirements era where
   CommitteeHotKeyAuthorizationRequirements

diff --git a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs
@@ -34,6 +34,7 @@ import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Conway.Core as L
 import qualified Cardano.Ledger.Conway.Governance as L
+import qualified Cardano.Ledger.Conway.PParams as L
 import qualified Cardano.Ledger.Conway.TxCert as L
 import qualified Cardano.Ledger.SafeHash as L
 import qualified Cardano.Ledger.UTxO as L

diff --git a/cardano-api/internal/Cardano/Api/Eras/Core.hs b/cardano-api/internal/Cardano/Api/Eras/Core.hs
@@ -155,7 +155,7 @@ forEraMaybeEon =
 
 maybeEon ::
   ( Eon eon
-  , IsCardanoEra era  -- ^ Era to check
+  , IsCardanoEra era      -- ^ Era to check
   ) => Maybe (eon era)    -- ^ The eon if supported in the era
 maybeEon =
   inEonForEra Nothing Just cardanoEra

diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
@@ -81,19 +81,15 @@ toGovernanceAction _ (ProposeNewConstitution prevGovAction anchor) =
     , Gov.constitutionScript = SNothing   -- TODO: Conway era
     }
 toGovernanceAction _ (ProposeNewCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor) =
-  Gov.NewCommittee
-    prevGovId
-    (Set.fromList $ map toCommitteeMember oldCommitteeMembers)
-    Gov.Committee
-      { Gov.committeeMembers = Map.mapKeys toCommitteeMember newCommitteeMembers
-      , Gov.committeeQuorum =
-            fromMaybe
-              (error $ mconcat ["toGovernanceAction: the given quorum "
+  Gov.UpdateCommittee
+    prevGovId -- previous governance action id
+    (Set.fromList $ map toCommitteeMember oldCommitteeMembers) -- members to remove
+    (Map.mapKeys toCommitteeMember newCommitteeMembers) -- members to add
+    (fromMaybe (error $ mconcat ["toGovernanceAction: the given quorum "
                                , show quor
                                , " was outside of the unit interval!"
                                ])
-          $ boundRational @UnitInterval quor
-       }
+          $ boundRational @UnitInterval quor)
 toGovernanceAction _ InfoAct = Gov.InfoAction
 toGovernanceAction _ (TreasuryWithdrawal withdrawals) =
   let m = Map.fromList [(L.mkRwdAcnt nw (toShelleyStakeCredential sc), toShelleyLovelace l) | (nw,sc,l) <- withdrawals]
@@ -124,16 +120,12 @@ fromGovernanceAction sbe = \case
               | (rwdAcnt, coin) <- Map.toList withdrawlMap
               ]
     in TreasuryWithdrawal res
-  Gov.NewCommittee prevGovId oldCommitteeMembers newCommittee ->
-    let Gov.Committee
-          { Gov.committeeMembers = newCommitteeMembers
-          , Gov.committeeQuorum = quor
-          } = newCommittee
-    in ProposeNewCommittee
-         prevGovId
-         (map fromCommitteeMember $ Set.toList oldCommitteeMembers)
-         (Map.mapKeys fromCommitteeMember newCommitteeMembers)
-         (unboundRational quor)
+  Gov.UpdateCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor ->
+    ProposeNewCommittee
+      prevGovId
+      (map fromCommitteeMember $ Set.toList oldCommitteeMembers)
+      (Map.mapKeys fromCommitteeMember newCommitteeMembers)
+      (unboundRational quor)
   Gov.InfoAction ->
     InfoAct
 

diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs
@@ -116,6 +116,8 @@ import qualified Cardano.Crypto.ProtocolMagic
 import qualified Cardano.Crypto.VRF as Crypto
 import qualified Cardano.Crypto.VRF.Class as VRF
 import           Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
+import qualified Cardano.Ledger.Api.Era as Ledger
+import qualified Cardano.Ledger.Api.Transition as Ledger
 import           Cardano.Ledger.BaseTypes (Globals (..), Nonce, ProtVer (..), natVersion, (⭒))
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import qualified Cardano.Ledger.BHeaderView as Ledger
@@ -126,7 +128,6 @@ import qualified Cardano.Ledger.PoolDistr as SL
 import qualified Cardano.Ledger.Shelley.API as ShelleyAPI
 import qualified Cardano.Ledger.Shelley.Core as Core
 import qualified Cardano.Ledger.Shelley.Genesis as Ledger
-import           Cardano.Ledger.Shelley.Translation (emptyFromByronTranslationContext)
 import qualified Cardano.Protocol.TPraos.API as TPraos
 import           Cardano.Protocol.TPraos.BHeader (checkLeaderNatValue)
 import qualified Cardano.Protocol.TPraos.BHeader as TPraos
@@ -156,7 +157,6 @@ import           Ouroboros.Consensus.Protocol.Abstract (ChainDepState, Consensus
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import           Ouroboros.Consensus.Protocol.Praos.VRF (mkInputVRF, vrfLeaderValue)
-import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos
 import qualified Ouroboros.Consensus.Shelley.Eras as Shelley
 import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Shelley
@@ -760,18 +760,18 @@ genesisConfigToEnv
   -- enp
   genCfg =
     case genCfg of
-      GenesisCardano _ bCfg sCfg _ _
-        | Cardano.Crypto.ProtocolMagic.unProtocolMagicId (Cardano.Chain.Genesis.configProtocolMagicId bCfg) /= Ledger.sgNetworkMagic (scConfig sCfg) ->
+      GenesisCardano _ bCfg _ transCfg
+        | Cardano.Crypto.ProtocolMagic.unProtocolMagicId (Cardano.Chain.Genesis.configProtocolMagicId bCfg) /= Ledger.sgNetworkMagic shelleyGenesis ->
             Left . NECardanoConfig $
               mconcat
                 [ "ProtocolMagicId ", textShow (Cardano.Crypto.ProtocolMagic.unProtocolMagicId $ Cardano.Chain.Genesis.configProtocolMagicId bCfg)
-                , " /= ", textShow (Ledger.sgNetworkMagic $ scConfig sCfg)
+                , " /= ", textShow (Ledger.sgNetworkMagic shelleyGenesis)
                 ]
-        | Cardano.Chain.Genesis.gdStartTime (Cardano.Chain.Genesis.configGenesisData bCfg) /= Ledger.sgSystemStart (scConfig sCfg) ->
+        | Cardano.Chain.Genesis.gdStartTime (Cardano.Chain.Genesis.configGenesisData bCfg) /= Ledger.sgSystemStart shelleyGenesis ->
             Left . NECardanoConfig $
               mconcat
                 [ "SystemStart ", textShow (Cardano.Chain.Genesis.gdStartTime $ Cardano.Chain.Genesis.configGenesisData bCfg)
-                , " /= ", textShow (Ledger.sgSystemStart $ scConfig sCfg)
+                , " /= ", textShow (Ledger.sgSystemStart shelleyGenesis)
                 ]
         | otherwise ->
             let
@@ -781,6 +781,8 @@ genesisConfigToEnv
                   { envLedgerConfig = Consensus.topLevelConfigLedger topLevelConfig
                   , envProtocolConfig = Consensus.topLevelConfigProtocol topLevelConfig
                   }
+        where
+          shelleyGenesis = transCfg ^. Ledger.tcShelleyGenesisL
 
 readNodeConfig :: NodeConfigFile 'In -> ExceptT Text IO NodeConfig
 readNodeConfig (File ncf) = do
@@ -804,23 +806,7 @@ data NodeConfig = NodeConfig
   , ncConwayGenesisHash :: !GenesisHashConway
   , ncRequiresNetworkMagic :: !Cardano.Crypto.RequiresNetworkMagic
   , ncByronProtocolVersion :: !Cardano.Chain.Update.ProtocolVersion
-
-  -- Per-era parameters for the hardfok transitions:
-  , ncByronToShelley   :: !(Consensus.ProtocolTransitionParams
-                              Byron.ByronBlock
-                              (Shelley.ShelleyBlock (TPraos Shelley.StandardCrypto) Shelley.StandardShelley)
-                           )
-  , ncShelleyToAllegra :: !(Consensus.ProtocolTransitionParams
-                              (Shelley.ShelleyBlock (TPraos Shelley.StandardCrypto) Shelley.StandardShelley)
-                              (Shelley.ShelleyBlock (TPraos Shelley.StandardCrypto) Shelley.StandardAllegra)
-                           )
-  , ncAllegraToMary    :: !(Consensus.ProtocolTransitionParams
-                              (Shelley.ShelleyBlock (TPraos Shelley.StandardCrypto) Shelley.StandardAllegra)
-                              (Shelley.ShelleyBlock (TPraos Shelley.StandardCrypto) Shelley.StandardMary)
-                           )
-  , ncMaryToAlonzo     :: !Consensus.TriggerHardFork
-  , ncAlonzoToBabbage  :: !Consensus.TriggerHardFork
-  , ncBabbageToConway  :: !Consensus.TriggerHardFork
+  , ncHardForkTriggers :: !Consensus.CardanoHardForkTriggers
   }
 
 instance FromJSON NodeConfig where
@@ -841,15 +827,7 @@ instance FromJSON NodeConfig where
           <*> fmap GenesisHashConway (o .: "ConwayGenesisHash")
           <*> o .: "RequiresNetworkMagic"
           <*> parseByronProtocolVersion o
-          <*> (Consensus.ProtocolTransitionParamsByronToShelley emptyFromByronTranslationContext
-                 <$> parseShelleyHardForkEpoch o)
-          <*> (Consensus.ProtocolTransitionParamsIntraShelley ()
-                 <$> parseAllegraHardForkEpoch o)
-          <*> (Consensus.ProtocolTransitionParamsIntraShelley ()
-                 <$> parseMaryHardForkEpoch o)
-          <*> parseAlonzoHardForkEpoch o
-          <*> parseBabbageHardForkEpoch o
-          <*> parseConwayHardForkEpoch o
+          <*> parseHardForkTriggers o
 
       parseByronProtocolVersion :: Object -> Parser Cardano.Chain.Update.ProtocolVersion
       parseByronProtocolVersion o =
@@ -858,6 +836,16 @@ instance FromJSON NodeConfig where
           <*> o .: "LastKnownBlockVersion-Minor"
           <*> o .: "LastKnownBlockVersion-Alt"
 
+      parseHardForkTriggers :: Object -> Parser Consensus.CardanoHardForkTriggers
+      parseHardForkTriggers o =
+        Consensus.CardanoHardForkTriggers'
+          <$> parseShelleyHardForkEpoch o
+          <*> parseAllegraHardForkEpoch o
+          <*> parseMaryHardForkEpoch o
+          <*> parseAlonzoHardForkEpoch o
+          <*> parseBabbageHardForkEpoch o
+          <*> parseConwayHardForkEpoch o
+
       parseShelleyHardForkEpoch :: Object -> Parser Consensus.TriggerHardFork
       parseShelleyHardForkEpoch o =
         asum
@@ -982,9 +970,8 @@ data GenesisConfig
   = GenesisCardano
       !NodeConfig
       !Cardano.Chain.Genesis.Config
-      !ShelleyConfig
-      !AlonzoGenesis
-      !(ConwayGenesis Shelley.StandardCrypto)
+      !GenesisHashShelley
+      !(Ledger.TransitionConfig (Ledger.LatestKnownEra Shelley.StandardCrypto))
 
 newtype LedgerStateDir = LedgerStateDir
   {  unLedgerStateDir :: FilePath
@@ -1003,7 +990,7 @@ mkProtocolInfoCardano ::
             (Consensus.CardanoEras Consensus.StandardCrypto))
   , IO [BlockForging IO (HFC.HardForkBlock
                               (Consensus.CardanoEras Consensus.StandardCrypto))])
-mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesis alonzoGenesis conwayGenesis)
+mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesisHash transCfg)
   = Consensus.protocolInfoCardano Consensus.CardanoProtocolParams
       { Consensus.paramsByron =
           Consensus.ProtocolParamsByron
@@ -1016,8 +1003,7 @@ mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesis alonzoGene
             }
       , Consensus.paramsShelleyBased =
           Consensus.ProtocolParamsShelleyBased
-            { Consensus.shelleyBasedGenesis = scConfig shelleyGenesis
-            , Consensus.shelleyBasedInitialNonce = shelleyPraosNonce shelleyGenesis
+            { Consensus.shelleyBasedInitialNonce = shelleyPraosNonce shelleyGenesisHash
             , Consensus.shelleyBasedLeaderCredentials = []
             }
       , Consensus.paramsShelley =
@@ -1050,43 +1036,25 @@ mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesis alonzoGene
             { Consensus.conwayProtVer = ProtVer (natVersion @10) 0
             , Consensus.conwayMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure
             }
-      , Consensus.transitionParamsByronToShelley =
-          ncByronToShelley dnc
-      , Consensus.transitionParamsShelleyToAllegra =
-          ncShelleyToAllegra dnc
-      , Consensus.transitionParamsAllegraToMary =
-          ncAllegraToMary dnc
-      , Consensus.transitionParamsMaryToAlonzo =
-          Consensus.ProtocolTransitionParamsIntraShelley
-            { Consensus.transitionIntraShelleyTranslationContext = alonzoGenesis
-            , Consensus.transitionIntraShelleyTrigger            = ncMaryToAlonzo dnc
-            }
-      , Consensus.transitionParamsAlonzoToBabbage =
-          Consensus.ProtocolTransitionParamsIntraShelley
-            { Consensus.transitionIntraShelleyTranslationContext = ()
-            , Consensus.transitionIntraShelleyTrigger            = ncAlonzoToBabbage dnc
-            }
-      , Consensus.transitionParamsBabbageToConway =
-          Consensus.ProtocolTransitionParamsIntraShelley
-            { Consensus.transitionIntraShelleyTranslationContext = conwayGenesis
-            , Consensus.transitionIntraShelleyTrigger            = ncBabbageToConway dnc
-            }
+      , Consensus.hardForkTriggers = ncHardForkTriggers dnc
+      , Consensus.ledgerTransitionConfig = transCfg
       }
 
--- | Compute the Nonce from the ShelleyGenesis file.
-shelleyPraosNonce :: ShelleyConfig -> Ledger.Nonce
-shelleyPraosNonce sCfg =
-  Ledger.Nonce (Cardano.Crypto.Hash.Class.castHash . unGenesisHashShelley $ scGenesisHash sCfg)
+-- | Compute the Nonce from the hash of the Genesis file.
+shelleyPraosNonce :: GenesisHashShelley -> Ledger.Nonce
+shelleyPraosNonce genesisHash =
+  Ledger.Nonce (Cardano.Crypto.Hash.Class.castHash $ unGenesisHashShelley genesisHash)
 
 readCardanoGenesisConfig
         :: NodeConfig
         -> ExceptT GenesisConfigError IO GenesisConfig
-readCardanoGenesisConfig enc =
-  GenesisCardano enc
-    <$> readByronGenesisConfig enc
-    <*> readShelleyGenesisConfig enc
-    <*> readAlonzoGenesisConfig enc
-    <*> readConwayGenesisConfig enc
+readCardanoGenesisConfig enc = do
+  byronGenesis <- readByronGenesisConfig enc
+  ShelleyConfig shelleyGenesis shelleyGenesisHash <- readShelleyGenesisConfig enc
+  alonzoGenesis <- readAlonzoGenesisConfig enc
+  conwayGenesis <- readConwayGenesisConfig enc
+  let transCfg = Ledger.mkLatestTransitionConfig shelleyGenesis alonzoGenesis conwayGenesis
+  pure $ GenesisCardano enc byronGenesis shelleyGenesisHash transCfg
 
 data GenesisConfigError
   = NEError !Text