Skip to content

Commit

Permalink
Merge pull request #321 from input-output-hk/td/ledger-and-consensus-…
Browse files Browse the repository at this point in the history
…for-8.6

Integrate latest ledger and ouroboros-consensus for 8.6
  • Loading branch information
newhoggy committed Oct 27, 2023
2 parents 5e8bd69 + d8a6063 commit cd2fd28
Show file tree
Hide file tree
Showing 15 changed files with 169 additions and 105 deletions.
2 changes: 1 addition & 1 deletion .github/workflows/haskell.yml
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ jobs:

env:
# Modify this value to "invalidate" the cabal cache.
CABAL_CACHE_VERSION: "2023-10-23"
CABAL_CACHE_VERSION: "2023-10-27"

concurrency:
group: >
Expand Down
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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-10-23T08:59:58Z
, cardano-haskell-packages 2023-10-26T16:30:55Z

packages:
cardano-api
Expand Down
49 changes: 24 additions & 25 deletions cardano-api/cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -149,17 +149,17 @@ library internal
, cardano-crypto-class ^>= 2.1.2
, cardano-crypto-wrapper ^>= 1.5
, cardano-data >= 1.0
, cardano-ledger-alonzo >= 1.3.1.1
, cardano-ledger-allegra >= 1.2.0.2
, cardano-ledger-api >= 1.3
, cardano-ledger-babbage >= 1.4.0.1
, cardano-ledger-alonzo >= 1.5.0
, cardano-ledger-allegra >= 1.2.3.1
, cardano-ledger-api ^>= 1.7
, cardano-ledger-babbage >= 1.5.0
, cardano-ledger-binary
, cardano-ledger-byron >= 1.0.0.2
, cardano-ledger-conway >= 1.5
, cardano-ledger-core >= 1.4
, cardano-ledger-conway >= 1.10.0
, cardano-ledger-core >= 1.8.0
, cardano-ledger-mary >= 1.3.0.2
, cardano-ledger-shelley >= 1.4.1.0
, cardano-protocol-tpraos >= 1.0.3.3
, cardano-ledger-shelley >= 1.7.0
, cardano-protocol-tpraos >= 1.0.3.6
, cardano-slotting >= 0.1
, cardano-strict-containers >= 0.1
, cborg
Expand All @@ -177,18 +177,18 @@ library internal
, mtl
, network
, optparse-applicative-fork
, ouroboros-consensus ^>= 0.12
, ouroboros-consensus-cardano ^>= 0.10
, ouroboros-consensus-diffusion ^>= 0.8.0.1
, ouroboros-consensus-protocol ^>= 0.5.0.7
, ouroboros-consensus ^>= 0.13
, ouroboros-consensus-cardano ^>= 0.11
, ouroboros-consensus-diffusion ^>= 0.8.0.2
, ouroboros-consensus-protocol ^>= 0.6
, ouroboros-network
, ouroboros-network-api
, ouroboros-network-framework
, ouroboros-network-protocols
, parsec
, plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.11
, plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.15
, prettyprinter
, prettyprinter-configurable ^>= 1.11
, prettyprinter-configurable ^>= 1.15
, random
, scientific
, serialise
Expand Down Expand Up @@ -261,12 +261,11 @@ library gen
, cardano-binary >= 1.6 && < 1.8
, cardano-crypto-class ^>= 2.1.2
, cardano-crypto-test ^>= 1.5
, cardano-ledger-alonzo >= 1.3.1.1
, cardano-ledger-alonzo-test
, cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.5.0
, cardano-ledger-byron-test >= 1.5
, cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4
, cardano-ledger-shelley >= 1.4.1.0
, cardano-ledger-conway:testlib >= 1.5
, cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8.0
, cardano-ledger-shelley >= 1.7.0
, cardano-ledger-conway:testlib >= 1.10.0
, containers
, filepath
, hedgehog >= 1.1
Expand All @@ -292,8 +291,8 @@ test-suite cardano-api-test
, cardano-crypto-class ^>= 2.1.2
, cardano-crypto-test ^>= 1.5
, cardano-crypto-tests ^>= 2.1
, cardano-ledger-api >= 1.3
, cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4
, cardano-ledger-api ^>= 1.7
, cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8
, containers
, directory
, hedgehog >= 1.1
Expand Down Expand Up @@ -341,8 +340,8 @@ test-suite cardano-api-golden
, cardano-crypto-class ^>= 2.1.2
, cardano-data >= 1.0
, cardano-ledger-alonzo
, cardano-ledger-api >= 1.3
, cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4
, cardano-ledger-api ^>= 1.7
, cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8
, cardano-ledger-shelley
, cardano-ledger-shelley-test >= 1.2.0.1
, cardano-slotting ^>= 0.1
Expand All @@ -352,8 +351,8 @@ test-suite cardano-api-golden
, hedgehog >= 1.1
, hedgehog-extras ^>= 0.4.7.0
, microlens
, plutus-core ^>= 1.11
, plutus-ledger-api ^>= 1.11
, plutus-core ^>= 1.15
, plutus-ledger-api ^>= 1.15
, tasty
, tasty-hedgehog
, time
Expand Down
13 changes: 5 additions & 8 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -160,7 +160,7 @@ import Test.Gen.Cardano.Api.Metadata (genTxMetadata)

