wip: cardano-api with kes-agent support

Author: fraser-iohk

cabal.project

@@ -65,9 +65,75 @@ if impl (ghc >= 9.12)
     -- https://github.com/kapralVV/Unique/issues/11
     , Unique:hashable
 
-    , network-mux:base 
-    , ouroboros-network:base 
-    , ouroboros-network-api:base 
-    , ouroboros-network-framework:base 
-    , ouroboros-network-protocols:base 
-
+    , network-mux:base
+    , ouroboros-network:base
+    , ouroboros-network-api:base
+    , ouroboros-network-framework:base
+    , ouroboros-network-protocols:base
+
+allow-newer:
+  cardano-ledger-core,
+  cardano-ledger-byron,
+  serdoc-core:tasty-quickcheck,
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/kes-agent
+  tag: 07437ed49022b13759c87c4e314f08fcff64b81a
+  --sha256: sha256-oTsxaFAs1c/H0oYLhiivO5mr48oHNsPi5k2XyXxwCJg=
+  subdir:
+      kes-agent
+
+source-repository-package
+   type: git
+   location: https://github.com/IntersectMBO/ouroboros-network
+   tag: 3e8d3b4b8c87ead794876c62d7fe25f32efb5142
+   --sha256: 08fpkx3iagj83nn413h9a865zjcj3lrf7017a756qd2wg2jg3amq
+   subdir:
+     ouroboros-network-api
+
+source-repository-package
+   type: git
+   location: https://github.com/IntersectMBO/cardano-ledger
+   tag: b44ce911475794a15f908ad27a6f497d6a27e8ba
+   --sha256: sha256-MXaVKKH9siUsmOnJmYyL6if48dx11zugux7AWGPABfA=
+   subdir:
+      eras/allegra/impl
+      eras/alonzo/impl
+      eras/alonzo/test-suite
+      eras/babbage/impl
+      eras/babbage/test-suite
+      eras/byron/chain/executable-spec
+      eras/byron/crypto
+      eras/byron/ledger/executable-spec
+      eras/byron/ledger/impl
+      eras/conway/impl
+      eras/conway/test-suite
+      eras/mary/impl
+      eras/shelley/impl
+      eras/shelley-ma/test-suite
+      eras/shelley/test-suite
+      libs/cardano-data
+      libs/cardano-ledger-api
+      libs/cardano-ledger-binary
+      libs/cardano-ledger-core
+      libs/cardano-ledger-test
+      libs/cardano-protocol-tpraos
+      libs/constrained-generators
+      libs/non-integral
+      libs/set-algebra
+      libs/small-steps
+      libs/vector-map
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 9fdeacc0ba74009bd3078f08cd6b443a3f296515
+  --sha256: sha256-oTsxaFAs1c/H0oYLhiivO5mr48oHNsPi5k2XyXxwCJg=
+  subdir:
+      ouroboros-consensus
+      ouroboros-consensus-cardano
+      ouroboros-consensus-diffusion
+      ouroboros-consensus-protocol
+      sop-extras
+      strict-sop-core

cardano-api/cardano-api.cabal

@@ -129,7 +129,7 @@ library
     cardano-ledger-binary >=1.6,
     cardano-ledger-byron >=1.1,
     cardano-ledger-conway >=1.19,
-    cardano-ledger-core:{cardano-ledger-core, testlib} >=1.17,
+    cardano-ledger-core:{cardano-ledger-core, testlib} >=1.17 && <1.19,
     cardano-ledger-mary >=1.8,
     cardano-ledger-shelley >=1.16,
     cardano-protocol-tpraos >=1.4,

cardano-api/src/Cardano/Api/Block.hs

@@ -72,7 +72,6 @@ import Ouroboros.Consensus.Byron.Ledger qualified as Consensus
 import Ouroboros.Consensus.Cardano.Block qualified as Consensus
 import Ouroboros.Consensus.HardFork.Combinator qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
-import Ouroboros.Consensus.Shelley.Protocol.Abstract qualified as Consensus
 import Ouroboros.Network.Block qualified as Consensus
 
 import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.=))
