Merge pull request #6 from input-output-hk/kderme/stable-parameter

Introduce stable parameter

Author: Ninjatrappeur

morpho-checkpoint-node/src/Morpho/Config/Types.hs

@@ -50,6 +50,7 @@ data NodeConfiguration
         ncNetworkMagic :: Word32,
         ncSystemStart :: Maybe SystemStart,
         ncSecurityParameter :: Word64,
+        ncStableLedgerDepth :: Int,
         ncLoggingSwitch :: Bool,
         ncTraceOpts :: !TraceOptions,
         ncLogMetrics :: Bool,
@@ -78,6 +79,7 @@ instance FromJSON NodeConfiguration where
     networkMagic <- v .: "NetworkMagic"
     systemStart <- v .:? "SystemStart"
     securityParam <- v .: "SecurityParam"
+    stableLedgerDepth <- v .: "StableLedgerDepth"
     loggingSwitch <- v .: "TurnOnLogging"
     traceOptions <- traceConfigParser v
     vMode <- v .: "ViewMode"
@@ -106,6 +108,7 @@ instance FromJSON NodeConfiguration where
         networkMagic
         systemStart
         securityParam
+        stableLedgerDepth
         loggingSwitch
         traceOptions
         logMetrics

morpho-checkpoint-node/src/Morpho/Ledger/SnapshotTimeTravel.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -9,32 +10,40 @@ module Morpho.Ledger.SnapshotTimeTravel
 where
 
 import Cardano.Prelude hiding (Handle, ReadMode, atomically, to, withFile)
+import qualified Data.FingerTree.Strict as FT
+import Morpho.Ledger.Block
 import Ouroboros.Consensus.Ledger.Basics
 import Ouroboros.Consensus.Ledger.Extended
 import Ouroboros.Consensus.Storage.ChainDB.API
 import Ouroboros.Consensus.Util.IOLike
-import Ouroboros.Network.AnchoredFragment (anchorPoint)
+import Ouroboros.Network.AnchoredFragment (unanchorFragment)
 import Ouroboros.Network.Block hiding (Tip)
+import qualified Ouroboros.Network.ChainFragment as CF
 
-newtype TimeTravelError blk = LedgerStateNotFoundAt (Point blk)
+data TimeTravelError blk
+  = LedgerStateNotFoundAt (Point blk)
+  | ChainNotLongEnough Int Int
   deriving (Show)
 
 getLatestStableLedgerState ::
-  (MonadIO m, MonadSTM m) =>
+  (MonadIO m, MonadSTM m, HasHeader (Header blk)) =>
   ChainDB m blk ->
+  Int ->
   m (Either (TimeTravelError blk) (LedgerState blk))
-getLatestStableLedgerState chainDB = go (5 :: Int)
+getLatestStableLedgerState chainDB offset = do
+  chainFragment <- unanchorFragment <$> atomically (getCurrentChain chainDB)
+  let result = CF.lookupByIndexFromEnd chainFragment offset
+  case result of
+    FT.Position _ h _ -> getLedger h
+    _ -> return $ Left $ ChainNotLongEnough offset (CF.length chainFragment)
   where
-    go n = do
-      immDbTip <- atomically $ castPoint . anchorPoint <$> getCurrentChain chainDB
-      -- There is a race condition here. If the ledger db advances between the two
-      -- calls, the ledger state will not be found and 'Nothing' will return.
-      -- In this case we try again to get a stable ledger state and
-      -- hopefully succeed this time.
-      -- Newer ouroboros-consensus make past ledgerState available in STM
-      -- transactions and can eliminate this race condition.
-      mstate <- getPastLedger chainDB immDbTip
-      case (ledgerState <$> mstate, n) of
-        (Nothing, 0) -> return $ Left $ LedgerStateNotFoundAt immDbTip
-        (Nothing, _) -> go $ n - 1
-        (Just st, _) -> return $ Right st
+    getLedger hdr = do
+      let pnt = blockPoint hdr
+      -- There is a race condition here. If the ledger db advances a lot between
+      -- the two chainDB api calls, the ledger state will not be found and 'Nothing'
+      -- will return. Newer ouroboros-consensus make past ledgerState available
+      -- in STM transactions and can eliminate this race condition.
+      mstate <- getPastLedger chainDB (castPoint pnt)
+      case ledgerState <$> mstate of
+        Nothing -> return $ Left $ LedgerStateNotFoundAt (castPoint pnt)
+        Just st -> return $ Right st

