Stream ledger events to a socket

Coauthored by:

* Konstantinos Lambrou-Latreille <konstantinos.lambrou@iohk.io>
* Arnaud Bailly <arnaud.bailly@iohk.io>
* Neil Mayhew <neil.mayhew@iohk.io>

bench/tx-generator/tx-generator.cabal

@@ -123,9 +123,9 @@ library
                       , network
                       , network-mux
                       , optparse-applicative-fork
-                      , ouroboros-consensus >= 0.6
-                      , ouroboros-consensus-cardano >= 0.5
-                      , ouroboros-consensus-diffusion >= 0.7.0
+                      , ouroboros-consensus ^>= 0.11
+                      , ouroboros-consensus-cardano >= 0.9
+                      , ouroboros-consensus-diffusion ^>= 0.8
                       , ouroboros-network
                       , ouroboros-network-api
                       , ouroboros-network-framework

cabal.project

@@ -57,3 +57,19 @@ package bitvec
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
 
 -- `smtp-mail` should depend on `crypton-connection` rather than `connection`!
+
+-- We need a forked version of ouroboros-consensus to support ledger
+-- events extraction from the application of blocks
+--
+-- To compute sha256 field:
+-- $ nix-prefetch-git https://github.com/CardanoSolutions/ouroboros-consensus XXXX
+source-repository-package
+    type: git
+    location: https://github.com/CardanoSolutions/ouroboros-consensus
+    tag: 019a99b71f9d009e1a2101d09f6be0e75a33ea96
+    --sha256: 1y39a5zp8g8bra5nss5n8wwjla3x8hc8xwnn3r8wwvkxsrgplgw4
+    subdir:
+      ouroboros-consensus
+      ouroboros-consensus-cardano
+      ouroboros-consensus-protocol
+      ouroboros-consensus-diffusion

cardano-node/cardano-node.cabal

@@ -68,6 +68,7 @@ library
                         Cardano.Node.Configuration.TopologyP2P
                         Cardano.Node.Handlers.Shutdown
                         Cardano.Node.Handlers.TopLevel
+                        Cardano.Node.LedgerEvent
                         Cardano.Node.Orphans
                         Cardano.Node.Parsers
                         Cardano.Node.Pretty
@@ -145,6 +146,7 @@ library
                       , cardano-ledger-allegra
                       , cardano-ledger-api
                       , cardano-ledger-babbage
+                      , cardano-ledger-binary
                       , cardano-ledger-byron
                       , cardano-ledger-conway
                       , cardano-ledger-core
@@ -190,6 +192,7 @@ library
                       , safe-exceptions
                       , scientific
                       , si-timers
+                      , small-steps
                       , sop-core
                       , stm
                       , strict-sop-core
@@ -237,11 +240,14 @@ test-suite cardano-node-test
   build-depends:        base
                       , aeson
                       , bytestring
+                      , base16-bytestring
                       , cardano-crypto-class
                       , cardano-api
                       , cardano-ledger-core
                       , cardano-node
                       , cardano-slotting
+                      , cddl
+                      , containers
                       , directory
                       , filepath
                       , hedgehog
@@ -261,10 +267,13 @@ test-suite cardano-node-test
                       , vector
                       , yaml
 
+  extra-libraries:      cddl
+
   other-modules:        Test.Cardano.Config.Mainnet
                         Test.Cardano.Node.FilePermissions
                         Test.Cardano.Node.Gen
                         Test.Cardano.Node.Json
+                        Test.Cardano.Node.LedgerEvent
                         Test.Cardano.Node.POM
                         Test.Cardano.Tracing.NewTracing.Consistency
                         Test.Cardano.Tracing.OrphanInstances.HardFork

cardano-node/ledger_events.cddl

