From d574c1cc1532bffbd26d5f5df13af63e574aa615 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 27 Jul 2023 15:03:15 +0200 Subject: [PATCH 01/19] Update the code to UTxO-HD --- ...local.ci.Darwin => cabal.project.local.ci} | 0 .../workflows/cabal.project.local.ci.Linux | 5 - ...bal.project.local.ci.MINGW64_NT-10.0-20348 | 5 - .github/workflows/lmdb.pc | 11 ++ cabal.project | 51 ++++- cardano-api/cardano-api.cabal | 1 + .../internal/Cardano/Api/LedgerState.hs | 184 ++++++++++-------- cardano-api/internal/Cardano/Api/Query.hs | 30 +-- 8 files changed, 180 insertions(+), 107 deletions(-) rename .github/workflows/{cabal.project.local.ci.Darwin => cabal.project.local.ci} (100%) delete mode 100644 .github/workflows/cabal.project.local.ci.Linux delete mode 100644 .github/workflows/cabal.project.local.ci.MINGW64_NT-10.0-20348 create mode 100644 .github/workflows/lmdb.pc diff --git a/.github/workflows/cabal.project.local.ci.Darwin b/.github/workflows/cabal.project.local.ci similarity index 100% rename from .github/workflows/cabal.project.local.ci.Darwin rename to .github/workflows/cabal.project.local.ci diff --git a/.github/workflows/cabal.project.local.ci.Linux b/.github/workflows/cabal.project.local.ci.Linux deleted file mode 100644 index 415a21c29c..0000000000 --- a/.github/workflows/cabal.project.local.ci.Linux +++ /dev/null @@ -1,5 +0,0 @@ -package cardano-crypto-praos - flags: -external-libsodium-vrf - -package HsOpenSSL - flags: +use-pkg-config diff --git a/.github/workflows/cabal.project.local.ci.MINGW64_NT-10.0-20348 b/.github/workflows/cabal.project.local.ci.MINGW64_NT-10.0-20348 deleted file mode 100644 index 415a21c29c..0000000000 --- a/.github/workflows/cabal.project.local.ci.MINGW64_NT-10.0-20348 +++ /dev/null @@ -1,5 +0,0 @@ -package cardano-crypto-praos - flags: -external-libsodium-vrf - -package HsOpenSSL - flags: +use-pkg-config diff --git a/.github/workflows/lmdb.pc b/.github/workflows/lmdb.pc new file mode 100644 index 0000000000..fc4838ed47 --- /dev/null +++ b/.github/workflows/lmdb.pc @@ -0,0 +1,11 @@ +prefix=/usr/local +exec_prefix=${prefix} +libdir=${exec_prefix}/lib +includedir=${exec_prefix}/include + +Name: liblmdb +Description: Lightning Memory-Mapped Database +URL: https://symas.com/products/lightning-memory-mapped-database/ +Version: 0.9.29 +Libs: -L${libdir} -llmdb +Cflags: -I${includedir} \ No newline at end of file diff --git a/cabal.project b/cabal.project index bfb117e447..81fe22b4c7 100644 --- a/cabal.project +++ b/cabal.project @@ -20,10 +20,7 @@ packages: cardano-api cardano-api-gen -package cardano-api - ghc-options: -Werror - -package cardano-api-gen +program-options ghc-options: -Werror package cryptonite @@ -42,3 +39,49 @@ write-ghc-environment-files: always -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. +source-repository-package + type: git + location: https://github.com/jasagredo/latex-svg + tag: 00e10224a96ce73e2a1da8478efb7790cf9ba2b3 + --sha256: 0pb5azww7qj0armldn95pr1vxz30gq51mz8ysmm0a1rgsxm9f3i5 + subdir: + latex-svg-image + +source-repository-package + type: git + location: https://github.com/input-output-hk/quickcheck-dynamic + tag: cf5273faabde55dc8e759e64766e3353439ac1e2 + --sha256: 1achsw9pzrg9lng7xmcnkc6fz1hrl1g8bm4g33lv0vzhrkcy0cl3 + subdir: quickcheck-dynamic + +source-repository-package + type: git + location: https://github.com/well-typed/quickcheck-lockstep + tag: 5125b458af594cb191c8979a3987f1894a96a196 + --sha256: 1mv6ylpksppjdqjjm0bf0pcxlsgk2bgz60i4l4jwl1kdp0zv4iay + +source-repository-package + type: git + location: https://github.com/input-output-hk/anti-diffs + tag: a6b3b7748711c10fc0413cbe6171b42774d08ffa + --sha256: 1cqnqq2zwlrz44iq636ai81f3pfwqjaxrm9n9k7rax5yi3n139xr + subdir: + diff-containers + fingertree-rm + +if impl(ghc >= 9.8) + allow-newer: + cardano-lmdb-simple:bytestring + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + tag: 5b4dd265f8c75a27c51797f114b3ce7e308b72aa + --sha256: 0736i06v6wwl5krlybqiwswy1mn0986zrs904dvc0718424gnb85 + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol + sop-extras + strict-sop-core diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 8dcb438e25..763d982712 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -208,6 +208,7 @@ library internal , safe-exceptions , scientific , serialise + , singletons , small-steps ^>= 1.0 , sop-core , sop-extras diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index 5ab2968fda..2e1ca33b9e 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -10,7 +10,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} - +{-# OPTIONS_GHC -Wno-unused-matches -Wno-unused-top-binds -Wno-unused-imports #-} {- HLINT ignore "Redundant fmap" -} module Cardano.Api.LedgerState @@ -157,6 +157,7 @@ import qualified Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common as import Ouroboros.Consensus.HardFork.Combinator.State.Types import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger import Ouroboros.Consensus.Ledger.Basics (LedgerResult (lrEvents), lrResult) +import qualified Ouroboros.Consensus.Ledger.Basics as Ledger import qualified Ouroboros.Consensus.Ledger.Extended as Ledger import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus @@ -165,9 +166,10 @@ import qualified Ouroboros.Consensus.Protocol.Praos as Consensus import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus import Ouroboros.Consensus.Protocol.Praos.VRF (mkInputVRF, vrfLeaderValue) import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos -import qualified Ouroboros.Consensus.Shelley.Eras as Shelley +import qualified Ouroboros.Consensus.Shelley.Eras as Shelley hiding (StandardCrypto) import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Shelley -import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Shelley +import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Shelley hiding (LedgerState) +import qualified Ouroboros.Consensus.Shelley.Node.Praos as Consensus import Ouroboros.Consensus.TypeFamilyWrappers (WrapLedgerEvent (WrapLedgerEvent)) import Ouroboros.Network.Block (blockNo) import qualified Ouroboros.Network.Block @@ -204,9 +206,12 @@ import qualified Data.Sequence as Seq import Data.Set (Set) import qualified Data.Set as Set import Data.SOP (K (K), (:.:) (Comp)) -import Data.SOP.Strict (NP (..), fn) +import Data.SOP.Constraint +import Data.SOP.Strict (NP (..), fn, hcmap) import Data.SOP.Strict.NS import qualified Data.SOP.Telescope as Telescope +import Data.SOP.Functors (Flip (..)) +--import Data.SOP.Strict (Compose, K (..), NP (..), fn, hcmap, (:.:) (Comp)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -219,6 +224,8 @@ import Lens.Micro import Network.TypedProtocol.Pipelined (Nat (..)) import System.FilePath +--import qualified Legacy.Convert as Legacy + data InitialLedgerStateError = ILSEConfigFile Text -- ^ Failed to read or parse the network config file. @@ -256,7 +263,7 @@ data LedgerStateError | UnexpectedLedgerState AnyShelleyBasedEra -- ^ Expected era - (NS (Current Consensus.LedgerState) (Consensus.CardanoEras Consensus.StandardCrypto)) + (NS (Current (Flip Consensus.LedgerState Ledger.EmptyMK)) (Consensus.CardanoEras Consensus.StandardCrypto)) -- ^ Ledgerstate from an unexpected era | ByronEraUnsupported | DebugError !String @@ -326,37 +333,37 @@ applyBlock env oldState validationMode block ShelleyBasedEraConway -> Consensus.BlockConway shelleyBlock pattern LedgerStateByron - :: Ledger.LedgerState Byron.ByronBlock + :: Ledger.LedgerState Byron.ByronBlock mk -> LedgerState pattern LedgerStateByron st <- LedgerState (Consensus.LedgerStateByron st) pattern LedgerStateShelley - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ShelleyEra Shelley.StandardCrypto)) + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ShelleyEra Consensus.StandardCrypto)) mk -> LedgerState pattern LedgerStateShelley st <- LedgerState (Consensus.LedgerStateShelley st) pattern LedgerStateAllegra - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AllegraEra Shelley.StandardCrypto)) + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AllegraEra Consensus.StandardCrypto)) mk -> LedgerState pattern LedgerStateAllegra st <- LedgerState (Consensus.LedgerStateAllegra st) pattern LedgerStateMary - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.MaryEra Shelley.StandardCrypto)) + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.MaryEra Consensus.StandardCrypto)) mk -> LedgerState pattern LedgerStateMary st <- LedgerState (Consensus.LedgerStateMary st) pattern LedgerStateAlonzo - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AlonzoEra Shelley.StandardCrypto)) + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AlonzoEra Consensus.StandardCrypto)) mk -> LedgerState pattern LedgerStateAlonzo st <- LedgerState (Consensus.LedgerStateAlonzo st) pattern LedgerStateBabbage - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.BabbageEra Shelley.StandardCrypto)) + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.BabbageEra Consensus.StandardCrypto)) mk -> LedgerState pattern LedgerStateBabbage st <- LedgerState (Consensus.LedgerStateBabbage st) pattern LedgerStateConway - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ConwayEra Shelley.StandardCrypto)) + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ConwayEra Consensus.StandardCrypto)) mk -> LedgerState pattern LedgerStateConway st <- LedgerState (Consensus.LedgerStateConway st) @@ -1026,15 +1033,25 @@ readByteString fp cfgType = (liftEither <=< liftIO) $ initLedgerStateVar :: GenesisConfig -> LedgerState initLedgerStateVar genesisConfig = LedgerState - { clsState = Ledger.ledgerState $ Consensus.pInfoInitLedger $ fst protocolInfo + { clsState = + HFC.HardForkLedgerState + $ hcmap + (Proxy @(Compose Ledger.CanStowLedgerTables Ledger.LedgerState)) + (Flip . Ledger.stowLedgerTables . unFlip) + $ HFC.hardForkLedgerStatePerEra + $ Ledger.ledgerState + $ Consensus.pInfoInitLedger + $ fst protocolInfo } where protocolInfo = mkProtocolInfoCardano genesisConfig -newtype LedgerState = LedgerState +data LedgerState = LedgerState { clsState :: Ledger.LedgerState (HFC.HardForkBlock - (Consensus.CardanoEras Consensus.StandardCrypto)) + (Consensus.CardanoEras Consensus.StandardCrypto)) Ledger.EmptyMK + , clsTables :: Ledger.LedgerTables (Ledger.LedgerState (HFC.HardForkBlock + (Consensus.CardanoEras Consensus.StandardCrypto))) Ledger.ValuesMK } deriving Show @@ -1048,7 +1065,7 @@ getAnyNewEpochState sbe (LedgerState ls) = getNewEpochState :: ShelleyBasedEra era - -> Consensus.LedgerState (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) + -> Consensus.LedgerState (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) Ledger.EmptyMK -> Either LedgerStateError (ShelleyAPI.NewEpochState (ShelleyLedgerEra era)) getNewEpochState era x = do let tip = Telescope.tip $ getHardForkState $ HFC.hardForkLedgerStatePerEra x @@ -1057,32 +1074,32 @@ getNewEpochState era x = do ShelleyBasedEraShelley -> case tip of ShelleyLedgerState shelleyCurrent -> - pure $ Shelley.shelleyLedgerState $ currentState shelleyCurrent + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState shelleyCurrent _ -> Left err ShelleyBasedEraAllegra -> case tip of AllegraLedgerState allegraCurrent -> - pure $ Shelley.shelleyLedgerState $ currentState allegraCurrent + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState allegraCurrent _ -> Left err ShelleyBasedEraMary -> case tip of MaryLedgerState maryCurrent -> - pure $ Shelley.shelleyLedgerState $ currentState maryCurrent + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState maryCurrent _ -> Left err ShelleyBasedEraAlonzo -> case tip of AlonzoLedgerState alonzoCurrent -> - pure $ Shelley.shelleyLedgerState $ currentState alonzoCurrent + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState alonzoCurrent _ -> Left err ShelleyBasedEraBabbage -> case tip of BabbageLedgerState babbageCurrent -> - pure $ Shelley.shelleyLedgerState $ currentState babbageCurrent + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState babbageCurrent _ -> Left err ShelleyBasedEraConway -> case tip of ConwayLedgerState conwayCurrent -> - pure $ Shelley.shelleyLedgerState $ currentState conwayCurrent + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState conwayCurrent _ -> Left err {-# COMPLETE ShelleyLedgerState, @@ -1094,81 +1111,81 @@ getNewEpochState era x = do #-} pattern ShelleyLedgerState - :: Current Consensus.LedgerState (Shelley.ShelleyBlock (TPraos.TPraos Shelley.StandardCrypto) (Shelley.ShelleyEra Shelley.StandardCrypto)) - -> NS (Current Consensus.LedgerState) (Consensus.CardanoEras Consensus.StandardCrypto) + :: Current (Flip Consensus.LedgerState mk) (Shelley.ShelleyBlock (TPraos.TPraos Ledger.StandardCrypto) (Shelley.ShelleyEra Ledger.StandardCrypto)) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern ShelleyLedgerState x = S (Z x) pattern AllegraLedgerState - :: Current Consensus.LedgerState (Shelley.ShelleyBlock (TPraos.TPraos Shelley.StandardCrypto) (Shelley.AllegraEra Shelley.StandardCrypto)) - -> NS (Current Consensus.LedgerState) (Consensus.CardanoEras Consensus.StandardCrypto) + :: Current (Flip Consensus.LedgerState mk) (Shelley.ShelleyBlock (TPraos.TPraos Ledger.StandardCrypto) (Shelley.AllegraEra Ledger.StandardCrypto)) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern AllegraLedgerState x = S (S (Z x)) pattern MaryLedgerState - :: Current Consensus.LedgerState (Shelley.ShelleyBlock (TPraos.TPraos Shelley.StandardCrypto) (Shelley.MaryEra Shelley.StandardCrypto)) - -> NS (Current Consensus.LedgerState) (Consensus.CardanoEras Consensus.StandardCrypto) + :: Current (Flip Consensus.LedgerState mk) (Shelley.ShelleyBlock (TPraos.TPraos Ledger.StandardCrypto) (Shelley.MaryEra Ledger.StandardCrypto)) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern MaryLedgerState x = S (S (S (Z x))) pattern AlonzoLedgerState - :: Current Consensus.LedgerState (Shelley.ShelleyBlock (TPraos.TPraos Shelley.StandardCrypto) (Shelley.AlonzoEra Shelley.StandardCrypto)) - -> NS (Current Consensus.LedgerState) (Consensus.CardanoEras Consensus.StandardCrypto) + :: Current (Flip Consensus.LedgerState mk) (Shelley.ShelleyBlock (TPraos.TPraos Ledger.StandardCrypto) (Shelley.AlonzoEra Ledger.StandardCrypto)) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern AlonzoLedgerState x = S (S (S (S (Z x)))) pattern BabbageLedgerState - :: Current Consensus.LedgerState (Shelley.ShelleyBlock (Consensus.Praos Shelley.StandardCrypto) (Shelley.BabbageEra Shelley.StandardCrypto)) - -> NS (Current Consensus.LedgerState) (Consensus.CardanoEras Consensus.StandardCrypto) + :: Current (Flip Consensus.LedgerState mk) (Shelley.ShelleyBlock (Consensus.Praos Ledger.StandardCrypto) (Shelley.BabbageEra Ledger.StandardCrypto)) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern BabbageLedgerState x = S (S (S (S (S (Z x))))) pattern ConwayLedgerState - :: Current Consensus.LedgerState (Shelley.ShelleyBlock (Consensus.Praos Shelley.StandardCrypto) (Shelley.ConwayEra Shelley.StandardCrypto)) - -> NS (Current Consensus.LedgerState) (Consensus.CardanoEras Consensus.StandardCrypto) + :: Current (Flip Consensus.LedgerState mk) (Shelley.ShelleyBlock (Consensus.Praos Ledger.StandardCrypto) (Shelley.ConwayEra Ledger.StandardCrypto)) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern ConwayLedgerState x = S (S (S (S (S (S (Z x)))))) - encodeLedgerState :: LedgerState -> CBOR.Encoding encodeLedgerState (LedgerState (HFC.HardForkLedgerState st)) = HFC.encodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) st where - byron = fn (K . Byron.encodeByronLedgerState) - shelley = fn (K . Shelley.encodeShelleyLedgerState) - allegra = fn (K . Shelley.encodeShelleyLedgerState) - mary = fn (K . Shelley.encodeShelleyLedgerState) - alonzo = fn (K . Shelley.encodeShelleyLedgerState) - babbage = fn (K . Shelley.encodeShelleyLedgerState) - conway = fn (K . Shelley.encodeShelleyLedgerState) + byron = fn (K . Byron.encodeByronLedgerState . unFlip) + shelley = fn (K . Shelley.encodeShelleyLedgerState . unFlip) + allegra = fn (K . Shelley.encodeShelleyLedgerState . unFlip) + mary = fn (K . Shelley.encodeShelleyLedgerState . unFlip) + alonzo = fn (K . Shelley.encodeShelleyLedgerState . unFlip) + babbage = fn (K . Shelley.encodeShelleyLedgerState . unFlip) + conway = fn (K . Shelley.encodeShelleyLedgerState . unFlip) decodeLedgerState :: forall s. CBOR.Decoder s LedgerState decodeLedgerState = LedgerState . HFC.HardForkLedgerState <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) where - byron = Comp Byron.decodeByronLedgerState - shelley = Comp Shelley.decodeShelleyLedgerState - allegra = Comp Shelley.decodeShelleyLedgerState - mary = Comp Shelley.decodeShelleyLedgerState - alonzo = Comp Shelley.decodeShelleyLedgerState - babbage = Comp Shelley.decodeShelleyLedgerState - conway = Comp Shelley.decodeShelleyLedgerState + byron = Comp $ Flip <$> Byron.decodeByronLedgerState + shelley = Comp $ Flip <$> Shelley.decodeShelleyLedgerState + allegra = Comp $ Flip <$> Shelley.decodeShelleyLedgerState + mary = Comp $ Flip <$> Shelley.decodeShelleyLedgerState + alonzo = Comp $ Flip <$> Shelley.decodeShelleyLedgerState + babbage = Comp $ Flip <$> Shelley.decodeShelleyLedgerState + conway = Comp $ Flip <$> Shelley.decodeShelleyLedgerState type LedgerStateEvents = (LedgerState, [LedgerEvent]) toLedgerStateEvents :: LedgerResult - ( Shelley.LedgerState - (HFC.HardForkBlock (Consensus.CardanoEras Shelley.StandardCrypto)) + ( Ledger.LedgerState + (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) ) - ( Shelley.LedgerState - (HFC.HardForkBlock (Consensus.CardanoEras Shelley.StandardCrypto)) + ( Ledger.LedgerState + (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) + Ledger.EmptyMK ) -> LedgerStateEvents toLedgerStateEvents lr = (ledgerState, ledgerEvents) where ledgerState = LedgerState (lrResult lr) ledgerEvents = mapMaybe (toLedgerEvent - . WrapLedgerEvent @(HFC.HardForkBlock (Consensus.CardanoEras Shelley.StandardCrypto))) + . WrapLedgerEvent @(HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto))) $ lrEvents lr -- Usually only one constructor, but may have two when we are preparing for a HFC event. @@ -1177,7 +1194,7 @@ data GenesisConfig !NodeConfig !Cardano.Chain.Genesis.Config !GenesisHashShelley - !(Ledger.TransitionConfig (Ledger.LatestKnownEra Shelley.StandardCrypto)) + !(Ledger.TransitionConfig (Ledger.LatestKnownEra Ledger.StandardCrypto)) newtype LedgerStateDir = LedgerStateDir { unLedgerStateDir :: FilePath @@ -1332,7 +1349,7 @@ readAlonzoGenesisConfig enc = do readConwayGenesisConfig :: MonadIOTransError GenesisConfigError t m => NodeConfig - -> t m (ConwayGenesis Shelley.StandardCrypto) + -> t m (ConwayGenesis Ledger.StandardCrypto) readConwayGenesisConfig enc = do let file = ncConwayGenesisFile enc modifyError (NEConwayConfig (unFile file) . renderConwayGenesisError) @@ -1437,7 +1454,7 @@ readConwayGenesis :: forall m t. MonadIOTransError ConwayGenesisError t m => ConwayGenesisFile 'In -> GenesisHashConway - -> t m (ConwayGenesis Shelley.StandardCrypto) + -> t m (ConwayGenesis Ledger.StandardCrypto) readConwayGenesis (File file) expectedGenesisHash = do content <- modifyError id $ handleIOExceptT (ConwayGenesisReadError file . textShow) $ BS.readFile file let genesisHash = GenesisHashConway (Cardano.Crypto.Hash.Class.hashWith id content) @@ -1487,8 +1504,8 @@ newtype StakeCred deriving (Eq, Ord) data Env = Env - { envLedgerConfig :: HFC.HardForkLedgerConfig (Consensus.CardanoEras Shelley.StandardCrypto) - , envProtocolConfig :: TPraos.ConsensusConfig (HFC.HardForkProtocol (Consensus.CardanoEras Shelley.StandardCrypto)) + { envLedgerConfig :: HFC.HardForkLedgerConfig (Consensus.CardanoEras Consensus.StandardCrypto) + , envProtocolConfig :: TPraos.ConsensusConfig (HFC.HardForkProtocol (Consensus.CardanoEras Consensus.StandardCrypto)) } envSecurityParam :: Env -> Word64 @@ -1513,7 +1530,7 @@ applyBlock' :: Env -> LedgerState -> ValidationMode - -> HFC.HardForkBlock + -> HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto) -> Either LedgerStateError LedgerStateEvents applyBlock' env oldState validationMode block = do @@ -1542,16 +1559,21 @@ applyBlockWithEvents env oldState enableValidation block = do -- the block matches the head hash of the ledger state. tickThenReapplyCheckHash :: HFC.HardForkLedgerConfig - (Consensus.CardanoEras Shelley.StandardCrypto) + (Consensus.CardanoEras Consensus.StandardCrypto) -> Consensus.CardanoBlock Consensus.StandardCrypto - -> Shelley.LedgerState + -> Ledger.LedgerState (HFC.HardForkBlock - (Consensus.CardanoEras Shelley.StandardCrypto)) + (Consensus.CardanoEras Consensus.StandardCrypto)) + Ledger.EmptyMK -> Either LedgerStateError LedgerStateEvents tickThenReapplyCheckHash cfg block lsb = if Consensus.blockPrevHash block == Ledger.ledgerTipHash lsb - then Right . toLedgerStateEvents - $ Ledger.tickThenReapplyLedgerResult cfg block lsb + then Right + . toLedgerStateEvents + $ Ledger.tickThenReapplyLedgerResult + cfg + block + lsb else Left $ ApplyBlockHashMismatch $ mconcat [ "Ledger state hash mismatch. Ledger head is slot " , textShow @@ -1577,16 +1599,20 @@ tickThenReapplyCheckHash cfg block lsb = -- the block matches the head hash of the ledger state. tickThenApply :: HFC.HardForkLedgerConfig - (Consensus.CardanoEras Shelley.StandardCrypto) + (Consensus.CardanoEras Consensus.StandardCrypto) -> Consensus.CardanoBlock Consensus.StandardCrypto - -> Shelley.LedgerState + -> Ledger.LedgerState (HFC.HardForkBlock - (Consensus.CardanoEras Shelley.StandardCrypto)) + (Consensus.CardanoEras Consensus.StandardCrypto)) + Ledger.EmptyMK -> Either LedgerStateError LedgerStateEvents tickThenApply cfg block lsb = either (Left . ApplyBlockError) (Right . toLedgerStateEvents) - $ runExcept - $ Ledger.tickThenApplyLedgerResult cfg block lsb + $ runExcept + $ Ledger.tickThenApplyLedgerResult + cfg + block + lsb renderByteArray :: ByteArrayAccess bin => bin -> Text renderByteArray = @@ -1646,7 +1672,7 @@ instance Api.Error LeadershipError where nextEpochEligibleLeadershipSlots :: forall era. () => ShelleyBasedEra era - -> ShelleyGenesis Shelley.StandardCrypto + -> ShelleyGenesis Consensus.StandardCrypto -> SerialisedCurrentEpochState era -- ^ We need the mark stake distribution in order to predict -- the following epoch's leadership schedule @@ -1716,9 +1742,9 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState poolid (Vr first LeaderErrDecodeProtocolEpochStateFailure $ decodeCurrentEpochState sbe serCurrEpochState - let snapshot :: ShelleyAPI.SnapShot Shelley.StandardCrypto + let snapshot :: ShelleyAPI.SnapShot Ledger.StandardCrypto snapshot = ShelleyAPI.ssStakeMark $ ShelleyAPI.esSnapshots cEstate - markSnapshotPoolDistr :: Map (SL.KeyHash 'SL.StakePool Shelley.StandardCrypto) (SL.IndividualPoolStake Shelley.StandardCrypto) + markSnapshotPoolDistr :: Map (SL.KeyHash 'SL.StakePool Ledger.StandardCrypto) (SL.IndividualPoolStake Ledger.StandardCrypto) markSnapshotPoolDistr = ShelleyAPI.unPoolDistr . ShelleyAPI.calculatePoolDistr $ snapshot let slotRangeOfInterest :: Core.EraPParams ledgerera => Core.PParams ledgerera -> Set SlotNo @@ -1747,7 +1773,7 @@ isLeadingSlotsTPraos :: forall v. () => Crypto.ContextVRF v ~ () => Set SlotNo -> PoolId - -> Map (SL.KeyHash 'SL.StakePool Shelley.StandardCrypto) (SL.IndividualPoolStake Shelley.StandardCrypto) + -> Map (SL.KeyHash 'SL.StakePool Consensus.StandardCrypto) (SL.IndividualPoolStake Consensus.StandardCrypto) -> Consensus.Nonce -> Crypto.SignKeyVRF v -> Ledger.ActiveSlotCoeff @@ -1768,9 +1794,9 @@ isLeadingSlotsTPraos slotRangeOfInterest poolid snapshotPoolDistr eNonce vrfSkey isLeadingSlotsPraos :: () => Set SlotNo -> PoolId - -> Map (SL.KeyHash 'SL.StakePool Shelley.StandardCrypto) (SL.IndividualPoolStake Shelley.StandardCrypto) + -> Map (SL.KeyHash 'SL.StakePool Consensus.StandardCrypto) (SL.IndividualPoolStake Consensus.StandardCrypto) -> Consensus.Nonce - -> SL.SignKeyVRF Shelley.StandardCrypto + -> SL.SignKeyVRF Consensus.StandardCrypto -> Ledger.ActiveSlotCoeff -> Either LeadershipError (Set SlotNo) isLeadingSlotsPraos slotRangeOfInterest poolid snapshotPoolDistr eNonce vrfSkey activeSlotCoeff' = do @@ -1781,7 +1807,7 @@ isLeadingSlotsPraos slotRangeOfInterest poolid snapshotPoolDistr eNonce vrfSkey let isLeader slotNo = checkLeaderNatValue certifiedNatValue stakePoolStake activeSlotCoeff' where rho = VRF.evalCertified () (mkInputVRF slotNo eNonce) vrfSkey - certifiedNatValue = vrfLeaderValue (Proxy @Shelley.StandardCrypto) rho + certifiedNatValue = vrfLeaderValue (Proxy @Consensus.StandardCrypto) rho Right $ Set.filter isLeader slotRangeOfInterest @@ -1789,7 +1815,7 @@ isLeadingSlotsPraos slotRangeOfInterest poolid snapshotPoolDistr eNonce vrfSkey -- expected to mint a block. currentEpochEligibleLeadershipSlots :: forall era. () => ShelleyBasedEra era - -> ShelleyGenesis Shelley.StandardCrypto + -> ShelleyGenesis Consensus.StandardCrypto -> EpochInfo (Either Text) -> Ledger.PParams (ShelleyLedgerEra era) -> ProtocolState era @@ -1832,7 +1858,7 @@ currentEpochEligibleLeadershipSlots sbe sGen eInfo pp ptclState poolid (VrfSigni f = activeSlotCoeff globals constructGlobals - :: ShelleyGenesis Shelley.StandardCrypto + :: ShelleyGenesis Consensus.StandardCrypto -> EpochInfo (Either Text) -> Ledger.ProtVer -> Globals diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs index d886b9f952..9305aacb8d 100644 --- a/cardano-api/internal/Cardano/Api/Query.hs +++ b/cardano-api/internal/Cardano/Api/Query.hs @@ -122,6 +122,7 @@ import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry import qualified Ouroboros.Consensus.Ledger.Query as Consensus import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus +import qualified Data.Singletons as Singletons import Ouroboros.Network.Block (Serialised (..)) import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..)) import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..)) @@ -709,24 +710,25 @@ toConsensusQueryShelleyBased sbe = \case era = shelleyBasedToCardanoEra sbe consensusQueryInEraInMode - :: forall era erablock modeblock result result' xs. + :: forall era erablock modeblock result result' fp xs. ConsensusBlockForEra era ~ erablock => Consensus.CardanoBlock L.StandardCrypto ~ modeblock => modeblock ~ Consensus.HardForkBlock xs => Consensus.HardForkQueryResult xs result ~ result' + => Singletons.SingI fp => CardanoEra era - -> Consensus.BlockQuery erablock result + -> Consensus.BlockQuery erablock fp result -> Consensus.Query modeblock result' -consensusQueryInEraInMode era = - Consensus.BlockQuery - . case era of - ByronEra -> Consensus.QueryIfCurrentByron - ShelleyEra -> Consensus.QueryIfCurrentShelley - AllegraEra -> Consensus.QueryIfCurrentAllegra - MaryEra -> Consensus.QueryIfCurrentMary - AlonzoEra -> Consensus.QueryIfCurrentAlonzo - BabbageEra -> Consensus.QueryIfCurrentBabbage - ConwayEra -> Consensus.QueryIfCurrentConway +consensusQueryInEraInMode erainmode b = + Consensus.BlockQuery @fp + $ case erainmode of + ByronEra -> Consensus.QueryIfCurrentByron b + ShelleyEra -> Consensus.QueryIfCurrentShelley b + AllegraEra -> Consensus.QueryIfCurrentAllegra b + MaryEra -> Consensus.QueryIfCurrentMary b + AlonzoEra -> Consensus.QueryIfCurrentAlonzo b + BabbageEra -> Consensus.QueryIfCurrentBabbage b + ConwayEra -> Consensus.QueryIfCurrentConway b -- ---------------------------------------------------------------------------- -- Conversions of query results from the consensus types. @@ -831,14 +833,14 @@ fromConsensusQueryResult (QueryInEra (QueryInShelleyBasedEra ShelleyBasedEraConw _ -> fromConsensusQueryResultMismatch fromConsensusQueryResultShelleyBased - :: forall era ledgerera protocol result result'. + :: forall era ledgerera protocol result fp result'. HasCallStack => ShelleyLedgerEra era ~ ledgerera => Core.EraCrypto ledgerera ~ Consensus.StandardCrypto => ConsensusProtocol era ~ protocol => ShelleyBasedEra era -> QueryInShelleyBasedEra era result - -> Consensus.BlockQuery (Consensus.ShelleyBlock protocol ledgerera) result' + -> Consensus.BlockQuery (Consensus.ShelleyBlock protocol ledgerera) fp result' -> result' -> result fromConsensusQueryResultShelleyBased _ QueryEpoch q' epoch = From 9c2a821cfcbb4cffca8c2ce830b1574f7bb4afda Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 25 Mar 2024 13:35:01 +0100 Subject: [PATCH 02/19] Fix LedgerState --- cabal.project | 32 +--- .../internal/Cardano/Api/LedgerState.hs | 163 +++++++++++------- 2 files changed, 103 insertions(+), 92 deletions(-) diff --git a/cabal.project b/cabal.project index 81fe22b4c7..434adf2fa6 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them index-state: - , hackage.haskell.org 2024-03-18T10:10:55Z - , cardano-haskell-packages 2024-03-15T18:07:40Z + , hackage.haskell.org 2024-03-25T10:39:21Z + , cardano-haskell-packages 2024-03-22T16:27:41Z packages: cardano-api @@ -42,34 +42,12 @@ write-ghc-environment-files: always source-repository-package type: git location: https://github.com/jasagredo/latex-svg - tag: 00e10224a96ce73e2a1da8478efb7790cf9ba2b3 - --sha256: 0pb5azww7qj0armldn95pr1vxz30gq51mz8ysmm0a1rgsxm9f3i5 + tag: c52c9905cb043ddb430c93b41ce431a7506a300d + --sha256: 0h9yrlvmyi32zlr0cj2nx8ik0y2cg5ckcxq4lgq5vvjyl6lhzrbk subdir: latex-svg-image -source-repository-package - type: git - location: https://github.com/input-output-hk/quickcheck-dynamic - tag: cf5273faabde55dc8e759e64766e3353439ac1e2 - --sha256: 1achsw9pzrg9lng7xmcnkc6fz1hrl1g8bm4g33lv0vzhrkcy0cl3 - subdir: quickcheck-dynamic - -source-repository-package - type: git - location: https://github.com/well-typed/quickcheck-lockstep - tag: 5125b458af594cb191c8979a3987f1894a96a196 - --sha256: 1mv6ylpksppjdqjjm0bf0pcxlsgk2bgz60i4l4jwl1kdp0zv4iay - -source-repository-package - type: git - location: https://github.com/input-output-hk/anti-diffs - tag: a6b3b7748711c10fc0413cbe6171b42774d08ffa - --sha256: 1cqnqq2zwlrz44iq636ai81f3pfwqjaxrm9n9k7rax5yi3n139xr - subdir: - diff-containers - fingertree-rm - -if impl(ghc >= 9.8) +if impl(ghc >= 9.6) allow-newer: cardano-lmdb-simple:bytestring diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index 2e1ca33b9e..ac61e1d59b 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -10,7 +10,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -Wno-unused-matches -Wno-unused-top-binds -Wno-unused-imports #-} {- HLINT ignore "Redundant fmap" -} module Cardano.Api.LedgerState @@ -157,7 +156,8 @@ import qualified Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common as import Ouroboros.Consensus.HardFork.Combinator.State.Types import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger import Ouroboros.Consensus.Ledger.Basics (LedgerResult (lrEvents), lrResult) -import qualified Ouroboros.Consensus.Ledger.Basics as Ledger +import Ouroboros.Consensus.Ledger.Tables.Utils +import Ouroboros.Consensus.Ledger.Tables (LedgerTables(..)) import qualified Ouroboros.Consensus.Ledger.Extended as Ledger import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus @@ -169,7 +169,6 @@ import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos import qualified Ouroboros.Consensus.Shelley.Eras as Shelley hiding (StandardCrypto) import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Shelley import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Shelley hiding (LedgerState) -import qualified Ouroboros.Consensus.Shelley.Node.Praos as Consensus import Ouroboros.Consensus.TypeFamilyWrappers (WrapLedgerEvent (WrapLedgerEvent)) import Ouroboros.Network.Block (blockNo) import qualified Ouroboros.Network.Block @@ -206,8 +205,7 @@ import qualified Data.Sequence as Seq import Data.Set (Set) import qualified Data.Set as Set import Data.SOP (K (K), (:.:) (Comp)) -import Data.SOP.Constraint -import Data.SOP.Strict (NP (..), fn, hcmap) +import Data.SOP.Strict (NP (..), fn) import Data.SOP.Strict.NS import qualified Data.SOP.Telescope as Telescope import Data.SOP.Functors (Flip (..)) @@ -224,8 +222,6 @@ import Lens.Micro import Network.TypedProtocol.Pipelined (Nat (..)) import System.FilePath ---import qualified Legacy.Convert as Legacy - data InitialLedgerStateError = ILSEConfigFile Text -- ^ Failed to read or parse the network config file. @@ -333,39 +329,39 @@ applyBlock env oldState validationMode block ShelleyBasedEraConway -> Consensus.BlockConway shelleyBlock pattern LedgerStateByron - :: Ledger.LedgerState Byron.ByronBlock mk + :: Ledger.LedgerState Byron.ByronBlock Ledger.EmptyMK -> LedgerState -pattern LedgerStateByron st <- LedgerState (Consensus.LedgerStateByron st) +pattern LedgerStateByron st <- LedgerState (Consensus.LedgerStateByron st) _ pattern LedgerStateShelley - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ShelleyEra Consensus.StandardCrypto)) mk + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ShelleyEra Consensus.StandardCrypto)) Ledger.EmptyMK -> LedgerState -pattern LedgerStateShelley st <- LedgerState (Consensus.LedgerStateShelley st) +pattern LedgerStateShelley st <- LedgerState (Consensus.LedgerStateShelley st) _ pattern LedgerStateAllegra - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AllegraEra Consensus.StandardCrypto)) mk + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AllegraEra Consensus.StandardCrypto)) Ledger.EmptyMK -> LedgerState -pattern LedgerStateAllegra st <- LedgerState (Consensus.LedgerStateAllegra st) +pattern LedgerStateAllegra st <- LedgerState (Consensus.LedgerStateAllegra st) _ pattern LedgerStateMary - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.MaryEra Consensus.StandardCrypto)) mk + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.MaryEra Consensus.StandardCrypto)) Ledger.EmptyMK -> LedgerState -pattern LedgerStateMary st <- LedgerState (Consensus.LedgerStateMary st) +pattern LedgerStateMary st <- LedgerState (Consensus.LedgerStateMary st) _ pattern LedgerStateAlonzo - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AlonzoEra Consensus.StandardCrypto)) mk + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AlonzoEra Consensus.StandardCrypto)) Ledger.EmptyMK -> LedgerState -pattern LedgerStateAlonzo st <- LedgerState (Consensus.LedgerStateAlonzo st) +pattern LedgerStateAlonzo st <- LedgerState (Consensus.LedgerStateAlonzo st) _ pattern LedgerStateBabbage - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.BabbageEra Consensus.StandardCrypto)) mk + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.BabbageEra Consensus.StandardCrypto)) Ledger.EmptyMK -> LedgerState -pattern LedgerStateBabbage st <- LedgerState (Consensus.LedgerStateBabbage st) +pattern LedgerStateBabbage st <- LedgerState (Consensus.LedgerStateBabbage st) _ pattern LedgerStateConway - :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ConwayEra Consensus.StandardCrypto)) mk + :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ConwayEra Consensus.StandardCrypto)) Ledger.EmptyMK -> LedgerState -pattern LedgerStateConway st <- LedgerState (Consensus.LedgerStateConway st) +pattern LedgerStateConway st <- LedgerState (Consensus.LedgerStateConway st) _ {-# COMPLETE LedgerStateByron , LedgerStateShelley @@ -1034,11 +1030,12 @@ readByteString fp cfgType = (liftEither <=< liftIO) $ initLedgerStateVar :: GenesisConfig -> LedgerState initLedgerStateVar genesisConfig = LedgerState { clsState = - HFC.HardForkLedgerState - $ hcmap - (Proxy @(Compose Ledger.CanStowLedgerTables Ledger.LedgerState)) - (Flip . Ledger.stowLedgerTables . unFlip) - $ HFC.hardForkLedgerStatePerEra + Ledger.ledgerState + $ forgetLedgerTables + $ Consensus.pInfoInitLedger + $ fst protocolInfo + , clsTables = + Ledger.projectLedgerTables $ Ledger.ledgerState $ Consensus.pInfoInitLedger $ fst protocolInfo @@ -1060,7 +1057,7 @@ getAnyNewEpochState :: ShelleyBasedEra era -> LedgerState -> Either LedgerStateError AnyNewEpochState -getAnyNewEpochState sbe (LedgerState ls) = +getAnyNewEpochState sbe (LedgerState ls _) = AnyNewEpochState sbe <$> getNewEpochState sbe ls getNewEpochState @@ -1143,10 +1140,13 @@ pattern ConwayLedgerState pattern ConwayLedgerState x = S (S (S (S (S (S (Z x)))))) encodeLedgerState :: LedgerState -> CBOR.Encoding -encodeLedgerState (LedgerState (HFC.HardForkLedgerState st)) = - HFC.encodeTelescope +encodeLedgerState (LedgerState (HFC.HardForkLedgerState st) tbs) = mconcat + [ CBOR.encodeListLen 2 + , HFC.encodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) st + , Ledger.valuesMKEncoder tbs + ] where byron = fn (K . Byron.encodeByronLedgerState . unFlip) shelley = fn (K . Shelley.encodeShelleyLedgerState . unFlip) @@ -1157,9 +1157,11 @@ encodeLedgerState (LedgerState (HFC.HardForkLedgerState st)) = conway = fn (K . Shelley.encodeShelleyLedgerState . unFlip) decodeLedgerState :: forall s. CBOR.Decoder s LedgerState -decodeLedgerState = +decodeLedgerState = do + 2 <- CBOR.decodeListLen LedgerState . HFC.HardForkLedgerState <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) + <*> Ledger.valuesMKDecoder where byron = Comp $ Flip <$> Byron.decodeByronLedgerState shelley = Comp $ Flip <$> Shelley.decodeShelleyLedgerState @@ -1176,14 +1178,12 @@ toLedgerStateEvents :: ( Ledger.LedgerState (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) ) - ( Ledger.LedgerState - (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) - Ledger.EmptyMK + ( LedgerState ) -> LedgerStateEvents toLedgerStateEvents lr = (ledgerState, ledgerEvents) where - ledgerState = LedgerState (lrResult lr) + ledgerState = lrResult lr ledgerEvents = mapMaybe (toLedgerEvent . WrapLedgerEvent @(HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto))) $ lrEvents lr @@ -1535,10 +1535,9 @@ applyBlock' -> Either LedgerStateError LedgerStateEvents applyBlock' env oldState validationMode block = do let config = envLedgerConfig env - stateOld = clsState oldState case validationMode of - FullValidation -> tickThenApply config block stateOld - QuickValidation -> tickThenReapplyCheckHash config block stateOld + FullValidation -> tickThenApply config block oldState + QuickValidation -> tickThenReapplyCheckHash config block oldState applyBlockWithEvents :: Env @@ -1550,10 +1549,9 @@ applyBlockWithEvents -> Either LedgerStateError LedgerStateEvents applyBlockWithEvents env oldState enableValidation block = do let config = envLedgerConfig env - stateOld = clsState oldState if enableValidation - then tickThenApply config block stateOld - else tickThenReapplyCheckHash config block stateOld + then tickThenApply config block oldState + else tickThenReapplyCheckHash config block oldState -- Like 'Consensus.tickThenReapply' but also checks that the previous hash from -- the block matches the head hash of the ledger state. @@ -1561,30 +1559,47 @@ tickThenReapplyCheckHash :: HFC.HardForkLedgerConfig (Consensus.CardanoEras Consensus.StandardCrypto) -> Consensus.CardanoBlock Consensus.StandardCrypto - -> Ledger.LedgerState - (HFC.HardForkBlock - (Consensus.CardanoEras Consensus.StandardCrypto)) - Ledger.EmptyMK + -> LedgerState -> Either LedgerStateError LedgerStateEvents -tickThenReapplyCheckHash cfg block lsb = - if Consensus.blockPrevHash block == Ledger.ledgerTipHash lsb - then Right - . toLedgerStateEvents - $ Ledger.tickThenReapplyLedgerResult - cfg - block - lsb +tickThenReapplyCheckHash cfg block (LedgerState st tbs) = + if Consensus.blockPrevHash block == Ledger.ledgerTipHash st + then + let + keys :: LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.KeysMK + keys = Ledger.getBlockKeySets block + + restrictedTables = + LedgerTables (rawRestrictValues (getLedgerTables tbs) (getLedgerTables keys)) + + + ledgerResult = + Ledger.tickThenReapplyLedgerResult cfg block + $ st `Ledger.withLedgerTables` restrictedTables + + in Right + . toLedgerStateEvents + . fmap (\stt -> LedgerState + (forgetLedgerTables stt) + ( LedgerTables + . rawApplyDiffs (getLedgerTables tbs) + . getLedgerTables + . Ledger.projectLedgerTables + $ stt + ) + ) + $ ledgerResult + else Left $ ApplyBlockHashMismatch $ mconcat [ "Ledger state hash mismatch. Ledger head is slot " , textShow $ Slot.unSlotNo $ Slot.fromWithOrigin (Slot.SlotNo 0) - (Ledger.ledgerTipSlot lsb) + (Ledger.ledgerTipSlot st) , " hash " , renderByteArray $ unChainHash - $ Ledger.ledgerTipHash lsb + $ Ledger.ledgerTipHash st , " but block previous hash is " , renderByteArray (unChainHash $ Consensus.blockPrevHash block) , " and block current hash is " @@ -1601,18 +1616,36 @@ tickThenApply :: HFC.HardForkLedgerConfig (Consensus.CardanoEras Consensus.StandardCrypto) -> Consensus.CardanoBlock Consensus.StandardCrypto - -> Ledger.LedgerState - (HFC.HardForkBlock - (Consensus.CardanoEras Consensus.StandardCrypto)) - Ledger.EmptyMK + -> LedgerState -> Either LedgerStateError LedgerStateEvents -tickThenApply cfg block lsb - = either (Left . ApplyBlockError) (Right . toLedgerStateEvents) - $ runExcept - $ Ledger.tickThenApplyLedgerResult - cfg - block - lsb +tickThenApply cfg block (LedgerState st tbs) + = let + keys :: LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.KeysMK + keys = Ledger.getBlockKeySets block + + restrictedTables = + LedgerTables (rawRestrictValues (getLedgerTables tbs) (getLedgerTables keys)) + + eLedgerResult = runExcept + $ Ledger.tickThenApplyLedgerResult cfg block + $ st `Ledger.withLedgerTables` restrictedTables + in + either + (Left . ApplyBlockError) + ( Right + . toLedgerStateEvents + . fmap (\stt -> + LedgerState + (forgetLedgerTables stt) + ( LedgerTables + . rawApplyDiffs (getLedgerTables tbs) + . getLedgerTables + . Ledger.projectLedgerTables + $ stt + ) + ) + ) + eLedgerResult renderByteArray :: ByteArrayAccess bin => bin -> Text renderByteArray = From cf6e015c1829dc5e54b8baec4f16f6f0b3d25f53 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 25 Mar 2024 16:35:32 +0100 Subject: [PATCH 03/19] Fix CI --- .github/workflows/haskell.yml | 15 ++++++++++++++- .github/workflows/lmdb.pc | 11 ----------- cabal.project | 4 ++-- cardano-api/internal/Cardano/Api/LedgerState.hs | 7 +++---- cardano-api/internal/Cardano/Api/Query.hs | 2 +- 5 files changed, 20 insertions(+), 19 deletions(-) delete mode 100644 .github/workflows/lmdb.pc diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 8cb95cd680..4013efe14d 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -17,7 +17,7 @@ jobs: env: # Modify this value to "invalidate" the cabal cache. - CABAL_CACHE_VERSION: "2024-02-15" + CABAL_CACHE_VERSION: "2024-03-25" concurrency: group: > @@ -54,6 +54,19 @@ jobs: with: use-sodium-vrf: true # default is true + - name: Linux install lmdb + if: matrix.os == 'ubuntu-latest' + run: sudo apt install liblmdb-dev + + - name: Mac install lmdb + if: matrix.os == 'macos-latest' + run: brew install lmdb + + - name: Windows install lmdb + if: matrix.os == 'windows-latest' + shell: 'C:/msys64/usr/bin/bash.exe -e {0}' + run: /usr/bin/pacman --noconfirm -S mingw-w64-x86_64-lmdb + - uses: actions/checkout@v3 - name: Cabal update diff --git a/.github/workflows/lmdb.pc b/.github/workflows/lmdb.pc deleted file mode 100644 index fc4838ed47..0000000000 --- a/.github/workflows/lmdb.pc +++ /dev/null @@ -1,11 +0,0 @@ -prefix=/usr/local -exec_prefix=${prefix} -libdir=${exec_prefix}/lib -includedir=${exec_prefix}/include - -Name: liblmdb -Description: Lightning Memory-Mapped Database -URL: https://symas.com/products/lightning-memory-mapped-database/ -Version: 0.9.29 -Libs: -L${libdir} -llmdb -Cflags: -I${includedir} \ No newline at end of file diff --git a/cabal.project b/cabal.project index 434adf2fa6..68004dbf75 100644 --- a/cabal.project +++ b/cabal.project @@ -54,8 +54,8 @@ if impl(ghc >= 9.6) source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 5b4dd265f8c75a27c51797f114b3ce7e308b72aa - --sha256: 0736i06v6wwl5krlybqiwswy1mn0986zrs904dvc0718424gnb85 + tag: ef26a50893c65f346ea0a3b865632b014692db3f + --sha256: 0c3pd7zdriid7n6a5n86f2c009lygls10qjawmdiih8rvpvr51d3 subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index ac61e1d59b..f2aecc2cca 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -156,9 +156,9 @@ import qualified Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common as import Ouroboros.Consensus.HardFork.Combinator.State.Types import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger import Ouroboros.Consensus.Ledger.Basics (LedgerResult (lrEvents), lrResult) -import Ouroboros.Consensus.Ledger.Tables.Utils -import Ouroboros.Consensus.Ledger.Tables (LedgerTables(..)) import qualified Ouroboros.Consensus.Ledger.Extended as Ledger +import Ouroboros.Consensus.Ledger.Tables (LedgerTables (..)) +import Ouroboros.Consensus.Ledger.Tables.Utils import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus import Ouroboros.Consensus.Protocol.Abstract (ChainDepState, ConsensusProtocol (..)) @@ -205,11 +205,10 @@ import qualified Data.Sequence as Seq import Data.Set (Set) import qualified Data.Set as Set import Data.SOP (K (K), (:.:) (Comp)) +import Data.SOP.Functors (Flip (..)) import Data.SOP.Strict (NP (..), fn) import Data.SOP.Strict.NS import qualified Data.SOP.Telescope as Telescope -import Data.SOP.Functors (Flip (..)) ---import Data.SOP.Strict (Compose, K (..), NP (..), fn, hcmap, (:.:) (Comp)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs index 9305aacb8d..7decd264b7 100644 --- a/cardano-api/internal/Cardano/Api/Query.hs +++ b/cardano-api/internal/Cardano/Api/Query.hs @@ -122,7 +122,6 @@ import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry import qualified Ouroboros.Consensus.Ledger.Query as Consensus import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus -import qualified Data.Singletons as Singletons import Ouroboros.Network.Block (Serialised (..)) import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..)) import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..)) @@ -141,6 +140,7 @@ import qualified Data.Map.Strict as Map import Data.Maybe (mapMaybe) import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.Singletons as Singletons import Data.SOP.Constraint (SListI) import Data.Text (Text) import qualified Data.Text as Text From 67c6f77a294fb6c318695def2dc062cefb09e2a2 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 4 Apr 2024 09:48:09 +0200 Subject: [PATCH 04/19] Update consensus ref --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 68004dbf75..5e6ffc73fe 100644 --- a/cabal.project +++ b/cabal.project @@ -54,8 +54,8 @@ if impl(ghc >= 9.6) source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: ef26a50893c65f346ea0a3b865632b014692db3f - --sha256: 0c3pd7zdriid7n6a5n86f2c009lygls10qjawmdiih8rvpvr51d3 + tag: 0d767e4258374353cef59d0163fef1debb54d7da + --sha256: 1hxdx9mkw35607ijn8n81d958j1f41fmr1cci1zwjdq91yxxpp3h subdir: ouroboros-consensus ouroboros-consensus-cardano From 57489b1f387519082934f3d29c6e9b5c0f64cb6d Mon Sep 17 00:00:00 2001 From: Renate Eilers Date: Thu, 4 Apr 2024 14:37:07 +0200 Subject: [PATCH 05/19] Use LedgerTables in foldEpochState --- .../internal/Cardano/Api/LedgerState.hs | 54 +++++++++++++++---- 1 file changed, 44 insertions(+), 10 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index f2aecc2cca..2a1da8241f 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -33,6 +33,7 @@ module Cardano.Api.LedgerState , applyBlockWithEvents , AnyNewEpochState(..) , getAnyNewEpochState + , getUTxOValues -- * Traversing the block chain , foldBlocks @@ -108,6 +109,7 @@ import Cardano.Api.Query (CurrentEpochState (..), PoolDistribution (un decodeCurrentEpochState, decodePoolDistribution, decodeProtocolState) import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.SpecialByron as Byron +import Cardano.Api.Tx.Body import Cardano.Api.Utils (textShow) import qualified Cardano.Binary as CBOR @@ -150,8 +152,7 @@ import qualified Ouroboros.Consensus.Cardano.CanHardFork as Consensus import qualified Ouroboros.Consensus.Cardano.Node as Consensus import qualified Ouroboros.Consensus.Config as Consensus import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus -import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as HFC -import qualified Ouroboros.Consensus.HardFork.Combinator.Basics as HFC +import qualified Ouroboros.Consensus.HardFork.Combinator as HFC import qualified Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common as HFC import Ouroboros.Consensus.HardFork.Combinator.State.Types import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger @@ -206,6 +207,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.SOP (K (K), (:.:) (Comp)) import Data.SOP.Functors (Flip (..)) +import Data.SOP.Index import Data.SOP.Strict (NP (..), fn) import Data.SOP.Strict.NS import qualified Data.SOP.Telescope as Telescope @@ -1056,8 +1058,8 @@ getAnyNewEpochState :: ShelleyBasedEra era -> LedgerState -> Either LedgerStateError AnyNewEpochState -getAnyNewEpochState sbe (LedgerState ls _) = - AnyNewEpochState sbe <$> getNewEpochState sbe ls +getAnyNewEpochState sbe (LedgerState ls tbs) = + flip (AnyNewEpochState sbe) tbs <$> getNewEpochState sbe ls getNewEpochState :: ShelleyBasedEra era @@ -1177,8 +1179,8 @@ toLedgerStateEvents :: ( Ledger.LedgerState (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) ) - ( LedgerState - ) -> + LedgerState + -> LedgerStateEvents toLedgerStateEvents lr = (ledgerState, ledgerEvents) where @@ -1910,12 +1912,45 @@ data AnyNewEpochState where AnyNewEpochState :: ShelleyBasedEra era -> ShelleyAPI.NewEpochState (ShelleyLedgerEra era) + -> Ledger.LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.ValuesMK -> AnyNewEpochState instance Show AnyNewEpochState where - showsPrec p (AnyNewEpochState sbe ledgerNewEpochState) = + showsPrec p (AnyNewEpochState sbe ledgerNewEpochState _) = shelleyBasedEraConstraints sbe $ showsPrec p ledgerNewEpochState +getUTxOValues :: forall era. ShelleyBasedEra era + -> Ledger.LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.ValuesMK + -> Set TxIn -- keys + -> Map TxIn (TxOut CtxUTxO era) +getUTxOValues sbe tbs keys = + let + cardanoKeys :: LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.KeysMK + cardanoKeys = LedgerTables $ Ledger.KeysMK $ Set.map ((case sbe of + ShelleyBasedEraShelley -> HFC.injectCanonicalTxIn $ IS IZ + ShelleyBasedEraAllegra -> HFC.injectCanonicalTxIn $ IS (IS IZ) + ShelleyBasedEraMary -> HFC.injectCanonicalTxIn $ IS (IS (IS IZ)) + ShelleyBasedEraAlonzo -> HFC.injectCanonicalTxIn $ IS (IS (IS (IS IZ))) + ShelleyBasedEraBabbage -> HFC.injectCanonicalTxIn $ IS (IS (IS (IS (IS IZ)))) + ShelleyBasedEraConway -> HFC.injectCanonicalTxIn $ IS (IS (IS (IS (IS (IS IZ))))) + ) . toShelleyTxIn) keys + + restrictedTables :: Ledger.LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.ValuesMK + restrictedTables = + LedgerTables (rawRestrictValues (getLedgerTables tbs) (getLedgerTables cardanoKeys)) + + distribTables :: Shelley.EraCrypto (ShelleyLedgerEra era) ~ Consensus.StandardCrypto + => Index (Consensus.CardanoEras Consensus.StandardCrypto) (Shelley.ShelleyBlock proto (ShelleyLedgerEra era)) + -> Map TxIn (TxOut CtxUTxO era) + distribTables idx = let LedgerTables (Ledger.ValuesMK values) = HFC.distribLedgerTables idx restrictedTables + in Map.mapKeys fromShelleyTxIn $ Map.map (fromShelleyTxOut sbe) values + in case sbe of + ShelleyBasedEraShelley -> distribTables (IS IZ) + ShelleyBasedEraAllegra -> distribTables (IS (IS IZ)) + ShelleyBasedEraMary -> distribTables (IS (IS (IS IZ))) + ShelleyBasedEraAlonzo -> distribTables (IS (IS (IS (IS IZ)))) + ShelleyBasedEraBabbage -> distribTables (IS (IS (IS (IS (IS IZ))))) + ShelleyBasedEraConway -> distribTables (IS (IS (IS (IS (IS (IS IZ)))))) -- | Reconstructs the ledger's new epoch state and applies a supplied condition to it for every block. This -- function only terminates if the condition is met or we have reached the termination epoch. We need to @@ -2068,12 +2103,11 @@ foldEpochState nodeConfigFilePath socketPath validationMode terminationEpoch ini let (knownLedgerStates', _) = pushLedgerState env knownLedgerStates slotNo new blockInMode newClientTip = At currBlockNo newServerTip = fromChainTip serverChainTip - case getNewEpochState sbe $ clsState newLedgerState of + case getAnyNewEpochState sbe newLedgerState of Left e -> let !err = Just e in clientIdle_DoneNwithMaybeError n err - Right lState -> do - let newEpochState = AnyNewEpochState sbe lState + Right newEpochState -> do -- Run the condition function in an exclusive lock. -- There can be only one place where `takeMVar stateMv` exists otherwise this -- code will deadlock! From d1abbb0b16f98d15c93d25349c7547746b533106 Mon Sep 17 00:00:00 2001 From: Renate Eilers Date: Thu, 4 Apr 2024 15:42:43 +0200 Subject: [PATCH 06/19] Stop restricting LedgerTables --- .../internal/Cardano/Api/LedgerState.hs | 19 ++----------------- cardano-api/src/Cardano/Api.hs | 1 + 2 files changed, 3 insertions(+), 17 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index 2a1da8241f..f69324e062 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -1921,28 +1921,13 @@ instance Show AnyNewEpochState where getUTxOValues :: forall era. ShelleyBasedEra era -> Ledger.LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.ValuesMK - -> Set TxIn -- keys -> Map TxIn (TxOut CtxUTxO era) -getUTxOValues sbe tbs keys = +getUTxOValues sbe tbs = let - cardanoKeys :: LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.KeysMK - cardanoKeys = LedgerTables $ Ledger.KeysMK $ Set.map ((case sbe of - ShelleyBasedEraShelley -> HFC.injectCanonicalTxIn $ IS IZ - ShelleyBasedEraAllegra -> HFC.injectCanonicalTxIn $ IS (IS IZ) - ShelleyBasedEraMary -> HFC.injectCanonicalTxIn $ IS (IS (IS IZ)) - ShelleyBasedEraAlonzo -> HFC.injectCanonicalTxIn $ IS (IS (IS (IS IZ))) - ShelleyBasedEraBabbage -> HFC.injectCanonicalTxIn $ IS (IS (IS (IS (IS IZ)))) - ShelleyBasedEraConway -> HFC.injectCanonicalTxIn $ IS (IS (IS (IS (IS (IS IZ))))) - ) . toShelleyTxIn) keys - - restrictedTables :: Ledger.LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.ValuesMK - restrictedTables = - LedgerTables (rawRestrictValues (getLedgerTables tbs) (getLedgerTables cardanoKeys)) - distribTables :: Shelley.EraCrypto (ShelleyLedgerEra era) ~ Consensus.StandardCrypto => Index (Consensus.CardanoEras Consensus.StandardCrypto) (Shelley.ShelleyBlock proto (ShelleyLedgerEra era)) -> Map TxIn (TxOut CtxUTxO era) - distribTables idx = let LedgerTables (Ledger.ValuesMK values) = HFC.distribLedgerTables idx restrictedTables + distribTables idx = let LedgerTables (Ledger.ValuesMK values) = HFC.distribLedgerTables idx tbs in Map.mapKeys fromShelleyTxIn $ Map.map (fromShelleyTxOut sbe) values in case sbe of ShelleyBasedEraShelley -> distribTables (IS IZ) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index cec503be7e..1404dd998b 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -750,6 +750,7 @@ module Cardano.Api ( AnyNewEpochState(..), foldEpochState, getAnyNewEpochState, + getUTxOValues, -- *** Errors LedgerStateError(..), From 0fb8ae595e7b0ae644c4724aa4b63594d1e53877 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 4 Apr 2024 16:58:17 +0200 Subject: [PATCH 07/19] Update consensus ref --- cabal.project | 6 +++--- flake.lock | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cabal.project b/cabal.project index 5e6ffc73fe..75236acbce 100644 --- 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 2024-03-25T10:39:21Z - , cardano-haskell-packages 2024-03-22T16:27:41Z + , cardano-haskell-packages 2024-04-04T11:57:10Z packages: cardano-api @@ -54,8 +54,8 @@ if impl(ghc >= 9.6) source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 0d767e4258374353cef59d0163fef1debb54d7da - --sha256: 1hxdx9mkw35607ijn8n81d958j1f41fmr1cci1zwjdq91yxxpp3h + tag: a31e7705fc42a39389d90299c77498dac77e546e + --sha256: 0f6vz6rh3zzqz52hzzydqvgw5hj6ii0fhvhs901sylzhl4d21jw1 subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/flake.lock b/flake.lock index 15656e4f13..1d7ba32c80 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1710529033, - "narHash": "sha256-vcxum8uDTGEGV1/h8UWRJmdPXcLhrAqpty/N2LbxRb4=", + "lastModified": 1712241301, + "narHash": "sha256-Np3AKeg8JuT53MaoA9HAP3Rk+mzFJR05LbmamXtpeXM=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "a744b5fe534c57a42cbc2645b9211bb619c7c243", + "rev": "91e98f31ae16e5a5833224c8ac46532fb72964a4", "type": "github" }, "original": { From ffadb947c711b9fc89123ba653b5b567006f1138 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 4 Apr 2024 17:39:20 +0200 Subject: [PATCH 08/19] Update consensus ref again --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 75236acbce..2abf1072fd 100644 --- a/cabal.project +++ b/cabal.project @@ -54,8 +54,8 @@ if impl(ghc >= 9.6) source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: a31e7705fc42a39389d90299c77498dac77e546e - --sha256: 0f6vz6rh3zzqz52hzzydqvgw5hj6ii0fhvhs901sylzhl4d21jw1 + tag: 02d6f44179cbffd573a15c0bd8a7e8d5de43690e + --sha256: 1h67ln5r5xzs2yiwld0pplym6iga458wh653z4z2s4k7g7a2i3rq subdir: ouroboros-consensus ouroboros-consensus-cardano From 05004203ec4c760b732ba0152bf5a8c4a6ff523a Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 5 Apr 2024 13:36:34 +0200 Subject: [PATCH 09/19] Update consensus ref once more and CHaP --- cabal.project | 10 +++------- flake.lock | 6 +++--- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/cabal.project b/cabal.project index 2abf1072fd..0d3a1c92da 100644 --- 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 2024-03-25T10:39:21Z - , cardano-haskell-packages 2024-04-04T11:57:10Z + , cardano-haskell-packages 2024-04-05T11:01:53Z packages: cardano-api @@ -47,15 +47,11 @@ source-repository-package subdir: latex-svg-image -if impl(ghc >= 9.6) - allow-newer: - cardano-lmdb-simple:bytestring - source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 02d6f44179cbffd573a15c0bd8a7e8d5de43690e - --sha256: 1h67ln5r5xzs2yiwld0pplym6iga458wh653z4z2s4k7g7a2i3rq + tag: 19782899875b1a5a08d79ab9abba174ab8f85724 + --sha256: 0zgsi6nlm8ky8l1kq9qahrmjpypjc7x1cszbbwi70qajd5ic7zcx subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/flake.lock b/flake.lock index 1d7ba32c80..78a4fdba2e 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1712241301, - "narHash": "sha256-Np3AKeg8JuT53MaoA9HAP3Rk+mzFJR05LbmamXtpeXM=", + "lastModified": 1712315807, + "narHash": "sha256-RdUQH5Wvm6jda6kM+rVgiz/qfpUXDJ2cXjIXdweh6NQ=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "91e98f31ae16e5a5833224c8ac46532fb72964a4", + "rev": "c6ae66cd05e72715d474da8f5469946b5db374ca", "type": "github" }, "original": { From f6b5db8f9d3f2a6d3e04041582636f1f1a85abb4 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 5 Apr 2024 13:47:13 +0200 Subject: [PATCH 10/19] Update consensus ref once more! --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 0d3a1c92da..570740f6b1 100644 --- a/cabal.project +++ b/cabal.project @@ -50,8 +50,8 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 19782899875b1a5a08d79ab9abba174ab8f85724 - --sha256: 0zgsi6nlm8ky8l1kq9qahrmjpypjc7x1cszbbwi70qajd5ic7zcx + tag: 33881548e70d619e652cb5334e31ee59ceefcc55 + --sha256: 1a64976szdvp0vmpjm974l955i18cjzqgcbyfgwjma8zh07r4347 subdir: ouroboros-consensus ouroboros-consensus-cardano From b22c2b29c1df1e8970bec4d1e1c05a98a306e683 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 5 Apr 2024 15:31:46 +0200 Subject: [PATCH 11/19] Invalidate cabal cache --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 4013efe14d..ffab16d0d9 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -17,7 +17,7 @@ jobs: env: # Modify this value to "invalidate" the cabal cache. - CABAL_CACHE_VERSION: "2024-03-25" + CABAL_CACHE_VERSION: "2024-04-05" concurrency: group: > From 5e6b14102d628892bd90e5bb59d45830c3cba613 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 5 Apr 2024 16:43:53 +0200 Subject: [PATCH 12/19] Update consensus ref and CHaP --- cabal.project | 14 +++----------- flake.lock | 6 +++--- 2 files changed, 6 insertions(+), 14 deletions(-) diff --git a/cabal.project b/cabal.project index 570740f6b1..6fdec1460b 100644 --- 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 2024-03-25T10:39:21Z - , cardano-haskell-packages 2024-04-05T11:01:53Z + , cardano-haskell-packages 2024-04-05T13:36:27Z packages: cardano-api @@ -39,19 +39,11 @@ write-ghc-environment-files: always -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. -source-repository-package - type: git - location: https://github.com/jasagredo/latex-svg - tag: c52c9905cb043ddb430c93b41ce431a7506a300d - --sha256: 0h9yrlvmyi32zlr0cj2nx8ik0y2cg5ckcxq4lgq5vvjyl6lhzrbk - subdir: - latex-svg-image - source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 33881548e70d619e652cb5334e31ee59ceefcc55 - --sha256: 1a64976szdvp0vmpjm974l955i18cjzqgcbyfgwjma8zh07r4347 + tag: 9e7d827b1e06de326e6e303c91b7d3d9d5402552 + --sha256: 1928whrs6fv7lvzqhhjxid38hxpq6gp62ghd9cqw38v2v765dpfx subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/flake.lock b/flake.lock index 78a4fdba2e..001e69cf93 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1712315807, - "narHash": "sha256-RdUQH5Wvm6jda6kM+rVgiz/qfpUXDJ2cXjIXdweh6NQ=", + "lastModified": 1712325757, + "narHash": "sha256-cOyalvthxBQzErM4UfsHmvIfmgXF0vUw7FK5txfTZoQ=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "c6ae66cd05e72715d474da8f5469946b5db374ca", + "rev": "d4205c96eeb139c87fcf2dc78627d867ab851acd", "type": "github" }, "original": { From c98b480098094e86aab43d5478b264032fd02da7 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 5 Apr 2024 17:04:13 +0200 Subject: [PATCH 13/19] Update consensus ref --- .github/workflows/haskell.yml | 2 +- cabal.project | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index ffab16d0d9..31140f7231 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -17,7 +17,7 @@ jobs: env: # Modify this value to "invalidate" the cabal cache. - CABAL_CACHE_VERSION: "2024-04-05" + CABAL_CACHE_VERSION: "2024-04-05-2" concurrency: group: > diff --git a/cabal.project b/cabal.project index 6fdec1460b..22f1c0d5c1 100644 --- a/cabal.project +++ b/cabal.project @@ -42,8 +42,8 @@ write-ghc-environment-files: always source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 9e7d827b1e06de326e6e303c91b7d3d9d5402552 - --sha256: 1928whrs6fv7lvzqhhjxid38hxpq6gp62ghd9cqw38v2v765dpfx + tag: 6b52504b882e1767f53bb37df4365c58014bea09 + --sha256: 1jc2n0h7a9569617r2ds4a8bi4j20xlgsnmgqn10cdjfbq3j74fk subdir: ouroboros-consensus ouroboros-consensus-cardano From a17852241968e8a9bfc8dec296809ed0899846e9 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 8 Apr 2024 05:24:01 +0000 Subject: [PATCH 14/19] Disable bitvec -simd on windows (prevent dependence on libc++) --- cabal.project | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cabal.project b/cabal.project index 22f1c0d5c1..d3c04ff7dd 100644 --- a/cabal.project +++ b/cabal.project @@ -28,6 +28,11 @@ package cryptonite -- generation is dubious. Set the flag so we use /dev/urandom by default. flags: -support_rdrand +-- bitvecs simd c++ dependencies break our windows build (for now) +if os(windows) + package bitvec + flags: -simd + tests: True test-show-details: direct From 1f729b836c928efc985f7c6beca19099e8e66b5f Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 8 Apr 2024 05:24:09 +0000 Subject: [PATCH 15/19] Update haskell.nix --- flake.lock | 84 +++++++++++++++++++++--------------------------------- 1 file changed, 33 insertions(+), 51 deletions(-) diff --git a/flake.lock b/flake.lock index 001e69cf93..834d2e6ad5 100644 --- a/flake.lock +++ b/flake.lock @@ -202,33 +202,33 @@ "type": "github" } }, - "ghc98X": { + "ghc910X": { "flake": false, "locked": { - "lastModified": 1696643148, - "narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=", - "ref": "ghc-9.8", - "rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6", - "revCount": 61642, + "lastModified": 1711543129, + "narHash": "sha256-MUI07CxYOng7ZwHnMCw0ugY3HmWo2p/f4r07CGV7OAM=", + "ref": "ghc-9.10", + "rev": "6ecd5f2ff97af53c7334f2d8581651203a2c6b7d", + "revCount": 62607, "submodules": true, "type": "git", "url": "https://gitlab.haskell.org/ghc/ghc" }, "original": { - "ref": "ghc-9.8", + "ref": "ghc-9.10", "submodules": true, "type": "git", "url": "https://gitlab.haskell.org/ghc/ghc" } }, - "ghc99": { + "ghc911": { "flake": false, "locked": { - "lastModified": 1701580282, - "narHash": "sha256-drA01r3JrXnkKyzI+owMZGxX0JameMzjK0W5jJE/+V4=", + "lastModified": 1711538967, + "narHash": "sha256-KSdOJ8seP3g30FaC2du8QjU9vumMnmzPR5wfkVRXQMk=", "ref": "refs/heads/master", - "rev": "f5eb0f2982e9cf27515e892c4bdf634bcfb28459", - "revCount": 62197, + "rev": "0acfe391583d77a72051d505f05fab0ada056c49", + "revCount": 62632, "submodules": true, "type": "git", "url": "https://gitlab.haskell.org/ghc/ghc" @@ -242,11 +242,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1708647761, - "narHash": "sha256-1WiRX2IqiopPq3sQTBPF7BswDacfGB9UUNnN9PYgrXA=", + "lastModified": 1712535859, + "narHash": "sha256-vlSP7kQMJE2w24qE/7uHY02ZW5JJ2gXQY12w7Xd1VEQ=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "6a164db037c9cb2fd7ea946e7a0d62d7d8f53766", + "rev": "bcd61e6c9a22fd661ce1e55e6b16a8b4dc8f4136", "type": "github" }, "original": { @@ -264,8 +264,8 @@ "cardano-shell": "cardano-shell", "flake-compat": "flake-compat_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", - "ghc98X": "ghc98X", - "ghc99": "ghc99", + "ghc910X": "ghc910X", + "ghc911": "ghc911", "hackage": "hackage", "hls-1.10": "hls-1.10", "hls-2.0": "hls-2.0", @@ -277,7 +277,6 @@ "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", - "nix-tools-static": "nix-tools-static", "nixpkgs": [ "haskellNix", "nixpkgs-unstable" @@ -294,11 +293,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1708649400, - "narHash": "sha256-iDwTrACFFetPuTc0efdZ5pukmMMj/e9rPIYAUJxSo1E=", + "lastModified": 1712537422, + "narHash": "sha256-/8xrHBgPHS9NoFa8MAsO7oY3iCMGNdcWLzSWkbKc0OE=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "a3e36bb1cc1f4ab1dbe1b12d5bf68220ba3daf64", + "rev": "e5ff7b65946282a46e51e4058f72e38be8418c7b", "type": "github" }, "original": { @@ -489,18 +488,18 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1691634696, - "narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", - "ref": "hkm/remote-iserv", - "rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", - "revCount": 14, - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "lastModified": 1708894040, + "narHash": "sha256-Rv+PajrnuJ6AeyhtqzMN+bcR8z9+aEnrUass+N951CQ=", + "owner": "stable-haskell", + "repo": "iserv-proxy", + "rev": "2f2a318fd8837f8063a0d91f329aeae29055fba9", + "type": "github" }, "original": { - "ref": "hkm/remote-iserv", - "type": "git", - "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" + "owner": "stable-haskell", + "ref": "iserv-syms", + "repo": "iserv-proxy", + "type": "github" } }, "lowdown-src": { @@ -540,23 +539,6 @@ "type": "github" } }, - "nix-tools-static": { - "flake": false, - "locked": { - "lastModified": 1706266250, - "narHash": "sha256-9t+GRk3eO9muCtKdNAwBtNBZ5dH1xHcnS17WaQyftwA=", - "owner": "input-output-hk", - "repo": "haskell-nix-example", - "rev": "580cb6db546a7777dad3b9c0fa487a366c045c4e", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "ref": "nix", - "repo": "haskell-nix-example", - "type": "github" - } - }, "nixpkgs": { "locked": { "lastModified": 1657693803, @@ -801,11 +783,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1708646943, - "narHash": "sha256-2yKh9HEWW+QvmUClepBuEQY0hgcPvCVoVHgrl3QPg8k=", + "lastModified": 1712535048, + "narHash": "sha256-GkQdcpkvoX5XXfgCRSmFl3ibQRVwwa9vyJ/gtn8YW80=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "6cd41c982e508c0ea3bb872ebccfdd7a65a58b2b", + "rev": "ad3c8abb39f04fe28c4d57d56553e11c594705a4", "type": "github" }, "original": { From 80a64eb5f6107727001234944e6294670185f638 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 8 Apr 2024 06:37:41 +0000 Subject: [PATCH 16/19] Bump cabal to 3.10.3.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit To fix the following build error of 3.10.2.0 src/Distribution/Client/CmdExec.hs:72:5: error: Module ‘Distribution.Simple.Program.Types’ does not export ‘simpleProgram’ | 72 | , simpleProgram | ^^^^^^^^^^^^^ --- flake.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flake.nix b/flake.nix index ff4869b8dd..01489a4d66 100644 --- a/flake.nix +++ b/flake.nix @@ -77,7 +77,7 @@ # tools we want in our shell, from hackage shell.tools = { - cabal = "3.10.2.0"; + cabal = "3.10.3.0"; ghcid = "0.8.8"; } // lib.optionalAttrs (config.compiler-nix-name == defaultCompiler) { From be6c05f5f007ad9320da182fbde86983a7945905 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 8 Apr 2024 10:02:14 +0200 Subject: [PATCH 17/19] Bump consensus ref --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index d3c04ff7dd..0cd4495475 100644 --- a/cabal.project +++ b/cabal.project @@ -47,8 +47,8 @@ write-ghc-environment-files: always source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 6b52504b882e1767f53bb37df4365c58014bea09 - --sha256: 1jc2n0h7a9569617r2ds4a8bi4j20xlgsnmgqn10cdjfbq3j74fk + tag: 144666d22235fc441fda615a7c7990f4e301d176 + --sha256: 07qd9alk2ck1a5piv6ax79pvv10618939npqpvi6qmv59bmpx7a8 subdir: ouroboros-consensus ouroboros-consensus-cardano From a0c348722c2d6fe77d807caf8ec705c6be77122b Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 15 Apr 2024 11:57:10 +0200 Subject: [PATCH 18/19] Update consensus ref --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 0cd4495475..0ddc33e6a4 100644 --- a/cabal.project +++ b/cabal.project @@ -47,8 +47,8 @@ write-ghc-environment-files: always source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 144666d22235fc441fda615a7c7990f4e301d176 - --sha256: 07qd9alk2ck1a5piv6ax79pvv10618939npqpvi6qmv59bmpx7a8 + tag: e1a9eccc44c039ba57e09ea4631bcb5353a52e19 + --sha256: 0hvlb77r37gvhr63kfsypfpm3cf9sarq3b09c812xv4a6vx8msjw subdir: ouroboros-consensus ouroboros-consensus-cardano From 239a713e8fdfca85ae4516e94d6cb8971ec6ca0f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 24 May 2024 12:49:32 +0200 Subject: [PATCH 19/19] Update consensus ref --- cabal.project | 6 +++--- flake.lock | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cabal.project b/cabal.project index 0ddc33e6a4..ffeeda81b1 100644 --- 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 2024-03-25T10:39:21Z - , cardano-haskell-packages 2024-04-05T13:36:27Z + , cardano-haskell-packages 2024-05-24T09:29:56Z packages: cardano-api @@ -47,8 +47,8 @@ write-ghc-environment-files: always source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: e1a9eccc44c039ba57e09ea4631bcb5353a52e19 - --sha256: 0hvlb77r37gvhr63kfsypfpm3cf9sarq3b09c812xv4a6vx8msjw + tag: 858fbd77bca6c423a44feef41e31adaf0400e267 + --sha256: 0bxxvw96nsg22pmxxlf1fzr7g09xi6b60frvjngrwidlsv31nf2q subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/flake.lock b/flake.lock index 834d2e6ad5..b77a6b3899 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1712325757, - "narHash": "sha256-cOyalvthxBQzErM4UfsHmvIfmgXF0vUw7FK5txfTZoQ=", + "lastModified": 1716544578, + "narHash": "sha256-Z9J23IQjRu4gKOI+jj6Rm8Bnza3CYHXLRLhNNg7QVkU=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "d4205c96eeb139c87fcf2dc78627d867ab851acd", + "rev": "19b29505e8d0a5bdd264db8911f88fcaa8a93090", "type": "github" }, "original": {