morpho-checkpoint-node/src/Morpho/Node/Run.hs

@@ -292,7 +292,7 @@ publishStableCheckpoint ::
 publishStableCheckpoint nc nodeTracers metrics chainDB ledgerState = do
   traceWith (extractStateTracer nodeTracers) (MorphoStateTrace $ morphoLedgerState ledgerState)
   set (ledgerStateToBlockNum ledgerState) $ mMorphoStateUnstableCheckpoint metrics
-  mst <- getLatestStableLedgerState chainDB
+  mst <- getLatestStableLedgerState chainDB (ncStableLedgerDepth nc)
   case mst of
     Left err -> traceWith (timeTravelErrorTracer nodeTracers) err
     Right stableLedgerState -> do

morpho-checkpoint-node/src/Morpho/Tracing/TracingOrphanInstances.hs

@@ -249,6 +249,13 @@ instance (HashAlgorithm h, BftCrypto c) => ToObject (TimeTravelError (MorphoBloc
         "error" .= String "LedgerStateNotFoundAt",
         "point" .= showPoint verb point
       ]
+  toObject _verb (ChainNotLongEnough offset len) =
+    mkObject
+      [ "kind" .= String "TimeTravelError",
+        "error" .= String "ChainNotLongEnough",
+        "offset" .= show offset,
+        "length" .= show len
+      ]
 
 instance (BftCrypto c, HashAlgorithm h) => ToObject (GenTx (MorphoBlock h c)) where
   toObject _verb (MorphoGenTx tx txid) =

morpho-checkpoint-node/tests/Test/Morpho/Examples.hs

@@ -181,6 +181,7 @@ exampleNodeConfig =
       ncNetworkMagic = 12345,
       ncSystemStart = Just $ SystemStart $ posixSecondsToUTCTime $ realToFrac (1234566789 :: Integer),
       ncSecurityParameter = 3,
+      ncStableLedgerDepth = 2,
       ncLoggingSwitch = True,
       ncTraceOpts = exampleTraceOptions,
       ncLogMetrics = True,

morpho-checkpoint-node/tests/configuration/Golden/Config.yaml

@@ -10,6 +10,7 @@ RequiresNetworkMagic: RequiresMagic
 NetworkMagic : 12345
 SystemStart: "2009-02-13T23:13:09Z"
 SecurityParam : 3
+StableLedgerDepth : 2
 TurnOnLogging: True
 ViewMode: SimpleView
 TurnOnLogMetrics: True

morpho-checkpoint-node/tests/configuration/QSM/prop_1/config-0.yaml

@@ -8,7 +8,8 @@ Protocol: MockedBFT
 NumCoreNodes: 1
 RequiresNetworkMagic: RequiresMagic
 NetworkMagic : 12345
-SecurityParam : 3
+SecurityParam : 5
+StableLedgerDepth : 3
 TurnOnLogging: True
 ViewMode: SimpleView
 TurnOnLogMetrics: False

morpho-checkpoint-node/tests/configuration/QSM/prop_2/config-0.yaml

@@ -9,7 +9,8 @@ NumCoreNodes: 2
 RequiresNetworkMagic: RequiresMagic
 NetworkMagic : 12345
 SystemStart: "2020-11-12T04:07:09Z"
-SecurityParam : 3
+SecurityParam : 5
+StableLedgerDepth : 3
 TurnOnLogging: True
 ViewMode: SimpleView
 TurnOnLogMetrics: False

morpho-checkpoint-node/tests/configuration/QSM/prop_2/config-1.yaml

@@ -9,7 +9,8 @@ NumCoreNodes: 2
 RequiresNetworkMagic: RequiresMagic
 NetworkMagic : 12345
 SystemStart: "2020-11-12T04:07:09Z"
-SecurityParam : 3
+SecurityParam : 5
+StableLedgerDepth : 3
 TurnOnLogging: True
 ViewMode: SimpleView
 TurnOnLogMetrics: False

morpho-checkpoint-node/tests/configuration/QSM/prop_3/config-0.yaml

@@ -9,7 +9,8 @@ NumCoreNodes: 2
 RequiresNetworkMagic: RequiresMagic
 NetworkMagic : 12345
 SystemStart: "2020-11-22T04:45:09Z"
-SecurityParam : 3
+SecurityParam : 5
+StableLedgerDepth : 3
 TurnOnLogging: True
 ViewMode: SimpleView
 TurnOnLogMetrics: False