KES Agent Connectivity

cabal.project

@@ -34,6 +34,10 @@ multi-repl: True
 
 import: ./asserts.cabal
 
+allow-newer: plutus-core:cardano-crypto-class
+           , bytestring
+           , serdoc-core:tasty-quickcheck
+
 package ouroboros-network
   -- Certain ThreadNet tests rely on transactions to be submitted promptly after
   -- a node (re)start. Therefore, we disable this flag (see
@@ -53,6 +57,14 @@ source-repository-package
   subdir:
       cardano-crypto-class
 
+source-repository-package
+  type: git
+  location: [email protected]:input-output-hk/kes-agent
+  tag: 660de3128d953fc81aec0c52f5677c0387e0ca4a
+  --sha256: sha256-N4XRVqC+UgWej+J16RPh3EO6MSIE3wmJvmP5/nRgIuw=
+  subdir:
+      kes-agent
+
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger

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

@@ -150,6 +150,7 @@ library
     crypton,
     deepseq,
     formatting >=6.3 && <7.3,
+    kes-agent,
     measures,
     microlens,
     mtl,
@@ -159,6 +160,7 @@ library
     ouroboros-network-api ^>=0.12,
     serialise ^>=0.2,
     small-steps,
+    serdoc-core,
     sop-core ^>=0.5,
     sop-extras ^>=0.2,
     strict-sop-core ^>=0.1,
@@ -311,6 +313,7 @@ library unstable-shelley-testlib
     cardano-strict-containers,
     containers,
     generic-random,
+    kes-agent,
     microlens,
     mtl,
     ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib},
@@ -319,6 +322,7 @@ library unstable-shelley-testlib
     ouroboros-consensus-protocol:{ouroboros-consensus-protocol, unstable-protocol-testlib},
     ouroboros-network-api,
     quiet ^>=0.2,
+    serdoc-core,
     small-steps,
 
 test-suite shelley-test
@@ -557,6 +561,7 @@ library unstable-cardano-tools
     ouroboros-network-framework ^>=0.16,
     ouroboros-network-protocols,
     resource-registry,
+    serdoc-core,
     serialise ^>=0.2,
     singletons,
     sop-core,

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

@@ -60,8 +60,7 @@ 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
@@ -75,7 +74,7 @@ import           Data.SOP.Index (Index (..))
 import           Data.SOP.OptNP (NonEmptyOptNP, OptNP (OptSkip))
 import qualified Data.SOP.OptNP as OptNP
 import           Data.SOP.Strict
-import           Data.Word (Word16, Word64)
+import           Data.Word (Word16)
 import           Lens.Micro ((^.))
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Byron.Ledger (ByronBlock)
@@ -97,6 +96,7 @@ import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.Protocol.Praos (Praos, PraosParams (..))
 import           Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (..), instantiatePraosCredentials)
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos, TPraosParams (..))
 import qualified Ouroboros.Consensus.Protocol.TPraos as Shelley
 import           Ouroboros.Consensus.Shelley.HFEras ()
@@ -105,15 +105,15 @@ import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
 import           Ouroboros.Consensus.Shelley.Ledger.Block (IsShelleyBlock,
                      ShelleyBlockLedgerEra)
 import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion
-import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
+import           Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey)
 import           Ouroboros.Consensus.Shelley.Node
 import           Ouroboros.Consensus.Shelley.Node.Common (ShelleyEraWithCrypto, shelleyBlockIssuerVKey)
 import qualified Ouroboros.Consensus.Shelley.Node.Praos as Praos
 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
 -------------------------------------------------------------------------------}
@@ -466,7 +466,10 @@ 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)]
@@ -556,7 +559,7 @@ protocolInfoCardano paramsCardano
           initialNonceShelley
           genesisShelley
 
-    TPraosParams { tpraosSlotsPerKESPeriod, tpraosMaxKESEvo } = tpraosParams
+    TPraosParams { tpraosSlotsPerKESPeriod } = tpraosParams
 
     praosParams :: PraosParams
     praosParams = PraosParams
