KES agent integration

cabal.project

@@ -14,9 +14,9 @@ repository cardano-haskell-packages
 -- update either of these.
 index-state:
   -- Bump this if you need newer packages from Hackage
-  , hackage.haskell.org 2025-04-08T10:52:25Z
+  , hackage.haskell.org 2025-04-16T18:30:40Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2025-04-08T11:09:22Z
+  , cardano-haskell-packages 2025-04-29T14:14:35Z
 
 packages:
   ouroboros-consensus
@@ -34,6 +34,10 @@ multi-repl: True
 
 import: ./asserts.cabal
 
+allow-newer:
+    serdoc-core:tasty-quickcheck
+  , kes-agent:base
+
 package ouroboros-network
   -- Certain ThreadNet tests rely on transactions to be submitted promptly after
   -- a node (re)start. Therefore, we disable this flag (see
@@ -45,6 +49,10 @@ if(os(windows))
   constraints:
     bitvec -simd
 
+if impl (ghc < 9)
+  allow-older:
+    kes-agent:template-haskell
+
 if impl (ghc >= 9.12)
   allow-newer:
     -- https://github.com/phadej/vec/issues/118
@@ -57,3 +65,16 @@ if impl (ghc >= 9.12)
 
     -- https://github.com/kapralVV/Unique/issues/11
     , Unique:hashable
+
+    , serdoc-core:template-haskell
+    , serdoc-core:th-abstraction
+    , kes-agent:containers
+    , kes-agent:extra
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/kes-agent
+  tag: a212f98b9bc567ebf3c8472e62f28450990f7821
+  --sha256: sha256-b/6L3WqQ+fY1K6uBJVeoOTE4RAc3SUc72qZtXO0DAfE=
+  subdir:
+      kes-agent

ouroboros-consensus-cardano/changelog.d/20250130_093803_tdammers_mlocked_kes_rebase.md

@@ -0,0 +1,8 @@
+### Breaking
+
+- Use new mlocked KES API for all internal KES sign key handling.
+- Add finalizers to all block forgings (required by `ouroboros-consensus`).
+- Change `ShelleyLeaderCredentials` to not contain the KES sign key itself
+  anymore. Instead, the `CanBeLeader` data structure now contains a
+  `praosCanBeLeaderCredentialsSource` field, which specifies how to obtain the
+  actual credentials (OpCert and KES SignKey).

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -149,9 +149,11 @@ library
     cardano-strict-containers,
     cborg ^>=0.2.2,
     containers >=0.5 && <0.8,
+    contra-tracer,
     crypton,
     deepseq,
     formatting >=6.3 && <7.3,
+    kes-agent,
     measures,
     mempack,
     microlens,
@@ -160,6 +162,7 @@ library
     ouroboros-consensus ^>=0.26,
     ouroboros-consensus-protocol ^>=0.12,
     ouroboros-network-api ^>=0.13,
+    serdoc-core,
     serialise ^>=0.2,
     singletons ^>=3.0,
     small-steps,
@@ -323,7 +326,9 @@ library unstable-shelley-testlib
     cardano-slotting,
     cardano-strict-containers,
     containers,
+    contra-tracer,
     generic-random,
+    kes-agent,
     microlens,
     mtl,
     ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib},
@@ -364,6 +369,7 @@ test-suite shelley-test
     cborg,
     constraints,
     containers,
+    contra-tracer,
     filepath,
     measures,
     microlens,
@@ -415,6 +421,7 @@ library unstable-cardano-testlib
     cardano-strict-containers,
     cborg,
     containers,
+    contra-tracer,
     mempack,
     microlens,
     mtl,

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Node.hs

@@ -140,6 +140,7 @@ byronBlockForging creds = BlockForging {
                                slot
                                tickedPBftState
     , forgeBlock       = \cfg -> return ....: forgeByronBlock cfg
+    , finalize = pure ()
     }
   where
     canBeLeader = mkPBftCanBeLeader creds

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs

@@ -58,12 +58,12 @@ import qualified Cardano.Ledger.Api.Transition as L
 import qualified Cardano.Ledger.BaseTypes as SL
 import qualified Cardano.Ledger.Shelley.API as SL
 import           Cardano.Prelude (cborError)
-import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..),
-                     ocertKESPeriod)
+import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..))
 import qualified Codec.CBOR.Decoding as CBOR
 import           Codec.CBOR.Encoding (Encoding)
 import qualified Codec.CBOR.Encoding as CBOR
 import           Control.Exception (assert)
+import qualified Control.Tracer as Tracer
 import qualified Data.ByteString.Short as Short
 import           Data.Functor.These (These1 (..))
 import qualified Data.Map.Strict as Map
@@ -98,10 +98,10 @@ import           Ouroboros.Consensus.Ledger.Tables.Utils (forgetLedgerTables)
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Run
-import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
 import           Ouroboros.Consensus.Protocol.Praos (Praos, PraosParams (..))
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient
 import           Ouroboros.Consensus.Protocol.Praos.Common