@@ -0,0 +1,214 @@
+; TODO '.cbor' control operator isn't supported by our validation lib at the moment.
+;
+; rule =
+;   [ version                    ; The codec version used to encode the following event.
+;   , bytes .cbor anchored-event ; An CBOR-encoded anchored ledger event.
+;   ]
+
+rule =
+  ledger-event
+
+anchored-event =
+  { 0: block-header-hash ; The block header hash from where this event was emitted.
+  , 1: slot              ; The slot number corresponding to the aforementioned header hash.
+  , 2: ledger-event      ; The actual ledger event.
+  }
+
+; ============= ;
+; Ledger events ;
+; ============= ;
+
+ledger-event =
+  [  0, ledger-event.epoch
+  // 1, ledger-event.reward-update
+  // 2, ledger-event.body
+  // 3, ledger-event.tick
+  ]
+
+ledger-event.epoch =
+  [  0, epoch.mir-distribution
+  // 1, epoch.stake-pool-reaping
+  // 2, epoch.stake-distribution
+  // 3, epoch.restrained-rewards
+  // 4, epoch.total-rewards
+  // 5, epoch.ada-pots
+  ]
+
+ledger-event.reward-update =
+  [  0, reward-update.incremental-rewards
+  ]
+
+ledger-event.body =
+  any
+
+ledger-event.tick =
+  any
+
+; -- Epoch / MIR distribution --------------------------------------------------
+;
+; Describes any tokens that are being added to reward accounts via MIR
+; certificates.
+;
+;                                  → This event only occurs on epoch boundaries.
+epoch.mir-distribution =
+  ( { * stake-credential => coin } ; Rewards paid from the Reserve into stake credentials
+  , { * stake-credential => coin } ; Rewards paid from the Treasury into stake credentials
+  , delta-coin                     ; Transfer from the Reserve into the Treasury
+  , delta-coin                     ; Transfer from the Treasury into the Reserve
+  )
+
+
+; -- Epoch / Stake pool reaping ------------------------------------------------
+;
+; Provides information about retired stake pools. In particular, it provides
+; all stake pool registration deposit amounts which are being returned.
+;
+; When a stake pool retires, a refund of the deposit is sent to the declared
+; reward account of the stake pool. Note that any given stake credential can be
+; registered to multiple stake pools as reward account. Which is why the
+; 'refund-distribution' goes from a stake credential (the reward account), to a
+; map of pool identifiers.
+;
+; The second 'refund-distribution' holds unclaimed deposits which corresponds
+; to ; deposits that ought to have been returned but for which the reward
+; account did no longer exist (because its owner had already de-registered it).
+; Those rewards end up being sent to the Treasury.
+;
+;                                  → This event only occurs on epoch boundaries.
+epoch.stake-pool-reaping =
+  ( epoch                                            ; Epoch in which the pool reaping occurs
+  , { * stake-credential => { 1* pool-id => coin } } ; Stake pools refunds after retirement
+  , { * stake-credential => { 1* pool-id => coin } } ; Unclaimed deposit after retirement
+  )
+
+
+; -- Epoch / Stake distribution ------------------------------------------------
+;
+; A new stake distribution snapshot is taken on every epoch boundary,
+; corresponding to the "mark" snapshot as described in the Shelley ledger formal
+; specification.
+;
+; This event provides the new snapshot which is a map from registered stake
+; credentials to the stake pool it is registered to and the amount of stake (in
+; lovelace) that it controls.
+;
+;                                  → This event only occurs on epoch boundaries.
+epoch.stake-distribution =
+  ( { * stake-credential => [ coin, pool-id ] }
+  )
+
+
+; -- Epoch / Restrained rewards ------------------------------------------------
+;
+; Describes rewards which are calculated by the ledger, but are not delivered to
+; a reward account. This happens, for example, when a reward account is
+; de-registered before the rewards are delivered to it.
+;
+; It also happened due to a bug during the Shelley era (Section 17.4). These two
+; cases are distinguished in the event.
+;
+;                                  → This event only occurs on epoch boundaries.
+epoch.restrained-rewards =
+  ( epoch
+  , { * stake-credential => [ 1* reward ] } ; Ignored rewards due to ledger bug in Shelley
+  , [ * stake-credential ]                  ; unregistered credentials which can no longer receive rewards
+  )
+
+
+; -- Epoch / Restrained rewards ------------------------------------------------
+;
+; Contains all the rewards which are delivered on the epoch boundary. In
+; particular, we have the following property:
+;
+;    Σincremental-rewards - restrained-rewards = total-rewards
+;
+;                                  → This event only occurs on epoch boundaries.
+epoch.total-rewards =
+  ( epoch                                   ; The epoch number of the new epoch
+  , { * stake-credential => [ 1* reward ] } ; Total rewards distributed at the epoch boundary
+  )
+
+
+; -- Epoch / Ada pots ----------------------------------------------------------
+;
+; The state of each pot of Ada/Lovelace in the ledger. The total sum of all pots
+; should always be equal to the network max supply (45B Ada on mainnet).
+;
+;                                  → This event only occurs on epoch boundaries.
+epoch.ada-pots =
+  ( coin ; Total amount in the Treasury
+  , coin ; Total amount in the Reserve
+  , coin ; Total amount held in reward accounts
+  , coin ; Total amount held in UTxO
+  , coin ; Total amount deposited for storing inline datums & scripts
+  , coin ; Total amount deposited for registering stake credentials
+  , coin ; Total amount deposited for registering stake pools
+  , coin ; Total amount collected asfees and collaterals
+  )
+
+
+; -- Rewards update / Incremental rewards  -------------------------------------
+;
+; This event is emitted on every reward calculation increment happening during the
+; course of an epoch. It maps stake credentials to a partial rewards amount
+; calculated so far.
+;
+; The epoch attached to this event refers to the epoch in which the rewards becomes
+; available; which is one epoch AFTER their calculation.
+;
+reward-update.incremental-rewards =
+  ( epoch                                  ; Epoch at which the rewards will become available
+  , { * stake-credential => [ * reward ] } ; Incremental rewards iteration
+  )
+
+
+; ============== ;
+; Common schemas ;
+; ============== ;
+
+coin =
+  uint
+
+block-header-hash =
+  $hash32
+
+delta-coin =
+  int
+
+epoch =
+  uint
+
+pool-id =
+  $hash28
+
+reward =
+  [ reward-type
+  , pool-id
+  , coin
+  ]
+
+reward-type =
+  ( 0 ; member rewards
+  / 1 ; leader rewards
+  )
+
+slot =
+  uint
+
+stake-credential =
+  [  0, $hash28   ; Key hash digest
+  // 1, $hash28   ; Script hash digest
+  ]
+
+version =
+  uint
+
+; ========================= ;
+; Parameterized  primitives ;
+; ========================= ;
+
+$hash28 =
+  bytes .size 28
+
+$hash32 =
+  bytes .size 32

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-}
 