@@ -573,7 +576,7 @@ protocolInfoCardano paramsCardano
             (SL.mkActiveSlotCoeff $ SL.sgActiveSlotsCoeff genesisShelley)
       }
 
-    PraosParams { praosSlotsPerKESPeriod, praosMaxKESEvo } = praosParams
+    PraosParams { praosSlotsPerKESPeriod } = praosParams
 
     blockConfigShelley :: BlockConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
     blockConfigShelley =
@@ -861,19 +864,13 @@ protocolInfoCardano paramsCardano
             slotToPeriod (SlotNo slot) = assert (tpraosSlotsPerKESPeriod == praosSlotsPerKESPeriod) $
               Absolute.KESPeriod $ fromIntegral $ slot `div` praosSlotsPerKESPeriod
 
-        (ocert, sk) <- instantiatePraosCredentials (praosCanBeLeaderCredentialsSource canBeLeader)
-
-        let startPeriod :: Absolute.KESPeriod
-            startPeriod = Absolute.ocertKESPeriod ocert
-
-        let maxKESEvo :: Word64
-            maxKESEvo = assert (tpraosMaxKESEvo == praosMaxKESEvo) praosMaxKESEvo
+        let maxKESEvo = assert (tpraosMaxKESEvo tpraosParams == praosMaxKESEvo praosParams) $
+                        tpraosMaxKESEvo tpraosParams
 
-        hotKey :: HotKey.HotKey c m <- HotKey.mkHotKey
-                    ocert
-                    sk
-                    startPeriod
+        hotKey :: HotKey c m <-
+                    instantiatePraosCredentials
                     maxKESEvo
+                    (praosCanBeLeaderCredentialsSource canBeLeader)
 
         let tpraos :: forall era.
                  ShelleyEraWithCrypto c       (TPraos c) era

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

@@ -33,16 +33,19 @@ module Ouroboros.Consensus.Shelley.Node.TPraos (
   ) where
 
 import qualified Cardano.Crypto.VRF as VRF
+import qualified Cardano.Crypto.KES as KES
 import qualified Cardano.Ledger.Api.Era as L
 import qualified Cardano.Ledger.Api.Transition as L
 import qualified Cardano.Ledger.Shelley.API as SL
+import           Cardano.Ledger.Crypto (KES)
 import qualified Cardano.Protocol.TPraos.API as SL
 import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..))
 import qualified Cardano.Protocol.TPraos.OCert as SL
 import           Cardano.Slotting.EpochInfo
 import           Cardano.Slotting.Time (mkSlotLength)
 import           Control.Monad.Except (Except)
 import           Data.Bifunctor (first)
+import qualified Data.SerDoc.Class as SerDoc
 import qualified Data.Text as T
 import qualified Data.Text as Text
 import           Lens.Micro ((^.))
@@ -55,10 +58,11 @@ import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.SupportsMempool (TxLimits)
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Protocol.Abstract
-import           Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey, mkHotKey)
+import           Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey)
 import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
 import           Ouroboros.Consensus.Protocol.Praos.Common
 import           Ouroboros.Consensus.Protocol.TPraos
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient
 import           Ouroboros.Consensus.Shelley.Eras
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.Inspect ()
@@ -71,6 +75,7 @@ import           Ouroboros.Consensus.Shelley.Node.Serialisation ()
 import           Ouroboros.Consensus.Shelley.Protocol.TPraos ()
 import           Ouroboros.Consensus.Util.Assert
 import           Ouroboros.Consensus.Util.IOLike
