From 533c55bc1f6e239088facbf928dbd4a94c66fb12 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Fri, 24 Nov 2023 16:21:54 -0700 Subject: [PATCH 01/10] Use a version of LedgerEventHandler specialized to use StandardCrypto --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index 80fdaf4ac78..17f8c6310c7 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -29,6 +29,7 @@ module Cardano.Node.LedgerEvent ( , ledgerEventName -- ** Using Ledger events + , StandardLedgerEventHandler , withLedgerEventsServerStream , foldEvent @@ -341,9 +342,9 @@ ledgerRewardUpdateEventName = \case LedgerIncrementalRewards {} -> "LedgerIncrementalRewards" fromAuxLedgerEvent - :: forall xs crypto. (All ConvertLedgerEvent xs, crypto ~ StandardCrypto) + :: forall xs. (All ConvertLedgerEvent xs) => AuxLedgerEvent (Abstract.LedgerState (HardForkBlock xs)) - -> Maybe (LedgerEvent crypto) + -> Maybe (LedgerEvent StandardCrypto) fromAuxLedgerEvent = toLedgerEvent . WrapLedgerEvent @(HardForkBlock xs) @@ -767,9 +768,11 @@ foldEvent h st0 fn = st' <- fn st event go st' events +type StandardLedgerEventHandler = LedgerEventHandler IO (LedgerState StandardCrypto) (HardForkBlock (CardanoEras StandardCrypto)) + withLedgerEventsServerStream :: PortNumber - -> (LedgerEventHandler IO (LedgerState StandardCrypto) (HardForkBlock (CardanoEras crypto)) -> IO ()) + -> (StandardLedgerEventHandler -> IO ()) -> IO () withLedgerEventsServerStream port handler = do withSocketsDo $ do From 89d58746007564f09d677f2704535a7ac47b059b Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 28 Nov 2023 15:06:15 -0700 Subject: [PATCH 02/10] Pass a list of event handlers to runNode --- cabal.project | 4 ++-- cardano-node-capi/src/Node.hs | 2 +- cardano-node/app/cardano-node.hs | 2 +- cardano-node/src/Cardano/Node/Run.hs | 18 +++++++++++++----- 4 files changed, 17 insertions(+), 9 deletions(-) diff --git a/cabal.project b/cabal.project index 9ae783614b0..66d7f5378a2 100644 --- a/cabal.project +++ b/cabal.project @@ -66,8 +66,8 @@ package bitvec source-repository-package type: git location: https://github.com/CardanoSolutions/ouroboros-consensus - tag: 019a99b71f9d009e1a2101d09f6be0e75a33ea96 - --sha256: 1y39a5zp8g8bra5nss5n8wwjla3x8hc8xwnn3r8wwvkxsrgplgw4 + tag: 79da9a368cb6d2e7ed5ff5e89bb318b94c3c606d + --sha256: sha256-a3pPcIQPk4GgsWREAnfo/xHYqTb9dWaXzyU3t95ekgs= subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-node-capi/src/Node.hs b/cardano-node-capi/src/Node.hs index 77af514c4fc..8c6406f72cc 100644 --- a/cardano-node-capi/src/Node.hs +++ b/cardano-node-capi/src/Node.hs @@ -19,7 +19,7 @@ foreign export ccall "runNode" crunNode :: Int -> Ptr CString -> IO () crunNode :: Int -> Ptr CString -> IO () crunNode argc argv = peekArray argc argv >>= mapM peekCString >>= \args -> case execParserPure pref opts args of - Success pnc -> runNode pnc + Success pnc -> runNode pnc [] Failure f -> print f CompletionInvoked _ -> putStrLn "Completion Invoked?" where diff --git a/cardano-node/app/cardano-node.hs b/cardano-node/app/cardano-node.hs index 20693e4cec7..cda9a85163f 100644 --- a/cardano-node/app/cardano-node.hs +++ b/cardano-node/app/cardano-node.hs @@ -30,7 +30,7 @@ main = do cmd <- Opt.customExecParser p opts case cmd of - RunCmd args -> runNode args + RunCmd args -> runNode args [] TraceDocumentation tdc -> runTraceDocumentationCmd tdc VersionCmd -> runVersionCommand diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 8f46a46f7d1..d86c8475110 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -82,7 +82,10 @@ import Cardano.Node.Configuration.NodeAddress import Cardano.Node.Configuration.POM (NodeConfiguration (..), PartialNodeConfiguration (..), SomeNetworkP2PMode (..), defaultPartialNodeConfiguration, makeNodeConfiguration, parseNodeConfigurationFP) -import Cardano.Node.LedgerEvent (withLedgerEventsServerStream) +import Cardano.Node.LedgerEvent ( + StandardLedgerEventHandler, + withLedgerEventsServerStream, + ) import Cardano.Node.Startup import Cardano.Node.Tracing.API import Cardano.Node.Tracing.StateRep (NodeState (NodeKernelOnline)) @@ -139,8 +142,9 @@ import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValenc runNode :: PartialNodeConfiguration + -> [StandardLedgerEventHandler] -> IO () -runNode cmdPc = do +runNode cmdPc eventHandlers = do installSigTermHandler Crypto.cryptoInit @@ -183,12 +187,16 @@ runNode cmdPc = do (SomeConsensusProtocol blockType@Api.CardanoBlockType runP, Just port) -> withLedgerEventsServerStream (fromIntegral port) $ \ledgerEventHandler -> handleNodeWithTracers - ledgerEventHandler + (mconcat $ ledgerEventHandler : eventHandlers) cmdPc nc p networkMagic blockType runP - (SomeConsensusProtocol blockType runP, _noGivenPort) -> + (SomeConsensusProtocol blockType@Api.CardanoBlockType runP, Nothing) -> handleNodeWithTracers - discardEvent + (mconcat eventHandlers) cmdPc nc p networkMagic blockType runP + (SomeConsensusProtocol otherBlockType runP, _somePort) -> + handleNodeWithTracers + mempty + cmdPc nc p networkMagic otherBlockType runP -- | Workaround to ensure that the main thread throws an async exception on -- receiving a SIGTERM signal. From 5c4905f682ca105227cc2792053584602b4436d8 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 28 Nov 2023 16:31:13 -0700 Subject: [PATCH 03/10] Implement withLedgerEventsChan --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 44 +++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index 17f8c6310c7..d76255d7c75 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -32,6 +32,10 @@ module Cardano.Node.LedgerEvent ( , StandardLedgerEventHandler , withLedgerEventsServerStream , foldEvent + , withLedgerEventsChan + , mkLedgerEventHandler + , LedgerEventWriter + , LedgerEventReader -- * Type-level plumbing , ConvertLedgerEvent (..) @@ -81,6 +85,7 @@ import qualified Codec.CBOR.Decoding as CBOR import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Read as CBOR import qualified Codec.CBOR.Write as CBOR +import Control.Concurrent.STM (newTChanIO, readTChan, writeTChan) import Control.State.Transition (Event) import Data.ByteString.Short(ShortByteString) import qualified Data.ByteString.Lazy as LBS @@ -112,7 +117,7 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import qualified Cardano.Ledger.Shelley.API as ShelleyAPI import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyEvent (ShelleyInAlonzoEvent), AlonzoUtxowEvent (WrappedShelleyEraEvent), AlonzoUtxoEvent (UtxosEvent), AlonzoUtxosEvent) import GHC.IO.Exception (IOException(IOError, ioe_type), IOErrorType (ResourceVanished)) -import Ouroboros.Network.Block (ChainHash(GenesisHash, BlockHash)) +import Ouroboros.Network.Block (ChainHash(GenesisHash, BlockHash), HeaderHash) type LedgerState crypto = ExtLedgerState (HardForkBlock (CardanoEras crypto)) @@ -807,3 +812,40 @@ withLedgerEventsServerStream port handler = do err -> do print err throwIO err + +withLedgerEventsChan + :: (LedgerEventWriter -> LedgerEventReader -> IO a) + -> IO a +withLedgerEventsChan action = do + chan <- newTChanIO + action (atomically . writeTChan chan) (atomically $ readTChan chan) + +type LedgerEventWriter = AnchoredEvent -> IO () +type LedgerEventReader = IO AnchoredEvent + +mkLedgerEventHandler + :: LedgerEventWriter + -> StandardLedgerEventHandler +mkLedgerEventHandler writer = + LedgerEventHandler $ \p h s b -> traverse_ writer . mkAnchoredEvents p h s b + +mkAnchoredEvents + :: ChainHash (HardForkBlock (CardanoEras StandardCrypto)) + -> HeaderHash (HardForkBlock (CardanoEras StandardCrypto)) + -> SlotNo + -> BlockNo + -> [AuxLedgerEvent (LedgerState StandardCrypto)] + -> [AnchoredEvent] +mkAnchoredEvents prevHash headerHash slotNo blockNo auxEvents = + [ AnchoredEvent + (getOneEraHash <$> chainHashToOriginHash prevHash) + (getOneEraHash headerHash) + slotNo + blockNo + ledgerEvent + | Just ledgerEvent <- map fromAuxLedgerEvent auxEvents + ] + where + chainHashToOriginHash :: ChainHash b -> WithOrigin (HeaderHash b) + chainHashToOriginHash GenesisHash = Origin + chainHashToOriginHash (BlockHash bh) = At bh From 29d39811c5b023f43168a544dd53d52a53eb29a0 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Tue, 28 Nov 2023 17:23:10 -0700 Subject: [PATCH 04/10] Refactor to share more code between socket and chan ledger event handlers --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 63 ++++++++++---------- 1 file changed, 31 insertions(+), 32 deletions(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index d76255d7c75..cfb5ad6362d 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -11,6 +11,7 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -59,6 +60,7 @@ module Cardano.Node.LedgerEvent ( import Cardano.Prelude hiding (All, Sum) +import Control.Arrow ((&&&)) import Control.Monad.Fail (MonadFail(..)) import Cardano.Ledger.Binary (DecCBOR(..), EncCBOR(..), Version, decodeFull', fromCBOR, serialize', toCBOR) @@ -731,8 +733,8 @@ instance DecCBOR AnchoredEvent where AnchoredEvent -> ByteString -serializeAnchoredEvent version event = +serializeAnchoredEvent :: (Version, AnchoredEvent) -> ByteString +serializeAnchoredEvent (version, event) = CBOR.toStrictByteString encoding where encoding = @@ -744,7 +746,7 @@ serializeAnchoredEvent version event = deserializeAnchoredEvent :: LBS.ByteString - -> Either CBOR.DeserialiseFailure (LBS.ByteString, AnchoredEvent) + -> Either CBOR.DeserialiseFailure (LBS.ByteString, (Version, AnchoredEvent)) deserializeAnchoredEvent = CBOR.deserialiseFromBytes decoder where @@ -753,7 +755,7 @@ deserializeAnchoredEvent = _ <- CBOR.decodeListLen version <- fromCBOR bytes <- CBOR.decodeBytes - either (fail . show) pure (decodeFull' version bytes) + either (fail . show) (pure . (version,)) $ decodeFull' version bytes -- IO action to read ledger events in binary form foldEvent @@ -769,7 +771,7 @@ foldEvent h st0 fn = if eof then pure st else do - (events, event) <- either (panic . show) pure $ deserializeAnchoredEvent bytes + (events, (_version, event)) <- either (panic . show) pure $ deserializeAnchoredEvent bytes st' <- fn st event go st' events @@ -779,13 +781,13 @@ withLedgerEventsServerStream :: PortNumber -> (StandardLedgerEventHandler -> IO ()) -> IO () -withLedgerEventsServerStream port handler = do +withLedgerEventsServerStream port action = do withSocketsDo $ do bracket open closeSockets go where go s = do h <- socketToHandle s WriteMode - handler $ LedgerEventHandler $ writeLedgerEvents h + action $ mkLedgerEventHandler (writeAnchoredEvent h) open = do sock <- socket AF_INET Stream defaultProtocol @@ -797,21 +799,15 @@ withLedgerEventsServerStream port handler = do closeSockets = close - writeLedgerEvents h ph headerHash slotNo blockNo events = do - forM_ events $ \event -> do - case fromAuxLedgerEvent event of - Nothing -> pure () - Just e -> do - let chainHashToHeaderHash GenesisHash = Origin - chainHashToHeaderHash (BlockHash bh) = At bh - let anchoredEvent = AnchoredEvent (getOneEraHash <$> chainHashToHeaderHash ph) (getOneEraHash headerHash) slotNo blockNo e - catch (BS.hPut h $ serializeAnchoredEvent (eventCodecVersion event) anchoredEvent) $ \case - -- If the client closes the socket, we continue running the node, but ignore the events. - IOError { ioe_type = ResourceVanished } -> do - pure () - err -> do - print err - throwIO err + writeAnchoredEvent h = handle errHandler . BS.hPut h . serializeAnchoredEvent + where + errHandler = \case + -- If the client closes the socket, we continue running the node, but ignore the events. + IOError { ioe_type = ResourceVanished } -> do + pure () + err -> do + print err + throwIO err withLedgerEventsChan :: (LedgerEventWriter -> LedgerEventReader -> IO a) @@ -820,8 +816,8 @@ withLedgerEventsChan action = do chan <- newTChanIO action (atomically . writeTChan chan) (atomically $ readTChan chan) -type LedgerEventWriter = AnchoredEvent -> IO () -type LedgerEventReader = IO AnchoredEvent +type LedgerEventWriter = (Version, AnchoredEvent) -> IO () +type LedgerEventReader = IO (Version, AnchoredEvent) mkLedgerEventHandler :: LedgerEventWriter @@ -835,15 +831,18 @@ mkAnchoredEvents -> SlotNo -> BlockNo -> [AuxLedgerEvent (LedgerState StandardCrypto)] - -> [AnchoredEvent] + -> [(Version, AnchoredEvent)] mkAnchoredEvents prevHash headerHash slotNo blockNo auxEvents = - [ AnchoredEvent - (getOneEraHash <$> chainHashToOriginHash prevHash) - (getOneEraHash headerHash) - slotNo - blockNo - ledgerEvent - | Just ledgerEvent <- map fromAuxLedgerEvent auxEvents + [ (version, + AnchoredEvent + (getOneEraHash <$> chainHashToOriginHash prevHash) + (getOneEraHash headerHash) + slotNo + blockNo + ledgerEvent + ) + | (version, Just ledgerEvent) + <- (eventCodecVersion &&& fromAuxLedgerEvent) <$> auxEvents ] where chainHashToOriginHash :: ChainHash b -> WithOrigin (HeaderHash b) From 9fcc0b131b31a7d7b4600d559107a2483f2e2e5a Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Thu, 30 Nov 2023 18:24:28 -0700 Subject: [PATCH 05/10] Aggregate ledger events into groups We group them by protocol version because the version has to be sent out-of-band from the encoding of the events themselves --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 84 ++++++++++---------- 1 file changed, 43 insertions(+), 41 deletions(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index cfb5ad6362d..fa0325f58a9 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -11,7 +11,6 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -21,12 +20,11 @@ -- Shamelessly stolen and adapted from db-sync. module Cardano.Node.LedgerEvent ( -- * Ledger Events - AnchoredEvent (..) + AnchoredEvents (..) , LedgerEvent (..) , LedgerNewEpochEvent (..) , LedgerRewardUpdateEvent (..) - , deserializeAnchoredEvent - , serializeAnchoredEvent + , Versioned (..) , ledgerEventName -- ** Using Ledger events @@ -35,8 +33,8 @@ module Cardano.Node.LedgerEvent ( , foldEvent , withLedgerEventsChan , mkLedgerEventHandler - , LedgerEventWriter - , LedgerEventReader + , LedgerEventsWriter + , LedgerEventsReader -- * Type-level plumbing , ConvertLedgerEvent (..) @@ -92,6 +90,7 @@ import Control.State.Transition (Event) import Data.ByteString.Short(ShortByteString) import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS +import qualified Data.List.NonEmpty as NE import Data.SOP (All, K (..)) import Data.SOP.Strict (NS(..), hcmap, hcollapse) import qualified Data.Set as Set @@ -705,36 +704,38 @@ eventCodecVersion = \case OneEraLedgerEvent ( S(S(S(S(S(Z{}))))) ) -> eraProtVerLow @(BabbageEra crypto) OneEraLedgerEvent (S(S(S(S(S(S(Z{}))))))) -> eraProtVerLow @(ConwayEra crypto) -data AnchoredEvent = - AnchoredEvent +data AnchoredEvents = + AnchoredEvents { prevBlockHeaderHash :: !(WithOrigin ShortByteString) , blockHeaderHash :: !ShortByteString , slotNo :: !SlotNo , blockNo :: !BlockNo - , ledgerEvent :: !(LedgerEvent StandardCrypto) + , ledgerEvents :: !(NonEmpty (LedgerEvent StandardCrypto)) } deriving (Eq, Show) -instance EncCBOR AnchoredEvent where - encCBOR AnchoredEvent{prevBlockHeaderHash, blockHeaderHash , slotNo, blockNo, ledgerEvent} = - encode $ Rec AnchoredEvent +instance EncCBOR AnchoredEvents where + encCBOR AnchoredEvents{prevBlockHeaderHash, blockHeaderHash , slotNo, blockNo, ledgerEvents} = + encode $ Rec AnchoredEvents !> To prevBlockHeaderHash !> To blockHeaderHash !> To slotNo !> To blockNo - !> To ledgerEvent + !> To ledgerEvents -instance DecCBOR AnchoredEvent where +instance DecCBOR AnchoredEvents where decCBOR = - decode $ RecD AnchoredEvent + decode $ RecD AnchoredEvents ByteString -serializeAnchoredEvent (version, event) = +data Versioned a = Versioned Version a + +serializeVersioned :: EncCBOR a => Versioned a -> ByteString +serializeVersioned (Versioned version x) = CBOR.toStrictByteString encoding where encoding = @@ -742,12 +743,13 @@ serializeAnchoredEvent (version, event) = <> toCBOR version <> - CBOR.encodeBytes (serialize' version event) + CBOR.encodeBytes (serialize' version x) -deserializeAnchoredEvent - :: LBS.ByteString - -> Either CBOR.DeserialiseFailure (LBS.ByteString, (Version, AnchoredEvent)) -deserializeAnchoredEvent = +deserializeVersioned + :: DecCBOR a + => LBS.ByteString + -> Either CBOR.DeserialiseFailure (LBS.ByteString, Versioned a) +deserializeVersioned = CBOR.deserialiseFromBytes decoder where decoder = do @@ -755,13 +757,13 @@ deserializeAnchoredEvent = _ <- CBOR.decodeListLen version <- fromCBOR bytes <- CBOR.decodeBytes - either (fail . show) (pure . (version,)) $ decodeFull' version bytes + either (fail . show) (pure . Versioned version) $ decodeFull' version bytes -- IO action to read ledger events in binary form foldEvent :: Handle -> a - -> (a -> AnchoredEvent -> IO a) + -> (a -> AnchoredEvents -> IO a) -> IO a foldEvent h st0 fn = LBS.hGetContents h >>= go st0 @@ -771,7 +773,7 @@ foldEvent h st0 fn = if eof then pure st else do - (events, (_version, event)) <- either (panic . show) pure $ deserializeAnchoredEvent bytes + (events, Versioned _ event) <- either (panic . show) pure $ deserializeVersioned bytes st' <- fn st event go st' events @@ -787,7 +789,7 @@ withLedgerEventsServerStream port action = do where go s = do h <- socketToHandle s WriteMode - action $ mkLedgerEventHandler (writeAnchoredEvent h) + action $ mkLedgerEventHandler (writeAnchoredEvents h) open = do sock <- socket AF_INET Stream defaultProtocol @@ -799,7 +801,7 @@ withLedgerEventsServerStream port action = do closeSockets = close - writeAnchoredEvent h = handle errHandler . BS.hPut h . serializeAnchoredEvent + writeAnchoredEvents h = handle errHandler . BS.hPut h . serializeVersioned where errHandler = \case -- If the client closes the socket, we continue running the node, but ignore the events. @@ -810,41 +812,41 @@ withLedgerEventsServerStream port action = do throwIO err withLedgerEventsChan - :: (LedgerEventWriter -> LedgerEventReader -> IO a) + :: (LedgerEventsWriter -> LedgerEventsReader -> IO a) -> IO a withLedgerEventsChan action = do chan <- newTChanIO action (atomically . writeTChan chan) (atomically $ readTChan chan) -type LedgerEventWriter = (Version, AnchoredEvent) -> IO () -type LedgerEventReader = IO (Version, AnchoredEvent) +type LedgerEventsWriter = Versioned AnchoredEvents -> IO () +type LedgerEventsReader = IO (Versioned AnchoredEvents) mkLedgerEventHandler - :: LedgerEventWriter + :: LedgerEventsWriter -> StandardLedgerEventHandler mkLedgerEventHandler writer = - LedgerEventHandler $ \p h s b -> traverse_ writer . mkAnchoredEvents p h s b + LedgerEventHandler $ \p h s b -> traverse_ writer . mkVersionedAnchoredEvents p h s b -mkAnchoredEvents +mkVersionedAnchoredEvents :: ChainHash (HardForkBlock (CardanoEras StandardCrypto)) -> HeaderHash (HardForkBlock (CardanoEras StandardCrypto)) -> SlotNo -> BlockNo -> [AuxLedgerEvent (LedgerState StandardCrypto)] - -> [(Version, AnchoredEvent)] -mkAnchoredEvents prevHash headerHash slotNo blockNo auxEvents = - [ (version, - AnchoredEvent + -> [Versioned AnchoredEvents] +mkVersionedAnchoredEvents prevHash headerHash slotNo blockNo auxEvents = + [ Versioned version $ + AnchoredEvents (getOneEraHash <$> chainHashToOriginHash prevHash) (getOneEraHash headerHash) slotNo blockNo - ledgerEvent - ) - | (version, Just ledgerEvent) - <- (eventCodecVersion &&& fromAuxLedgerEvent) <$> auxEvents + ledgerEvents + | (version, ledgerEvents) <- versionedGroups ] where chainHashToOriginHash :: ChainHash b -> WithOrigin (HeaderHash b) chainHashToOriginHash GenesisHash = Origin chainHashToOriginHash (BlockHash bh) = At bh + versionedEvents = mapMaybe (sequence . (eventCodecVersion &&& fromAuxLedgerEvent)) auxEvents + versionedGroups = map (first NE.head . NE.unzip) . NE.groupBy ((==) `on` fst) $ versionedEvents From 85a03b4715f66ce4d7c3fd3fc79dcad386206d13 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Sat, 2 Dec 2023 10:54:23 -0700 Subject: [PATCH 06/10] Fix hlint warnings --- .github/workflows/check-hlint.yml | 2 +- cardano-node/test/Test/Cardano/Node/LedgerEvent.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/check-hlint.yml b/.github/workflows/check-hlint.yml index 33376132a33..11897a531ae 100644 --- a/.github/workflows/check-hlint.yml +++ b/.github/workflows/check-hlint.yml @@ -23,7 +23,7 @@ jobs: - name: 'Set up HLint' uses: rwe/actions-hlint-setup@v1 with: - version: 3.3 + version: 3.5 - name: 'Run HLint' uses: rwe/actions-hlint-run@v2 diff --git a/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs b/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs index 3d2dad4fa3a..6e7342569c9 100644 --- a/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module Test.Cardano.Node.LedgerEvent where From ea370bbb4cee7f223283f2304933943e848974a8 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Sat, 2 Dec 2023 11:36:31 -0700 Subject: [PATCH 07/10] Fix stylish-haskell warnings --- cardano-git-rev/src/Cardano/Git/Rev.hs | 4 +- .../src/Cardano/Node/Configuration/POM.hs | 2 +- cardano-node/src/Cardano/Node/LedgerEvent.hs | 110 +++++++++--------- cardano-node/src/Cardano/Node/Run.hs | 17 ++- .../test/Test/Cardano/Node/LedgerEvent.hs | 12 +- cardano-node/test/cardano-node-test.hs | 2 +- cddl/src/Codec/CBOR/Schema.hs | 16 +-- cddl/test/Codec/CBOR/SchemaSpec.hs | 6 +- 8 files changed, 82 insertions(+), 87 deletions(-) diff --git a/cardano-git-rev/src/Cardano/Git/Rev.hs b/cardano-git-rev/src/Cardano/Git/Rev.hs index 7d8972465af..6b15f4cb295 100644 --- a/cardano-git-rev/src/Cardano/Git/Rev.hs +++ b/cardano-git-rev/src/Cardano/Git/Rev.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ForeignFunctionInterface #-} module Cardano.Git.Rev ( gitRev @@ -13,8 +13,8 @@ import qualified Data.Text as T #if !defined(arm_HOST_ARCH) import Cardano.Git.RevFromGit (gitRevFromGit) #endif -import GHC.Foreign (peekCStringLen) import Foreign.C.String (CString) +import GHC.Foreign (peekCStringLen) import System.IO (utf8) import System.IO.Unsafe (unsafeDupablePerformIO) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 2c446a2a89a..8efc3d693ff 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -40,7 +40,7 @@ import System.FilePath (takeDirectory, ()) import Cardano.Crypto (RequiresNetworkMagic (..)) import Cardano.Logging.Types -import Cardano.Node.Configuration.NodeAddress (SocketPath, PortNumber) +import Cardano.Node.Configuration.NodeAddress (PortNumber, SocketPath) import Cardano.Node.Configuration.Socket (SocketConfig (..)) import Cardano.Node.Handlers.Shutdown import Cardano.Node.Protocol.Types (Protocol (..)) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index fa0325f58a9..dfc0e58e5eb 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -1,19 +1,19 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | Local representation for display purpose of cardano-ledger events. -- @@ -58,67 +58,65 @@ module Cardano.Node.LedgerEvent ( import Cardano.Prelude hiding (All, Sum) -import Control.Arrow ((&&&)) -import Control.Monad.Fail (MonadFail(..)) -import Cardano.Ledger.Binary (DecCBOR(..), EncCBOR(..), Version, - decodeFull', fromCBOR, serialize', toCBOR) -import Cardano.Ledger.Binary.Coders (Decode(..), Encode (..), encode, (!>), - (), ()) import System.IO.Unsafe (unsafePerformIO) -import qualified Data.Text as T -import qualified Data.Text.IO as TIO specification :: Text specification = diff --git a/cardano-node/test/cardano-node-test.hs b/cardano-node/test/cardano-node-test.hs index fd89e9b3c88..fea4910d0c5 100644 --- a/cardano-node/test/cardano-node-test.hs +++ b/cardano-node/test/cardano-node-test.hs @@ -14,8 +14,8 @@ import qualified Test.Cardano.Node.FilePermissions import qualified Test.Cardano.Node.Json import qualified Test.Cardano.Node.LedgerEvent import qualified Test.Cardano.Node.POM -import qualified Test.Cardano.Tracing.OrphanInstances.HardFork import qualified Test.Cardano.Tracing.NewTracing.Consistency +import qualified Test.Cardano.Tracing.OrphanInstances.HardFork import qualified Cardano.Crypto.Init as Crypto diff --git a/cddl/src/Codec/CBOR/Schema.hs b/cddl/src/Codec/CBOR/Schema.hs index bffe8d0681d..c8376a1659f 100644 --- a/cddl/src/Codec/CBOR/Schema.hs +++ b/cddl/src/Codec/CBOR/Schema.hs @@ -3,17 +3,17 @@ module Codec.CBOR.Schema where -import Prelude +import Prelude -import Data.Text (Text) -import qualified Data.Text as Text -import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as Base16 +import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as B8 -import Foreign.Marshal.Alloc (free) -import Foreign.C.String (CString, peekCString, withCStringLen) -import System.IO.Unsafe (unsafePerformIO) +import Data.Text (Text) +import qualified Data.Text as Text +import Foreign.C.String (CString, peekCString, withCStringLen) +import Foreign.Marshal.Alloc (free) +import System.IO.Unsafe (unsafePerformIO) data ValidationError = ValidationError { cbor :: String -- | The erroneous CBOR as a base16-encoded text string diff --git a/cddl/test/Codec/CBOR/SchemaSpec.hs b/cddl/test/Codec/CBOR/SchemaSpec.hs index 82df24816ab..4badc783082 100644 --- a/cddl/test/Codec/CBOR/SchemaSpec.hs +++ b/cddl/test/Codec/CBOR/SchemaSpec.hs @@ -1,12 +1,12 @@ module Codec.CBOR.SchemaSpec where -import Prelude +import Prelude import qualified Codec.CBOR.Schema as CDDL import qualified Data.ByteString.Base16 as Base16 -import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text.Encoding as T -import Test.Hspec (Spec, SpecWith, context, specify, shouldBe) +import Test.Hspec (Spec, SpecWith, context, shouldBe, specify) spec :: Spec spec = context "Codec.CBOR.SchemaSpec" $ do From 8d9a9f295b839406242dc4901d43c595cf424832 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Sat, 2 Dec 2023 11:44:09 -0700 Subject: [PATCH 08/10] Fix check-nix-config errors --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 66d7f5378a2..05151d9aae4 100644 --- a/cabal.project +++ b/cabal.project @@ -67,7 +67,7 @@ source-repository-package type: git location: https://github.com/CardanoSolutions/ouroboros-consensus tag: 79da9a368cb6d2e7ed5ff5e89bb318b94c3c606d - --sha256: sha256-a3pPcIQPk4GgsWREAnfo/xHYqTb9dWaXzyU3t95ekgs= + --sha256: 02wjbvgbfdr5rybncxgx6slxh4gzx1vh4i34n6h834qghiq4yykb subdir: ouroboros-consensus ouroboros-consensus-cardano From a28540f690f485fc28283528e824652c17ce62c0 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Sat, 2 Dec 2023 11:40:30 -0700 Subject: [PATCH 09/10] Fix check-mainnet-config errors --- .github/workflows/check-mainnet-config.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/check-mainnet-config.yml b/.github/workflows/check-mainnet-config.yml index a9549738c2f..88b11c0e968 100644 --- a/.github/workflows/check-mainnet-config.yml +++ b/.github/workflows/check-mainnet-config.yml @@ -50,9 +50,9 @@ jobs: for f in "${test_files[@]}"; do nix_file="result/$f" repo_file="configuration/cardano/$f" - if ! jq -e --argfile nix "$nix_file" --argfile repo "$repo_file" -n '$repo | reduce keys[] as $k (true; . and $repo[$k] == $nix[$k])' &>/dev/null ; then + if ! jq -e --argfile nix "$nix_file" --argfile repo "$repo_file" -n '$repo | reduce keys[] as $k (true; . and $repo[$k] == $nix[$k])' >/dev/null ; then echo "Nix file $nix_file does not have all the same top-level entries as the file from repository $repo_file" - diff "$nix_file" "$repo_file" + diff <(jq -S . "$nix_file") <(jq -S . "$repo_file") exit 1 fi done From 15e08071ad9adc8e73c15bac6e5b41a9f9bbf7c5 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Fri, 8 Dec 2023 15:45:59 -0700 Subject: [PATCH 10/10] Revert to using ghc928 --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 3 +-- nix/haskell.nix | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index dfc0e58e5eb..dabd7281052 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -6,7 +6,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RankNTypes #-} @@ -115,7 +114,7 @@ import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState) import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, ShelleyLedgerEvent (..)) import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Network.Block (ChainHash (BlockHash, GenesisHash), HeaderHash) -import Prelude (type (~)) +import Prelude hiding (MonadFail (..), String, map, print, putStrLn, show, (.)) import System.IO (hIsEOF) type LedgerState crypto = diff --git a/nix/haskell.nix b/nix/haskell.nix index 8d902acb3b0..02464e3e06f 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -20,7 +20,7 @@ let { src = ../.; name = "cardano-node"; - compiler-nix-name = lib.mkDefault "ghc963"; + compiler-nix-name = lib.mkDefault "ghc928"; # extra-compilers flake.variants = lib.genAttrs [ ] (x: {compiler-nix-name = x;}); cabalProjectLocal = ''