Cover more of the ledger event with CDDL conformance tests.

cardano-node/ledger_events.cddl

@@ -1,50 +1,76 @@
+; 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 =
-  [ version                    ; The codec version used to encode the following event.
-  , bytes .cbor anchored-event ; An CBOR-encoded anchored ledger event.
-  ]
+  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.body
   // 2, ledger-event.tick
   ]
 
-; ============= ;
-; Ledger events ;
-; ============= ;
-
 ledger-event.epoch =
   [  0, epoch.mir-distribution
   // 1, epoch.stake-pool-reaping
   // 2, epoch.stake-distribution
   // 3, epoch.incremental-rewards
   // 4, epoch.delta-rewards
+  // 5, epoch.restrained-rewards
+  // 6, epoch.total-rewards
+  // 7, epoch.starts-at
   ]
 
 epoch.mir-distribution =
-  { 0: stake-distribution ; Rewards paid from the Reserve into stake credentials
-  , 1: stake-distribution ; Rewards paid from the Treasury into stake credentials
-  , 2: delta-coin         ; Transfer from the Reserve into the Treasury
-  , 3: delta-coin         ; Transfer from the Treasury into the Reserve
-  }
+  ( stake-distribution ; Rewards paid from the Reserve into stake credentials
+  , stake-distribution ; 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 =
+  ( epoch
+  , refund-distribution
+  , refund-distribution
+  )
 
-epoch.stake-pool-reaping = #
+epoch.stake-distribution =
+  any
 
-epoch.stake-distribution = #
+epoch.incremental-rewards =
+  any
 
-epoch.incremental-rewards = #
+epoch.delta-rewards =
+  any
 
-epoch.delta-rewards = #
+epoch.restrained-rewards =
+  any
 
-ledger-event.body = #
+epoch.total-rewards =
+  any
 
-ledger-event.tick = #
+epoch.starts-at =
+  epoch
+
+ledger-event.body =
+  any
+
+ledger-event.tick =
+  any
 
 ; ============== ;
 ; Common schemas ;
@@ -65,6 +91,9 @@ epoch =
 pool-id =
   $hash28
 
+refund-distribution =
+  { * stake-credential => { * $hash28 => coin } }
+
 reward =
   { 0: reward-type
   , 1: pool-id
@@ -80,8 +109,8 @@ slot =
   uint
 
 stake-credential =
-  [  0, $hash28
-  // 1, $hash28
+  [  0, $hash28   ; Key hash digest
+  // 1, $hash28   ; Script hash digest
   ]
 
 stake-distribution =
@@ -95,8 +124,8 @@ version =
 ; Parameterized  primitives ;
 ; ========================= ;
 
-$hash28 /=
+$hash28 =
   bytes .size 28
 
-$hash32 /=
+$hash32 =
   bytes .size 32

cardano-node/src/Cardano/Node/LedgerEvent.hs

@@ -16,23 +16,42 @@
 
 -- | Local representation for display purpose of cardano-ledger events.
 --
--- Shamelessly stolen from db-sync.
+-- Shamelessly stolen and adapted from db-sync.
 module Cardano.Node.LedgerEvent (
-    ConvertLedgerEvent (..)
-  , ShelleyEventsConstraints
-  , ConwayEventsConstraints
+    -- * Ledger Events
+    AnchoredEvent (..)
   , LedgerEvent (..)
   , LedgerNewEpochEvent (..)
-  , AnchoredEvent (..)
-  , fromAuxLedgerEvent
-  , ledgerEventName
-  , eventCodecVersion
-  , serializeAnchoredEvent
   , deserializeAnchoredEvent
+  , serializeAnchoredEvent
+  , ledgerEventName
+
+    -- ** Using Ledger events
+  , withLedgerEventsServerStream
   , foldEvent
+
+    -- ** Example
   , filterRewards
   , parseStakeCredential
-  , withLedgerEventsServerStream
+
+    -- * Type-level plumbing
+  , ConvertLedgerEvent (..)
+  , ConwayEventsConstraints
+  , ShelleyEventsConstraints
+  , eventCodecVersion
+
+    -- * Re-Exports
+  , Coin (..)
+  , Credential (..)
+  , DeltaCoin (..)
+  , EpochNo (..)
+  , KeyHash (..)
+  , KeyRole (..)
+  , Reward (..)
+  , ScriptHash (..)
+  , SlotNo (..)
+  , StandardCrypto
+  , serialize'
   ) where
 
 import           Cardano.Prelude hiding (All, Sum)
@@ -43,22 +62,22 @@ import           Cardano.Ledger.Binary (DecCBOR(..), EncCBOR(..), Version,
 import           Cardano.Ledger.Binary.Coders (Decode(..), Encode (..), encode, (!>),
                    (<!), decode)
 import           Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
-import           Cardano.Ledger.Credential(Credential, StakeCredential)
+import           Cardano.Ledger.Credential (Credential (..))
 import           Cardano.Ledger.Rewards (Reward(..))
 import qualified Cardano.Ledger.Shelley.Rules as Rules
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Address as Ledger
 import           Cardano.Ledger.Core (eraProtVerLow)
 import           Cardano.Ledger.Crypto (Crypto, StandardCrypto)
 import           Cardano.Ledger.Keys (KeyRole (..))
-import           Cardano.Ledger.Shelley.API (InstantaneousRewards (..), KeyHash)
+import           Cardano.Ledger.Shelley.API (InstantaneousRewards (..), KeyHash (..), ScriptHash (..))
 import           Cardano.Ledger.Shelley.Core (EraCrypto)
 import qualified Cardano.Ledger.Shelley.Rules as Shelley
 import           Cardano.Ledger.Shelley.Rules (RupdEvent (..),
                      ShelleyEpochEvent (..), ShelleyMirEvent (..),
                      ShelleyNewEpochEvent, ShelleyPoolreapEvent (..),
                      ShelleyTickEvent (..))
-import           Cardano.Slotting.Slot (SlotNo, EpochNo (..))
+import           Cardano.Slotting.Slot (SlotNo (..), EpochNo (..))
 import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR
 import qualified Codec.CBOR.Read as CBOR
@@ -73,7 +92,9 @@ import qualified Data.Map.Strict as Map
 import           Data.SOP.Strict (All, K (..), NS(..), hcmap, hcollapse)
 import qualified Data.Set as Set
 import           Data.String (String)
-import           Network.Socket(PortNumber, defaultProtocol, listen, accept, bind, close, socket, socketToHandle, withSocketsDo, SockAddr(..), SocketType(Stream), Family(AF_INET))
+import           Network.Socket(PortNumber, defaultProtocol, listen, accept,
+                  bind, close, socket, socketToHandle, withSocketsDo,
+                  SockAddr(..), SocketType(Stream), Family(AF_INET))
 import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
 import           Ouroboros.Consensus.Cardano.Block (AllegraEra, AlonzoEra,
                      BabbageEra, CardanoEras, ConwayEra, HardForkBlock,
@@ -111,9 +132,9 @@ data LedgerEvent crypto
 -- on us.
 data LedgerNewEpochEvent crypto
   = LedgerMirDist
-      !(Map (StakeCredential crypto) Coin)
+      !(Map (Credential 'Staking crypto) Coin)
         -- ^ Rewards paid from the __Reserve__ into stake credentials
-      !(Map (StakeCredential crypto) Coin)
+      !(Map (Credential 'Staking crypto) Coin)
         -- ^ Rewards paid from the __Treasury__ to stake credentials
       !DeltaCoin
         -- ^ Transfer from the __Reserve__ into the __Treasury__
@@ -130,17 +151,17 @@ data LedgerNewEpochEvent crypto
       !(Map (Credential 'Staking crypto) (Coin, KeyHash 'StakePool crypto))
   | LedgerIncrementalRewards
       !EpochNo
-      !(Map (StakeCredential crypto) (Set (Reward crypto)))
+      !(Map (Credential 'Staking crypto) (Set (Reward crypto)))
   | LedgerDeltaRewards
       !EpochNo
-      !(Map (StakeCredential crypto) (Set (Reward crypto)))
+      !(Map (Credential 'Staking crypto) (Set (Reward crypto)))
   | LedgerRestrainedRewards
       !EpochNo
-      !(Map (StakeCredential crypto) (Set (Reward crypto)))
-      !(Set (StakeCredential crypto))
+      !(Map (Credential 'Staking crypto) (Set (Reward crypto)))
+      !(Set (Credential 'Staking crypto))
   | LedgerTotalRewards
       !EpochNo
-      !(Map (StakeCredential crypto) (Set (Reward crypto)))
+      !(Map (Credential 'Staking crypto) (Set (Reward crypto)))
   | LedgerTotalAdaPots
       !Coin
       -- ^ Treasury Ada pot
@@ -263,8 +284,8 @@ instance Crypto crypto => DecCBOR (LedgerNewEpochEvent crypto) where
         <! From
       decRaw n = Invalid n
 
--- | Parse a 'StakeCredential' from a stake address in base16.
-parseStakeCredential :: String -> Maybe (StakeCredential StandardCrypto)
+-- | Parse a 'Credential 'Staking' from a stake address in base16.
+parseStakeCredential :: String -> Maybe (Credential 'Staking StandardCrypto)
 parseStakeCredential str =
    case Hex.decode (B8.pack str) of
      Right bytes -> Ledger.getRwdCred <$> Ledger.decodeRewardAcnt bytes
@@ -489,7 +510,7 @@ serializeAnchoredEvent version event =
     <>
     toCBOR version
     <>
-    CBOR.encodeBytes (serialize' version (encCBOR event))
+    CBOR.encodeBytes (serialize' version event)
 
 deserializeAnchoredEvent
   :: LBS.ByteString
@@ -523,7 +544,7 @@ foldEvent h st0 fn =
         go st' events
 
 filterRewards
-  :: StakeCredential StandardCrypto
+  :: Credential 'Staking StandardCrypto
   -> Map EpochNo Coin
   -> AnchoredEvent
   -> Map EpochNo Coin

cddl/cddl.cabal

@@ -49,14 +49,16 @@ test-suite unit
   hs-source-dirs:       test
   main-is:              Spec.hs
   other-modules:        Codec.CBOR.SchemaSpec
+                        Cardano.Node.LedgerEventSpec
                         Paths_cddl
   build-depends:        , base
                         , base16-bytestring
                         , bytestring
+                        , cardano-crypto-class
                         , cddl
+                        , containers
                         , hedgehog
                         , hspec
-                        , hspec-hedgehog
                         , text
                         , cardano-node
   build-tool-depends:   hspec-discover:hspec-discover