+import qualified Cardano.KESAgent.Serialization.DirectCodec as Agent
 
 {-------------------------------------------------------------------------------
   BlockForging
@@ -167,8 +172,12 @@ protocolInfoShelley ::
      forall m c.
       ( IOLike m
       , PraosCrypto c
+      , AgentCrypto c
       , ShelleyCompatible (TPraos c) (ShelleyEra c)
       , TxLimits (ShelleyBlock (TPraos c) (ShelleyEra c))
+      , MonadKESAgent m
+      , SerDoc.HasInfo (Agent.DirectCodec m) (KES.VerKeyKES (KES c))
+      , SerDoc.HasInfo (Agent.DirectCodec m) (KES.SignKeyKES (KES c))
       )
   => SL.ShelleyGenesis c
   -> ProtocolParamsShelleyBased c
@@ -186,11 +195,11 @@ protocolInfoShelley shelleyGenesis
 
 protocolInfoTPraosShelleyBased ::
      forall m era c.
-      ( IOLike m
-      , PraosCrypto c
+      ( PraosCrypto c
       , ShelleyCompatible (TPraos c) era
       , TxLimits (ShelleyBlock (TPraos c) era)
       , c ~ EraCrypto era
+      , KESAgentContext c m
       )
   => ProtocolParamsShelleyBased c
   -> L.TransitionConfig era
@@ -216,16 +225,11 @@ protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased {
     mkBlockForging :: ShelleyLeaderCredentials c -> m (BlockForging m (ShelleyBlock (TPraos c) era))
     mkBlockForging credentials = do
       let canBeLeader = shelleyLeaderCredentialsCanBeLeader credentials
-      (ocert, sk) <- instantiatePraosCredentials (praosCanBeLeaderCredentialsSource canBeLeader)
-
-      let startPeriod :: Absolute.KESPeriod
-          startPeriod = SL.ocertKESPeriod ocert
 
-      hotKey :: HotKey c m <- mkHotKey
-                  ocert
-                  sk
-                  startPeriod
-                  (tpraosMaxKESEvo tpraosParams)
+      hotKey :: HotKey c m <-
+                  instantiatePraosCredentials
+                    (tpraosMaxKESEvo tpraosParams)
+                    (praosCanBeLeaderCredentialsSource canBeLeader)
 
       return $ shelleyBlockForging tpraosParams hotKey credentials
 

ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/ProtocolInfo.hs

@@ -21,6 +21,7 @@ module Test.Consensus.Cardano.ProtocolInfo (
   , protocolVersionZero
   ) where
 
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient (KESAgentContext)
 import qualified Cardano.Chain.Genesis as CC.Genesis
 import qualified Cardano.Chain.Update as CC.Update
 import           Cardano.Ledger.Api.Era (StandardCrypto)
@@ -50,7 +51,6 @@ import           Ouroboros.Consensus.Protocol.PBFT (PBftParams,
 import           Ouroboros.Consensus.Shelley.Node
                      (ProtocolParamsShelleyBased (..), ShelleyGenesis,
                      ShelleyLeaderCredentials)
-import           Ouroboros.Consensus.Util.IOLike (IOLike)
 import qualified Test.Cardano.Ledger.Alonzo.Examples.Consensus as SL
 import qualified Test.Cardano.Ledger.Conway.Examples.Consensus as SL
 import qualified Test.ThreadNet.Infra.Byron as Byron
@@ -214,7 +214,10 @@ mkSimpleTestProtocolInfo
 --
 mkTestProtocolInfo ::
      forall m c
-   . (CardanoHardForkConstraints c, IOLike m, c ~ StandardCrypto)
+   . ( CardanoHardForkConstraints c
+     , KESAgentContext c m
+     , c ~ StandardCrypto
+     )
   => (CoreNodeId, Shelley.CoreNode c)
   -- ^ Id of the node for which the protocol info will be elaborated.
   -> ShelleyGenesis c

ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs

@@ -56,13 +56,14 @@ import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol)
 import           Ouroboros.Consensus.Node
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient (KESAgentContext)
 import           Ouroboros.Consensus.Protocol.TPraos
 import           Ouroboros.Consensus.Shelley.Eras
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Node
+import           Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
 import           Ouroboros.Consensus.TypeFamilyWrappers
 import           Ouroboros.Consensus.Util (eitherToMaybe)
-import           Ouroboros.Consensus.Util.IOLike (IOLike)
 import           Test.ThreadNet.TxGen
 import           Test.ThreadNet.TxGen.Shelley ()
 
@@ -265,7 +266,9 @@ instance ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
 
 protocolInfoShelleyBasedHardFork ::
      forall m proto1 era1 proto2 era2.
-     (IOLike m, ShelleyBasedHardForkConstraints proto1 era1 proto2 era2)
+     ( KESAgentContext (ProtoCrypto proto2) m
+     , ShelleyBasedHardForkConstraints proto1 era1 proto2 era2
+     )
   => ProtocolParamsShelleyBased (EraCrypto era1)
   -> SL.ProtVer
   -> SL.ProtVer

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/Protocol/Types.hs
 
@@ -30,13 +31,14 @@ import qualified Ouroboros.Consensus.Ledger.SupportsProtocol as Consensus
 import           Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo (..),
                      ProtocolInfo (..))
 import           Ouroboros.Consensus.Node.Run (RunNode)
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient
 import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
 import qualified Ouroboros.Consensus.Shelley.Eras as Consensus (ShelleyEra)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Consensus
                      (ShelleyBlock)
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
 import           Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC)
-import           Ouroboros.Consensus.Util.IOLike (IOLike)
+import           Ouroboros.Consensus.Util.IOLike
 
 
 class (RunNode blk, IOLike m) => Protocol m blk where
@@ -62,7 +64,11 @@ instance IOLike m => Protocol m ByronBlockHFC where
                                                 , pure . map inject $ blockForgingByron params
                                                 )
 