-                     (praosCanBeLeaderOpCert)
+                     (PraosCanBeLeader (..), instantiatePraosCredentials)
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos, TPraosParams (..))
 import qualified Ouroboros.Consensus.Protocol.TPraos as Shelley
 import           Ouroboros.Consensus.Shelley.HFEras ()
@@ -118,7 +118,6 @@ import qualified Ouroboros.Consensus.Shelley.Node.TPraos as TPraos
 import           Ouroboros.Consensus.Storage.Serialisation
 import           Ouroboros.Consensus.TypeFamilyWrappers
 import           Ouroboros.Consensus.Util.Assert
-import           Ouroboros.Consensus.Util.IOLike
 
 {-------------------------------------------------------------------------------
   SerialiseHFC
@@ -488,10 +487,13 @@ data CardanoProtocolParams c = CardanoProtocolParams {
 -- PRECONDITION: only a single set of Shelley credentials is allowed when used
 -- for mainnet (check against @'SL.gNetworkId' == 'SL.Mainnet'@).
 protocolInfoCardano ::
-     forall c m. (IOLike m, CardanoHardForkConstraints c)
+     forall c m.
+     ( CardanoHardForkConstraints c
+     , KESAgentContext c m
+     )
   => CardanoProtocolParams c
   -> ( ProtocolInfo      (CardanoBlock c)
-     , m [BlockForging m (CardanoBlock c)]
+     , Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (CardanoBlock c)]
      )
 protocolInfoCardano paramsCardano
   | SL.Mainnet <- SL.sgNetworkId genesisShelley
@@ -503,7 +505,7 @@ protocolInfoCardano paramsCardano
         pInfoConfig       = cfg
       , pInfoInitLedger   = initExtLedgerStateCardano
       }
-    , blockForging
+    , mkBlockForgings
     )
   where
     CardanoProtocolParams {
@@ -854,9 +856,9 @@ protocolInfoCardano paramsCardano
     -- credentials. If there are multiple Shelley credentials, we merge the
     -- Byron credentials with the first Shelley one but still have separate
     -- threads for the remaining Shelley ones.
-    blockForging :: m [BlockForging m (CardanoBlock c)]
-    blockForging = do
-        shelleyBased <- traverse blockForgingShelleyBased credssShelleyBased
+    mkBlockForgings :: Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m (CardanoBlock c)]
+    mkBlockForgings tr = do
+        shelleyBased <- traverse (blockForgingShelleyBased tr) credssShelleyBased
         let blockForgings :: [NonEmptyOptNP (BlockForging m) (CardanoEras c)]
             blockForgings = case (mBlockForgingByron, shelleyBased) of
               (Nothing,    shelleys)         -> shelleys
@@ -878,27 +880,24 @@ protocolInfoCardano paramsCardano
         return $ byronBlockForging creds `OptNP.at` IZ
 
     blockForgingShelleyBased ::
-         ShelleyLeaderCredentials c
+         Tracer.Tracer m KESAgentClientTrace
+      -> ShelleyLeaderCredentials c
       -> m (NonEmptyOptNP (BlockForging m) (CardanoEras c))
-    blockForgingShelleyBased credentials = do
-        let ShelleyLeaderCredentials
-              { shelleyLeaderCredentialsInitSignKey = initSignKey
-              , shelleyLeaderCredentialsCanBeLeader = canBeLeader
-              } = credentials
-
-        hotKey <- do
-          let maxKESEvo :: Word64
-              maxKESEvo = assert (tpraosMaxKESEvo == praosMaxKESEvo) praosMaxKESEvo
-
-              startPeriod :: Absolute.KESPeriod
-              startPeriod = Absolute.ocertKESPeriod $ praosCanBeLeaderOpCert canBeLeader
-
-          HotKey.mkHotKey @m @c initSignKey startPeriod maxKESEvo
+    blockForgingShelleyBased tr credentials = do
+        let canBeLeader = shelleyLeaderCredentialsCanBeLeader credentials
 
         let slotToPeriod :: SlotNo -> Absolute.KESPeriod
             slotToPeriod (SlotNo slot) = assert (tpraosSlotsPerKESPeriod == praosSlotsPerKESPeriod) $
               Absolute.KESPeriod $ fromIntegral $ slot `div` praosSlotsPerKESPeriod
 
+            maxKESEvo :: Word64
+            maxKESEvo = assert (tpraosMaxKESEvo == praosMaxKESEvo) praosMaxKESEvo
+
+        hotKey <- instantiatePraosCredentials
+                    maxKESEvo
+                    tr
+                    (praosCanBeLeaderCredentialsSource canBeLeader)
+
         let tpraos :: forall era.
                  ShelleyEraWithCrypto c       (TPraos c) era
               => BlockForging m (ShelleyBlock (TPraos c) era)

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/HFEras.hs

@@ -18,9 +18,10 @@ module Ouroboros.Consensus.Shelley.HFEras (
   , StandardShelleyBlock
   ) where
 
+import           Cardano.Protocol.Crypto
 import           Ouroboros.Consensus.Protocol.Praos (Praos)
 import qualified Ouroboros.Consensus.Protocol.Praos as Praos