import Test.Cardano.Chain.UTxO.Gen (genVKWitness)
import Test.Cardano.Crypto.Gen (genProtocolMagicId)
import qualified Test.Cardano.Ledger.Alonzo.PlutusScripts as Plutus
import Test.Cardano.Ledger.Alonzo.Arbitrary (genValidCostModel)
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Core.Arbitrary ()

Expand Down Expand Up @@ -960,15 +960,12 @@ genUpdateProposal era =

genCostModel :: Gen Alonzo.CostModel
genCostModel = do
let costModelParams = Alonzo.getCostModelParams Plutus.testingCostModelV1
eCostModel <- Alonzo.mkCostModel <$> genPlutusLanguage
<*> mapM (const $ Gen.integral (Range.linear 0 5000)) costModelParams
case eCostModel of
Left err -> error $ "genCostModel: " <> show err
Right cModel -> return cModel
lang <- genPlutusLanguage
cm <- Q.quickcheck (genValidCostModel lang)
pure cm

genPlutusLanguage :: Gen Language
genPlutusLanguage = Gen.element [PlutusV1, PlutusV2]
genPlutusLanguage = Gen.element [PlutusV1, PlutusV2, PlutusV3]

_genCostModels :: Gen (Map AnyPlutusScriptVersion CostModel)
_genCostModels =
Expand Down
10 changes: 6 additions & 4 deletions cardano-api/internal/Cardano/Api/Certificate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -421,16 +421,18 @@ data CommitteeColdkeyResignationRequirements era where
CommitteeColdkeyResignationRequirements
:: ConwayEraOnwards era
-> Ledger.KeyHash Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era))
-> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era)))
-> CommitteeColdkeyResignationRequirements era

makeCommitteeColdkeyResignationCertificate :: ()
=> CommitteeColdkeyResignationRequirements era
-> Certificate era
makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyHash) =
makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyHash anchor) =
ConwayCertificate cOnwards
. Ledger.ConwayTxCertGov
$ Ledger.ConwayResignCommitteeColdKey
(Ledger.KeyHashObj coldKeyHash)
(noInlineMaybeToStrictMaybe anchor)

data DRepUnregistrationRequirements era where
DRepUnregistrationRequirements
Expand Down Expand Up @@ -494,7 +496,7 @@ selectStakeCredential = fmap fromShelleyStakeCredential . \case
Ledger.DelegTxCert sCred _ -> Just sCred
Ledger.RegDepositDelegTxCert sCred _ _ -> Just sCred
Ledger.AuthCommitteeHotKeyTxCert{} -> Nothing
Ledger.ResignCommitteeColdTxCert _ -> Nothing
Ledger.ResignCommitteeColdTxCert _ _ -> Nothing
Ledger.RegDRepTxCert{} -> Nothing
Ledger.UnRegDRepTxCert{} -> Nothing
Ledger.UpdateDRepTxCert{} -> Nothing
Expand Down Expand Up @@ -523,7 +525,7 @@ filterUnRegCreds = fmap fromShelleyStakeCredential . \case
Ledger.DelegTxCert _ _ -> Nothing
Ledger.RegDepositDelegTxCert{} -> Nothing
Ledger.AuthCommitteeHotKeyTxCert{} -> Nothing
Ledger.ResignCommitteeColdTxCert _ -> Nothing
Ledger.ResignCommitteeColdTxCert _ _ -> Nothing
Ledger.RegDRepTxCert{} -> Nothing
Ledger.UnRegDRepTxCert{} -> Nothing
Ledger.UpdateDRepTxCert{} -> Nothing
Expand All @@ -544,7 +546,7 @@ filterUnRegDRepCreds = \case
Ledger.DelegTxCert _ _ -> Nothing
Ledger.RegDepositDelegTxCert{} -> Nothing
Ledger.AuthCommitteeHotKeyTxCert{} -> Nothing
Ledger.ResignCommitteeColdTxCert _ -> Nothing
Ledger.ResignCommitteeColdTxCert _ _ -> Nothing
Ledger.RegDRepTxCert{} -> Nothing
Ledger.UnRegDRepTxCert cred _ -> Just cred
Ledger.UpdateDRepTxCert{} -> Nothing
Expand Down
2 changes: 1 addition & 1 deletion cardano-api/internal/Cardano/Api/Convenience/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -34,8 +34,8 @@ import Cardano.Api.Utils
import Cardano.Api.Value

