WIP

IntersectMBO · May 9, 2024 · 510fadd · 510fadd
1 parent b28359f
commit 510fadd
Show file tree

Hide file tree

Showing 5 changed files with 52 additions and 68 deletions.
diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs
@@ -16,6 +16,7 @@ module Cardano.TxGenerator.Setup.Plutus
 
 import           Data.Bifunctor
 import           Data.ByteString.Short (ShortByteString)
+import           Data.Int (Int64)
 import           Data.Map.Strict as Map (lookup)
 
 import           Control.Monad.Trans.Except
@@ -268,5 +269,5 @@ preExecutePlutusV3 (major, _minor) (PlutusScript _ (PlutusScriptSerialised (scri
       , PlutusV3.txInfoTreasuryDonation = Nothing
       }
 
-flattenCostModel :: CostModel -> [Integer]
+flattenCostModel :: CostModel -> [Int64]
 flattenCostModel (CostModel cm) = cm
diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
@@ -90,12 +90,13 @@ import           Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
 import qualified Ouroboros.Consensus.Config as Consensus
 import           Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
 import           Ouroboros.Consensus.Node (DiskPolicyArgs (..), NetworkP2PMode (..),
-                   RunNodeArgs (..), StdRunNodeArgs (..), stdChainSyncTimeout)
+                   RunNodeArgs (..), StdRunNodeArgs (..))
 import qualified Ouroboros.Consensus.Node as Node (getChainDB, run)
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Util.Orphans ()
 import qualified Ouroboros.Network.Diffusion as Diffusion
+import qualified Ouroboros.Network.Diffusion.Configuration as Configuration
 import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P
 import qualified Ouroboros.Network.Diffusion.P2P as P2P
 import           Ouroboros.Network.NodeToClient (LocalAddress (..), LocalSocket (..))
@@ -592,7 +593,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
   customizeChainSyncTimeout = case ncChainSyncIdleTimeout nc of
     NoTimeoutOverride -> Nothing
     TimeoutOverride t -> Just $ do
-      cst <- stdChainSyncTimeout
+      cst <- Configuration.defaultChainSyncTimeout
       pure $ case t of
         0 ->
           cst { idleTimeout = Nothing }

diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs
@@ -225,36 +225,37 @@ instance
   ( Consensus.ShelleyBasedEra era
   , ToJSON (Ledger.PParamsUpdate era)
   ) => LogFormatting (ShelleyLedgerUpdate era) where
-  forMachine dtal (ShelleyUpdatedProtocolUpdates updates) =
+  forMachine _dtal (ShelleyUpdatedPParams updates epochNo) =
     mconcat [ "kind" .= String "ShelleyUpdatedProtocolUpdates"
-             , "updates" .= map (forMachine dtal) updates
-             ]
-
-instance
-  ( Ledger.Era era
-  , ToJSON (Ledger.PParamsUpdate era)
-  ) => LogFormatting (ProtocolUpdate era) where
-  forMachine dtal ProtocolUpdate{protocolUpdateProposal, protocolUpdateState} =
-    mconcat [ "proposal" .= forMachine dtal protocolUpdateProposal
-             , "state"    .= forMachine dtal protocolUpdateState
-             ]
-
-instance
-  ( ToJSON (Ledger.PParamsUpdate era)
-  ) => LogFormatting (UpdateProposal era) where
-  forMachine _dtal UpdateProposal{proposalParams, proposalVersion, proposalEpoch} =
-    mconcat [ "params"  .= proposalParams
-             , "version" .= proposalVersion
-             , "epoch"   .= proposalEpoch
-             ]
-
-instance
-  ( Ledger.Crypto crypto
-  ) => LogFormatting (UpdateState crypto) where
-  forMachine _dtal UpdateState{proposalVotes, proposalReachedQuorum} =
-    mconcat [ "proposal"      .= proposalVotes
-             , "reachedQuorum" .= proposalReachedQuorum
-             ]
+             , "updates" .= show updates -- map (forMachine dtal) updates
+             , "epochNo" .= show epochNo
+             ]
+
+-- instance
+--   ( Ledger.Era era
+--   , ToJSON (Ledger.PParamsUpdate era)
+--   ) => LogFormatting (ProtocolUpdate era) where
+--   forMachine dtal ProtocolUpdate{protocolUpdateProposal, protocolUpdateState} =
+--     mconcat [ "proposal" .= forMachine dtal protocolUpdateProposal
+--              , "state"    .= forMachine dtal protocolUpdateState
+--              ]
+
+-- instance
+--   ( ToJSON (Ledger.PParamsUpdate era)
+--   ) => LogFormatting (UpdateProposal era) where
+--   forMachine _dtal UpdateProposal{proposalParams, proposalVersion, proposalEpoch} =
+--     mconcat [ "params"  .= proposalParams
+--              , "version" .= proposalVersion
+--              , "epoch"   .= proposalEpoch
+--              ]
+
+-- instance
+--   ( Ledger.Crypto crypto
+--   ) => LogFormatting (UpdateState crypto) where
+--   forMachine _dtal UpdateState{proposalVotes, proposalReachedQuorum} =
+--     mconcat [ "proposal"      .= proposalVotes
+--              , "reachedQuorum" .= proposalReachedQuorum
+--              ]
 
 instance
   ( Ledger.Crypto crypto

diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs
@@ -138,11 +138,12 @@ instance
 
 instance
   ( Ledger.Era ledgerera
-  , ToJSON (Ledger.PParamsUpdate ledgerera)
+  , Show (Ledger.PParamsHKD Identity ledgerera)
   ) => ToObject (ShelleyLedgerUpdate ledgerera) where
-  toObject verb (ShelleyUpdatedProtocolUpdates updates) =
-    mconcat [ "kind" .= String "ShelleyUpdatedProtocolUpdates"
-             , "updates" .= map (toObject verb) updates
+  toObject _verb (ShelleyUpdatedPParams updates epochNo) =
+    mconcat [ "kind" .= String "ShelleyUpdatedPParams"
+             , "updates" .= show updates -- map (toObject verb) updates
+             , "epochNo" .= show epochNo
              ]
 instance
   ( ToObject (PredicateFailure (Ledger.EraRule "DELEG" era))
@@ -222,28 +223,19 @@ instance ToObject (Set (Credential 'Staking StandardCrypto)) where
              , "stakeCreds" .= map toJSON (Set.toList creds)
              ]
 
-instance
-  ( Ledger.Era ledgerera
-  , ToJSON (Ledger.PParamsUpdate ledgerera)
-  ) => ToObject (ProtocolUpdate ledgerera) where
-  toObject verb ProtocolUpdate{protocolUpdateProposal, protocolUpdateState} =
-    mconcat [ "proposal" .= toObject verb protocolUpdateProposal
-             , "state"    .= toObject verb protocolUpdateState
-             ]
+-- instance ToJSON (Ledger.PParamsUpdate era)
+--          => ToObject (UpdateProposal era) where
+--   toObject _verb UpdateProposal{proposalParams, proposalVersion, proposalEpoch} =
+--     mconcat [ "params"  .= proposalParams
+--              , "version" .= proposalVersion
+--              , "epoch"   .= proposalEpoch
+--              ]
 
-instance ToJSON (Ledger.PParamsUpdate era)
-         => ToObject (UpdateProposal era) where
-  toObject _verb UpdateProposal{proposalParams, proposalVersion, proposalEpoch} =
-    mconcat [ "params"  .= proposalParams
-             , "version" .= proposalVersion
-             , "epoch"   .= proposalEpoch
-             ]
-
-instance Core.Crypto crypto => ToObject (UpdateState crypto) where
-  toObject _verb UpdateState{proposalVotes, proposalReachedQuorum} =
-    mconcat [ "proposal"      .= proposalVotes
-             , "reachedQuorum" .= proposalReachedQuorum
-             ]
+-- instance Core.Crypto crypto => ToObject (UpdateState crypto) where
+--   toObject _verb UpdateState{proposalVotes, proposalReachedQuorum} =
+--     mconcat [ "proposal"      .= proposalVotes
+--              , "reachedQuorum" .= proposalReachedQuorum
+--              ]
 
 instance Core.Crypto crypto => ToObject (ChainTransitionError crypto) where
   toObject verb (ChainTransitionError fs) =

diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs
@@ -52,15 +52,12 @@ import           Cardano.Tracing.Config
 
 import           Prelude
 
-import           Control.Monad
 import           Control.Monad.Identity (Identity)
 import           Data.Aeson (ToJSON (..), Value, (.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KeyMapAeson
 import qualified Data.Default.Class as DefaultClass
-import           Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
 import           Data.Maybe
 import           Data.Proxy
 import           Data.Ratio
@@ -84,26 +81,18 @@ import           Testnet.Start.Types
 {- HLINT ignore "Use underscore" -}
 
 instance Api.Error AlonzoGenesisError where
-  prettyError (AlonzoGenErrCostModels e) =
-    "Error in Alonzo genesis cost models: " <> pshow e
   prettyError (AlonzoGenErrTooMuchPrecision r) =
     "Too much precision for bounded rational in Alonzo genesis: " <> pshow r
 
 data AlonzoGenesisError
   = AlonzoGenErrTooMuchPrecision Rational
-  | AlonzoGenErrCostModels (Map Ledger.Language Ledger.CostModelError)
   deriving Show
 
 defaultAlonzoGenesis :: Either AlonzoGenesisError AlonzoGenesis
 defaultAlonzoGenesis = do
   let genesis = Api.alonzoGenesisDefaults
-      costModelsErrors = Ledger.costModelsErrors $ Ledger.agCostModels genesis
       prices = Ledger.agPrices genesis
 
-  -- fail on cost models errors
-  unless (Map.null costModelsErrors)
-    . Left $ AlonzoGenErrCostModels costModelsErrors
-
   -- double check that prices have correct values - they're set using unsafeBoundedRational in cardano-api
   _priceExecSteps <- checkBoundedRational $ Ledger.prSteps prices
   _priceMemSteps <- checkBoundedRational $ Ledger.prMem prices