@@ -167,7 +166,6 @@ getShelleyBlockTxs
   :: forall era ledgerera blockheader
    . ShelleyLedgerEra era ~ ledgerera
   => Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera
-  => Consensus.ShelleyProtocolHeader (ConsensusProtocol era) ~ blockheader
   => ShelleyBasedEra era
   -> Ledger.Block blockheader ledgerera
   -> [Tx era]

cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs

@@ -22,6 +22,7 @@ where
 
 import Cardano.Api.Consensus.Internal.Mode
 
+import qualified Control.Tracer as Tracer
 import Ouroboros.Consensus.Block.Forging (BlockForging)
 import Ouroboros.Consensus.Byron.ByronHFC (ByronBlockHFC)
 import Ouroboros.Consensus.Cardano
@@ -31,6 +32,7 @@ import Ouroboros.Consensus.HardFork.Combinator.Embed.Unary
 import Ouroboros.Consensus.Ledger.SupportsProtocol qualified as Consensus (LedgerSupportsProtocol)
 import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo (..), ProtocolInfo (..))
 import Ouroboros.Consensus.Node.Run (RunNode)
+import Ouroboros.Consensus.Protocol.Praos.AgentClient
 import Ouroboros.Consensus.Protocol.TPraos qualified as Consensus
 import Ouroboros.Consensus.Shelley.Eras qualified as Consensus (ShelleyEra)
 import Ouroboros.Consensus.Shelley.Ledger.Block qualified as Consensus (ShelleyBlock)
@@ -44,7 +46,11 @@ import Type.Reflection ((:~:) (..))
 
 class (RunNode blk, IOLike m) => Protocol m blk where
   data ProtocolInfoArgs blk
-  protocolInfo :: ProtocolInfoArgs blk -> (ProtocolInfo blk, m [BlockForging m blk])
+  protocolInfo
+    :: ProtocolInfoArgs blk
+    -> ( ProtocolInfo blk
+       , Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m blk]
+       )
 
 -- | Node client support for each consensus protocol.
 --
@@ -59,10 +65,10 @@ instance IOLike m => Protocol m ByronBlockHFC where
   data ProtocolInfoArgs ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron
   protocolInfo (ProtocolInfoArgsByron params) =
     ( inject $ protocolInfoByron params
-    , pure . map inject $ blockForgingByron params
+    , \_ -> 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 (CardanoBlock StandardCrypto)
     = ProtocolInfoArgsCardano
         (CardanoProtocolParams StandardCrypto)
@@ -89,6 +95,7 @@ instance
           (Consensus.TPraos StandardCrypto)
           ShelleyEra
       )
+  , MonadKESAgent m
   )
   => Protocol m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra)
   where
@@ -98,7 +105,7 @@ instance
         (ProtocolParamsShelleyBased StandardCrypto)
         ProtVer
   protocolInfo (ProtocolInfoArgsShelley genesis paramsShelleyBased_ paramsShelley_) =
-    bimap inject (fmap $ map inject) $
+    bimap inject (fmap $ fmap $ map inject) $
       protocolInfoShelley genesis paramsShelleyBased_ paramsShelley_
 
 instance

cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs

@@ -112,7 +112,7 @@ module Cardano.Api.Ledger.Internal.Reexport
   , toPlainDecoder
   -- Shelley
   , secondsToNominalDiffTimeMicro
-  , AccountState (..)
+  , ChainAccountState (..)
   , NewEpochState (..)
   , ShelleyGenesisStaking (..)
   -- Babbage
@@ -266,7 +266,7 @@ import Cardano.Ledger.Binary
   , toPlainDecoder
   )
 import Cardano.Ledger.Binary.Plain (Decoder, serializeAsHexText)
-import Cardano.Ledger.CertState (DRepState (..), csCommitteeCredsL)
+import Cardano.Ledger.Conway.State (DRepState (..), csCommitteeCredsL)
 import Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin)
 import Cardano.Ledger.Conway.Core
   ( DRepVotingThresholds (..)
@@ -336,7 +336,7 @@ import Cardano.Ledger.Plutus.Data (Data (..), unData)
 import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary)
 import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (..), StakePoolRelay (..))
 import Cardano.Ledger.Shelley.API