-import           Ouroboros.Consensus.Protocol.TPraos (StandardCrypto, TPraos)
+import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos
 import           Ouroboros.Consensus.Shelley.Eras (AllegraEra, AlonzoEra,
                      BabbageEra, ConwayEra, MaryEra, ShelleyEra)
@@ -75,7 +76,7 @@ instance
   ShelleyCompatible (TPraos c) BabbageEra
 
 instance
-  (Praos.PraosCrypto c) => ShelleyCompatible (Praos c) BabbageEra
+  Praos.PraosCrypto c => ShelleyCompatible (Praos c) BabbageEra
 
 -- This instance is required since the ledger view forecast function for
 -- Praos/Conway still goes through the forecast for TPraos. Once this is
@@ -85,4 +86,4 @@ instance
   ShelleyCompatible (TPraos c) ConwayEra
 
 instance
-  (Praos.PraosCrypto c) => ShelleyCompatible (Praos c) ConwayEra
+  Praos.PraosCrypto c => ShelleyCompatible (Praos c) ConwayEra

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Common.hs

@@ -20,12 +20,10 @@ module Ouroboros.Consensus.Shelley.Node.Common (
   , shelleyBlockIssuerVKey
   ) where
 
-import           Cardano.Crypto.KES (UnsoundPureSignKeyKES)
 import           Cardano.Ledger.BaseTypes (unNonZero)
 import qualified Cardano.Ledger.Keys as SL
 import qualified Cardano.Ledger.Shelley.API as SL
 import           Cardano.Ledger.Slot
-import           Cardano.Protocol.Crypto
 import           Data.Text (Text)
 import           Ouroboros.Consensus.Block (CannotForge, ForgeStateInfo,
                      ForgeStateUpdateError)
@@ -50,12 +48,7 @@ import           Ouroboros.Consensus.Storage.ImmutableDB
 -------------------------------------------------------------------------------}
 
 data ShelleyLeaderCredentials c = ShelleyLeaderCredentials
-  { -- | The unevolved signing KES key (at evolution 0).
-    --
-    -- Note that this is not inside 'ShelleyCanBeLeader' since it gets evolved
-    -- automatically, whereas 'ShelleyCanBeLeader' does not change.
-    shelleyLeaderCredentialsInitSignKey :: UnsoundPureSignKeyKES (KES c),
-    shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader c,
+  { shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader c,
     -- | Identifier for this set of credentials.
     --
     -- Useful when the node is running with multiple sets of credentials.

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs

@@ -27,8 +27,6 @@ import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Mempool
 import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
 import           Ouroboros.Consensus.Protocol.Praos (Praos, PraosParams (..),
                      praosCheckCanForge)
-import           Ouroboros.Consensus.Protocol.Praos.Common
-                     (PraosCanBeLeader (praosCanBeLeaderOpCert))
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                      ShelleyCompatible, forgeShelleyBlock)
 import           Ouroboros.Consensus.Shelley.Node.Common (ShelleyEraWithCrypto,
@@ -48,21 +46,13 @@ praosBlockForging ::
      , IOLike m
      )
   => PraosParams
+  -> HotKey.HotKey c m
   -> ShelleyLeaderCredentials c
-  -> m (BlockForging m (ShelleyBlock (Praos c) era))
-praosBlockForging praosParams credentials = do
-    hotKey <- HotKey.mkHotKey @m @c initSignKey startPeriod praosMaxKESEvo
-    pure $ praosSharedBlockForging hotKey slotToPeriod credentials
+  -> BlockForging m (ShelleyBlock (Praos c) era)
+praosBlockForging praosParams hotKey credentials =
+    praosSharedBlockForging hotKey slotToPeriod credentials
   where
-    PraosParams {praosMaxKESEvo, praosSlotsPerKESPeriod} = praosParams
-
-    ShelleyLeaderCredentials {
-        shelleyLeaderCredentialsInitSignKey = initSignKey
-      , shelleyLeaderCredentialsCanBeLeader = canBeLeader
-      } = credentials
-
-    startPeriod :: Absolute.KESPeriod
-    startPeriod = SL.ocertKESPeriod $ praosCanBeLeaderOpCert canBeLeader
+    PraosParams {praosSlotsPerKESPeriod} = praosParams
 
     slotToPeriod :: SlotNo -> Absolute.KESPeriod
     slotToPeriod (SlotNo slot) =
@@ -87,7 +77,7 @@ praosSharedBlockForging
   ShelleyLeaderCredentials {
       shelleyLeaderCredentialsCanBeLeader = canBeLeader
     , shelleyLeaderCredentialsLabel = label
-    } = do
+    } =
     BlockForging
       { forgeLabel = label <> "_" <> T.pack (L.eraName @era),
         canBeLeader = canBeLeader,
@@ -102,5 +92,6 @@ praosSharedBlockForging
           forgeShelleyBlock
             hotKey
             canBeLeader
-            cfg
+            cfg,
+        finalize = HotKey.finalize hotKey
       }