import qualified Cardano.Ledger.Api as L
import Cardano.Ledger.CertState (DRepState (..))
import qualified Cardano.Ledger.Credential as L
import Cardano.Ledger.DRepDistr (DRepState (..))
import qualified Cardano.Ledger.Keys as L
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..))

Expand Down
14 changes: 4 additions & 10 deletions cardano-api/internal/Cardano/Api/Ledger/Lens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,8 @@

module Cardano.Api.Ledger.Lens
( strictMaybeL
, invalidBeforeL
, invalidHereAfterL
, L.invalidBeforeL
, L.invalidHereAfterL
, invalidBeforeStrictL
, invalidHereAfterStrictL
, invalidBeforeTxBodyL
Expand Down Expand Up @@ -35,7 +35,7 @@ strictMaybeL = lens g s
s _ = maybe SNothing SJust

invalidBeforeTxBodyL :: AllegraEraOnwards era -> Lens' (L.TxBody (ShelleyLedgerEra era)) (Maybe SlotNo)
invalidBeforeTxBodyL w = allegraEraOnwardsConstraints w $ L.vldtTxBodyL . invalidBeforeL
invalidBeforeTxBodyL w = allegraEraOnwardsConstraints w $ L.vldtTxBodyL . L.invalidBeforeL

-- | Compatibility lens that provides a consistent interface over 'ttlTxBodyL' and
-- 'vldtTxBodyL . invalidHereAfterStrictL' across all shelley based eras.
Expand All @@ -56,7 +56,7 @@ invalidHereAfterTxBodyL :: ShelleyBasedEra era -> Lens' (L.TxBody (ShelleyLedger
invalidHereAfterTxBodyL =
caseShelleyEraOnlyOrAllegraEraOnwards
ttlAsInvalidHereAfterTxBodyL
(const $ L.vldtTxBodyL . invalidHereAfterL)
(const $ L.vldtTxBodyL . L.invalidHereAfterL)

-- | Compatibility lens over 'ttlTxBodyL' which represents 'maxBound' as Nothing and all other values as 'Just'.
ttlAsInvalidHereAfterTxBodyL :: ShelleyEraOnly era -> Lens' (L.TxBody (ShelleyLedgerEra era)) (Maybe SlotNo)
Expand All @@ -74,12 +74,6 @@ ttlAsInvalidHereAfterTxBodyL w = lens (g w) (s w)
Nothing -> txBody & L.ttlTxBodyL .~ maxBound
Just ttl -> txBody & L.ttlTxBodyL .~ ttl

invalidBeforeL :: Lens' L.ValidityInterval (Maybe SlotNo)
invalidBeforeL = invalidBeforeStrictL . strictMaybeL

invalidHereAfterL :: Lens' L.ValidityInterval (Maybe SlotNo)
invalidHereAfterL = invalidHereAfterStrictL . strictMaybeL

-- | Lens to access the 'invalidBefore' field of a 'ValidityInterval' as a 'StrictMaybe SlotNo'.
-- Ideally this should be defined in cardano-ledger
invalidBeforeStrictL :: Lens' L.ValidityInterval (StrictMaybe SlotNo)
Expand Down
3 changes: 2 additions & 1 deletion cardano-api/internal/Cardano/Api/Orphans.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ import qualified Cardano.Ledger.Conway.PParams as Ledger
import Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import qualified Cardano.Ledger.Crypto as Crypto
import Cardano.Ledger.HKD (NoUpdate (..))
import qualified Cardano.Ledger.Shelley.PParams as Ledger
import qualified Cardano.Protocol.TPraos.API as Ledger
import Cardano.Protocol.TPraos.BHeader (HashHeader (..))
Expand Down Expand Up @@ -313,7 +314,7 @@ instance Semigroup (Ledger.ConwayPParams StrictMaybe era) where
, Ledger.cppA0 = lastMappendWith Ledger.cppA0 p1 p2
, Ledger.cppRho = lastMappendWith Ledger.cppRho p1 p2
, Ledger.cppTau = lastMappendWith Ledger.cppTau p1 p2
, Ledger.cppProtocolVersion = lastMappendWith Ledger.cppProtocolVersion p1 p2
, Ledger.cppProtocolVersion = NoUpdate -- For conway, protocol version cannot be changed via `PParamsUpdate`
, Ledger.cppMinPoolCost = lastMappendWith Ledger.cppMinPoolCost p1 p2
, Ledger.cppCoinsPerUTxOByte = lastMappendWith Ledger.cppCoinsPerUTxOByte p1 p2
, Ledger.cppCostModels = lastMappendWith Ledger.cppCostModels p1 p2
Expand Down
Loading

0 comments on commit cd2fd28

Please sign in to comment.