-  ( AccountState (..)
+  ( ChainAccountState (..)
   , GenDelegPair (..)
   , NewEpochState (..)
   , StakeReference (..)

cardano-api/src/Cardano/Api/LedgerState.hs

@@ -193,6 +193,7 @@ import Ouroboros.Consensus.Ledger.Tables.Utils qualified as Ledger
 import Ouroboros.Consensus.Node.ProtocolInfo qualified as Consensus
 import Ouroboros.Consensus.Protocol.Abstract (ChainDepState, ConsensusProtocol (..))
 import Ouroboros.Consensus.Protocol.Praos qualified as Praos
+import Ouroboros.Consensus.Protocol.Praos.AgentClient
 import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
 import Ouroboros.Consensus.Protocol.Praos.VRF (mkInputVRF, vrfLeaderValue)
 import Ouroboros.Consensus.Protocol.TPraos qualified as TPraos
@@ -214,6 +215,7 @@ import Control.Error.Util (note)
 import Control.Exception.Safe
 import Control.Monad
 import Control.Monad.State.Strict
+import qualified Control.Tracer as Tracer
 import Data.Aeson as Aeson
   ( FromJSON (parseJSON)
   , Object
@@ -1434,7 +1436,7 @@ mkProtocolInfoCardano
   :: GenesisConfig
   -> ( Consensus.ProtocolInfo
          (Consensus.CardanoBlock Consensus.StandardCrypto)
-     , IO [BlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)]
+     , Tracer.Tracer IO KESAgentClientTrace -> IO [BlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)]
      )
 mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesisHash transCfg) =
   Consensus.protocolInfoCardano

cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs

@@ -35,11 +35,11 @@ import Cardano.Api.Query.Internal.Type.QueryInMode
 import Cardano.Api.Tx.Internal.Body
 import Cardano.Api.UTxO (UTxO (..))
 
-import Cardano.Ledger.CertState (DRepState (..))
+import Cardano.Ledger.State (DRepState (..))
 import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Credential qualified as L
 import Cardano.Ledger.Keys qualified as L
-import Cardano.Ledger.Shelley.LedgerState qualified as L
+import Cardano.Ledger.State (ChainAccountState(..))
 import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..))
 import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))
 
@@ -164,11 +164,11 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
     caseShelleyToBabbageOrConwayEraOnwards
       (const $ pure Nothing)
       ( \cOnwards -> do
-          L.AccountState{L.asTreasury} <-
+          ChainAccountState{casTreasury} <-
             lift (queryAccountState cOnwards)
               & onLeft (left . QceUnsupportedNtcVersion)
               & onLeft (left . QueryEraMismatch)
-          let txCurrentTreasuryValue = TxCurrentTreasuryValue asTreasury
+          let txCurrentTreasuryValue = TxCurrentTreasuryValue casTreasury
           return $ Just $ Featured cOnwards txCurrentTreasuryValue
       )
       sbe

cardano-api/src/Cardano/Api/Query/Internal/Expr.hs

@@ -59,12 +59,11 @@ import Cardano.Api.UTxO
 
 import Cardano.Ledger.Api qualified as L
 import Cardano.Ledger.Api.State.Query qualified as L
-import Cardano.Ledger.CertState qualified as L
+import Cardano.Ledger.State qualified as L
 import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Credential qualified as L
 import Cardano.Ledger.Hashes hiding (Hash)
 import Cardano.Ledger.Keys qualified as L
-import Cardano.Ledger.Shelley.LedgerState qualified as L
 import Cardano.Slotting.Slot
 import Ouroboros.Consensus.Cardano.Block qualified as Consensus
 import Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
@@ -484,7 +483,7 @@ queryAccountState
        QueryInMode
        r
        IO
-       (Either UnsupportedNtcVersionError (Either EraMismatch L.AccountState))
+       (Either UnsupportedNtcVersionError (Either EraMismatch L.ChainAccountState))
 queryAccountState eon = querySbe eon QueryAccountState
 
 queryProposals