@@ -39,7 +40,7 @@ import           System.FilePath (takeDirectory, (</>))
 
 import           Cardano.Crypto (RequiresNetworkMagic (..))
 import           Cardano.Logging.Types
-import           Cardano.Node.Configuration.NodeAddress (SocketPath)
+import           Cardano.Node.Configuration.NodeAddress (SocketPath, PortNumber)
 import           Cardano.Node.Configuration.Socket (SocketConfig (..))
 import           Cardano.Node.Handlers.Shutdown
 import           Cardano.Node.Protocol.Types (Protocol (..))
@@ -148,6 +149,9 @@ data NodeConfiguration
 
          -- Enable Peer Sharing
        , ncPeerSharing :: PeerSharing
+
+         -- Ledger Events
+       , ncLedgerEventHandlerPort :: !(Maybe PortNumber)
        } deriving (Eq, Show)
 
 
@@ -208,6 +212,9 @@ data PartialNodeConfiguration
 
          -- Peer Sharing
        , pncPeerSharing :: !(Last PeerSharing)
+
+         -- Ledger Events
+       , pncLedgerEventHandlerPort :: !(Last PortNumber)
        } deriving (Eq, Generic, Show)
 
 instance AdjustFilePaths PartialNodeConfiguration where
@@ -304,6 +311,8 @@ instance FromJSON PartialNodeConfiguration where
       -- DISABLED BY DEFAULT
       pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just NoPeerSharing
 
+      pncLedgerEventHandlerPort <- Last . fmap (fromIntegral @Int) <$> v .:? "LedgerEventHandler"
+
       pure PartialNodeConfiguration {
              pncProtocolConfig
            , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath
@@ -336,6 +345,7 @@ instance FromJSON PartialNodeConfiguration where
            , pncTargetNumberOfActiveBigLedgerPeers
            , pncEnableP2P
            , pncPeerSharing
+           , pncLedgerEventHandlerPort
            }
     where
       parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride
@@ -510,6 +520,7 @@ defaultPartialNodeConfiguration =
     , pncTargetNumberOfActiveBigLedgerPeers      = Last (Just 5)
     , pncEnableP2P                      = Last (Just DisabledP2PMode)
     , pncPeerSharing                    = Last (Just NoPeerSharing)
+    , pncLedgerEventHandlerPort         = Last Nothing
     }
 
 lastOption :: Parser a -> Parser (Last a)
@@ -614,6 +625,7 @@ makeNodeConfiguration pnc = do
                  EnabledP2PMode  -> SomeNetworkP2PMode Consensus.EnabledP2PMode
                  DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode
              , ncPeerSharing
+             , ncLedgerEventHandlerPort = getLast $ pncLedgerEventHandlerPort pnc
              }
 
 ncProtocol :: NodeConfiguration -> Protocol