-instance (CardanoHardForkConstraints StandardCrypto, IOLike m) => Protocol m (CardanoBlock StandardCrypto) where
+instance ( CardanoHardForkConstraints StandardCrypto
+         , IOLike m
+         , MonadKESAgent m
+         )
+  => Protocol m (CardanoBlock StandardCrypto) where
   data ProtocolInfoArgs m (CardanoBlock StandardCrypto) =
          ProtocolInfoArgsCardano
           (CardanoProtocolParams StandardCrypto)
@@ -83,6 +89,7 @@ instance CardanoHardForkConstraints StandardCrypto => ProtocolClient (CardanoBlo
     protocolClientInfoCardano epochSlots
 
 instance ( IOLike m
+         , MonadKESAgent m
          , Consensus.LedgerSupportsProtocol
              (Consensus.ShelleyBlock
                 (Consensus.TPraos StandardCrypto) (ShelleyEra StandardCrypto))

ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/MockCrypto.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -27,12 +28,16 @@ import           Control.State.Transition.Extended (PredicateFailure)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol)
 import qualified Ouroboros.Consensus.Protocol.Praos as Praos
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient (AgentCrypto (..))
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import           Ouroboros.Consensus.Shelley.Eras (EraCrypto, ShelleyEra)
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                      ShelleyCompatible)
 import qualified Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes as SL (Mock)
 import           Test.QuickCheck (Arbitrary)
+import qualified Cardano.KESAgent.KES.Crypto as Agent
+import qualified Cardano.KESAgent.Protocols.VersionedProtocol as Agent
+import qualified Cardano.KESAgent.Processes.ServiceClient as Agent
 
 -- | A mock replacement for 'StandardCrypto'
 --
@@ -76,3 +81,16 @@ type CanMock proto era =
   , Arbitrary (StashedAVVMAddresses era)
   , Arbitrary (Core.GovState era)
   )
+
+instance Agent.NamedCrypto (MockCrypto h) where
+  cryptoName _ = Agent.CryptoName "Mock"
+
+instance Agent.ServiceClientDrivers (MockCrypto h) where
+  availableServiceClientDrivers = []
+
+instance Agent.Crypto (MockCrypto h) where
+  type KES (MockCrypto h) = MockKES 10
+  type DSIGN (MockCrypto h) = MockDSIGN
+
+instance HashAlgorithm h => AgentCrypto (MockCrypto h) where
+  type ACrypto (MockCrypto h) = MockCrypto h