Disable ledger state option

cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs

@@ -213,6 +213,7 @@ mkSyncNodeParams staticDir mutableDir = do
     , enpPGPassSource = Db.PGPassCached pgconfig
     , enpExtended = True
     , enpHasCache = True
+    , enpHasLedger = True
     , enpMaybeRollback = Nothing
     }
 

cardano-db-sync/app/cardano-db-sync.hs

@@ -65,6 +65,7 @@ pRunDbSyncNode =
     <*> pPGPassSource
     <*> pExtended
     <*> pHasCache
+    <*> pHasLedger
     <*> optional pSlotNo
 
 pConfigFile :: Parser ConfigFile
@@ -113,6 +114,13 @@ pHasCache =
     <> Opt.help "Disables the db-sync caches. Reduces memory usage but it takes longer to sync."
     )
 
+pHasLedger ::  Parser Bool
+pHasLedger =
+  Opt.flag True False
+    ( Opt.long "disable-ledger"
+    <> Opt.help "Disables the leger state. Drastically reduces memory usage and it syncs faster, but some data are missing."
+    )
+
 pSocketPath :: Parser SocketPath
 pSocketPath =
   SocketPath <$> Opt.strOption

cardano-db-sync/cardano-db-sync.cabal

@@ -109,6 +109,7 @@ library
 
                         Cardano.DbSync.Rollback
 
+                        Cardano.DbSync.LocalStateQuery
                         Cardano.DbSync.StateQuery
                         Cardano.DbSync.Sync
                         Cardano.DbSync.Tracing.ToObjectOrphans

cardano-db-sync/src/Cardano/DbSync/Api.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Cardano.DbSync.Api
@@ -9,6 +10,7 @@ module Cardano.DbSync.Api
   , mkSyncEnvFromConfig
   , verifyFilePoints
   , getTrace
+  , hasLedgerState
   , getLatestPoints
   , getSlotHash
   , getDbLatestBlockInfo
@@ -37,9 +39,12 @@ import           Cardano.DbSync.Config.Shelley
 import           Cardano.DbSync.Config.Types
 import           Cardano.DbSync.Error
 import           Cardano.DbSync.LedgerState
+import           Cardano.DbSync.LocalStateQuery
 import           Cardano.DbSync.Types
 
+import           Control.Monad.Class.MonadSTM.Strict (StrictTVar, TBQueue, newTBQueueIO, newTVarIO)
 import           Control.Monad.Trans.Maybe (MaybeT (..))
+import           Data.Time.Clock (UTCTime, getCurrentTime)
 
 import           Database.Persist.Sql (SqlBackend)
 
@@ -58,13 +63,18 @@ data SyncEnv = SyncEnv
   , envBackend :: !SqlBackend
   , envOptions :: !SyncOptions
   , envCache :: !Cache
+  , envOfflineWorkQueue :: !(TBQueue IO PoolFetchRetry)
+  , envOfflineResultQueue :: !(TBQueue IO FetchResult)
+  , envEpochSyncTime :: !(StrictTVar IO UTCTime)
+  , envNoLedgerEnv :: !NoLedgerStateEnv -- only used when configured without ledger state.
   , envLedger :: !LedgerEnv
   }
 
 data SyncOptions = SyncOptions
   { soptExtended :: !Bool
   , soptAbortOnInvalid :: !Bool
   , soptCache :: !Bool
+  , soptLedger :: !Bool
   , snapshotEveryFollowing :: !Word64
   , snapshotEveryLagging :: !Word64
   }
@@ -75,6 +85,9 @@ getTrace = leTrace . envLedger
 getSlotHash :: SqlBackend -> SlotNo -> IO [(SlotNo, ByteString)]
 getSlotHash backend = DB.runDbIohkNoLogging backend . DB.querySlotHash
 
+hasLedgerState :: SyncEnv -> Bool
+hasLedgerState = soptLedger . envOptions
+
 getDbLatestBlockInfo :: SqlBackend -> IO (Maybe TipInfo)
 getDbLatestBlockInfo backend = do
   runMaybeT $ do
@@ -118,19 +131,27 @@ getCurrentTipBlockNo env = do
 
 mkSyncEnv
     :: Trace IO Text -> SqlBackend -> SyncOptions -> ProtocolInfo IO CardanoBlock -> Ledger.Network
-    -> NetworkMagic -> SystemStart -> LedgerStateDir -> EpochSlot
+    -> NetworkMagic -> SystemStart -> LedgerStateDir
     -> IO SyncEnv
-mkSyncEnv trce backend syncOptions protoInfo nw nwMagic systemStart dir stableEpochSlot = do
-  ledgerEnv <- mkLedgerEnv trce protoInfo dir nw stableEpochSlot systemStart (soptAbortOnInvalid syncOptions)
+mkSyncEnv trce backend syncOptions protoInfo nw nwMagic systemStart dir = do
+  ledgerEnv <- mkLedgerEnv trce protoInfo dir nw systemStart (soptAbortOnInvalid syncOptions)
                  (snapshotEveryFollowing syncOptions) (snapshotEveryLagging syncOptions)
   cache <- if soptCache syncOptions then newEmptyCache 100000 else pure uninitiatedCache
+  owq <- newTBQueueIO 100
+  orq <- newTBQueueIO 100
+  epochSyncTime <- newTVarIO =<< getCurrentTime
+  noLegdState <- mkNoLedgerStateEnv trce systemStart
   pure $ SyncEnv
           { envProtocol = SyncProtocolCardano
           , envNetworkMagic = nwMagic
           , envSystemStart = systemStart
           , envBackend = backend
           , envOptions = syncOptions
           , envCache = cache
+          , envOfflineWorkQueue = owq
+          , envOfflineResultQueue = orq
+          , envEpochSyncTime = epochSyncTime
+          , envNoLedgerEnv = noLegdState
           , envLedger = ledgerEnv
           }
 
@@ -154,13 +175,21 @@ mkSyncEnvFromConfig trce backend syncOptions dir genCfg =
           Right <$> mkSyncEnv trce backend syncOptions (mkProtocolInfoCardano genCfg []) (Shelley.sgNetworkId $ scConfig sCfg)
                       (NetworkMagic . unProtocolMagicId $ Byron.configProtocolMagicId bCfg)
                       (SystemStart .Byron.gdStartTime $ Byron.configGenesisData bCfg)
-                      dir (calculateStableEpochSlot $ scConfig sCfg)
+                      dir
 
 
 getLatestPoints :: SyncEnv -> IO [CardanoPoint]
 getLatestPoints env = do
-  files <- listLedgerStateFilesOrdered $ leDir (envLedger env)
-  verifyFilePoints env files
+    if hasLedgerState env then do
+      files <- listLedgerStateFilesOrdered $ leDir (envLedger env)
+      verifyFilePoints env files
+    else do
+      -- Brings the 5 latest.
+      lastPoints <- DB.runDbIohkNoLogging (envBackend env) DB.queryLatestPoints
+      pure $ mapMaybe convert' lastPoints
+  where
+    convert' (Nothing, _) = Nothing
+    convert' (Just slot, bs) = convert (SlotNo slot) bs
 
 verifyFilePoints :: SyncEnv -> [LedgerStateFile] -> IO [CardanoPoint]
 verifyFilePoints env files =
@@ -171,31 +200,12 @@ verifyFilePoints env files =
         hashes <- getSlotHash (envBackend env) (lsfSlotNo lsf)
         let valid  = find (\(_, h) -> lsfHash lsf == hashToAnnotation h) hashes
         case valid of
-          Just (slot, hash) | slot == lsfSlotNo lsf -> pure $ convert (slot, hash)
+          Just (slot, hash) | slot == lsfSlotNo lsf -> pure $ convert slot hash
           _ -> pure Nothing
 
-    convert :: (SlotNo, ByteString) -> Maybe CardanoPoint
-    convert (slot, hashBlob) =
-      Point . Point.block slot <$> convertHashBlob hashBlob
-
+convert :: SlotNo -> ByteString -> Maybe CardanoPoint
+convert slot hashBlob =
+    Point . Point.block slot <$> convertHashBlob hashBlob
+  where
     convertHashBlob :: ByteString -> Maybe (HeaderHash CardanoBlock)
     convertHashBlob = Just . fromRawHash (Proxy @CardanoBlock)
-
--- -------------------------------------------------------------------------------------------------
--- This is incredibly suboptimal. It should work, for now, but may break at some future time and
--- when it is wrong then data in `db-sync` will simply be wrong and we do not have any way of
--- detecting that it is wrong.
---
--- An epoch is `10 k / f` long, and the stability window is `3 k / f` so the time from the start
--- of the epoch to start of the stability window is `7 k / f`.
---
--- Hopefully lower level libraries will be able to provide us with something better than this soon.
-calculateStableEpochSlot :: Shelley.ShelleyGenesis era -> EpochSlot
-calculateStableEpochSlot cfg =
-    EpochSlot $ ceiling (7.0 * secParam / actSlotCoeff)
-  where
-    secParam :: Double
-    secParam = fromIntegral $ Shelley.sgSecurityParam cfg
-
-    actSlotCoeff :: Double
-    actSlotCoeff = fromRational (Ledger.unboundRational $ Shelley.sgActiveSlotsCoeff cfg)

cardano-db-sync/src/Cardano/DbSync/Config/Types.hs

@@ -68,6 +68,7 @@ data SyncNodeParams = SyncNodeParams
   , enpPGPassSource :: !PGPassSource
   , enpExtended :: !Bool
   , enpHasCache :: !Bool
+  , enpHasLedger :: !Bool
   , enpMaybeRollback :: !(Maybe SlotNo)
   }
 
@@ -156,8 +157,8 @@ pcNodeConfigFilePath = unNodeConfigFile . pcNodeConfigFile
 -- -------------------------------------------------------------------------------------------------
 
 instance FromJSON SyncPreConfig where
-  parseJSON o =
-    Aeson.withObject "top-level" parseGenSyncNodeConfig o
+  parseJSON =
+    Aeson.withObject "top-level" parseGenSyncNodeConfig
 
 parseGenSyncNodeConfig :: Object -> Parser SyncPreConfig
 parseGenSyncNodeConfig o =

cardano-db-sync/src/Cardano/DbSync/Database.hs

@@ -89,7 +89,9 @@ runActions env actions = do
             pure Done
         ([], DbRollBackToPoint pt resultVar : ys) -> do
             runRollbacksDB env pt
-            points <- lift $ rollbackLedger env pt
+            points <- if hasLedgerState env
+              then lift $ rollbackLedger env pt
+              else pure Nothing
             blockNo <- lift $ getDbTipBlockNo env
             lift $ atomically $ putTMVar resultVar (points, blockNo)
             dbAction Continue ys

cardano-db-sync/src/Cardano/DbSync/Default.hs

@@ -27,7 +27,8 @@ import           Cardano.DbSync.Era.Shelley.Insert.Epoch (insertPoolDepositRefun
 import           Cardano.DbSync.Era.Shelley.Validate (validateEpochRewards)
 import           Cardano.DbSync.Error
 import           Cardano.DbSync.LedgerState (ApplyResult (..), LedgerEvent (..),
-                   applyBlockAndSnapshot)
+                   applyBlockAndSnapshot, defaultApplyResult)
+import           Cardano.DbSync.LocalStateQuery
 import           Cardano.DbSync.Rollback (rollbackToPoint)
 import           Cardano.DbSync.Types
 import           Cardano.DbSync.Util
@@ -64,12 +65,12 @@ insertListBlocks env blocks = do
 applyAndInsert
     :: SyncEnv -> CardanoBlock -> ExceptT SyncNodeError (ReaderT SqlBackend (LoggingT IO)) ()
 applyAndInsert env cblk = do
-    !applyResult <- liftIO $ applyBlockAndSnapshot (envLedger env) cblk
+    !applyResult <- liftIO mkApplyResult
     let !details = apSlotDetails applyResult
     insertLedgerEvents env (sdEpochNo details) (apEvents applyResult)
     insertEpoch details
     let firstBlockOfEpoch = hasEpochStartEvent (apEvents applyResult)
-    let isMember = \poolId -> Set.member poolId (apPoolsRegistered applyResult)
+    let isMember poolId = Set.member poolId (apPoolsRegistered applyResult)
     case cblk of
       BlockByron blk ->
         newExceptT $ insertByronBlock env firstBlockOfEpoch blk details
@@ -99,6 +100,14 @@ applyAndInsert env cblk = do
       Strict.Just pr -> pr
       Strict.Nothing -> Ledger.Prices minBound minBound
 
+    mkApplyResult :: IO ApplyResult
+    mkApplyResult = do
+      if hasLedgerState env then
+        applyBlockAndSnapshot (envLedger env) cblk
+      else do
+        slotDetails <- getSlotDetailsNode (envNoLedgerEnv env) (cardanoBlockSlotNo cblk)
+        pure $ defaultApplyResult slotDetails
+
 -- -------------------------------------------------------------------------------------------------
 
 insertLedgerEvents
@@ -129,7 +138,7 @@ insertLedgerEvents env currentEpochNo@(EpochNo curEpoch) =
       case ev of
         LedgerNewEpoch en ss -> do
           lift $ do
-            insertEpochSyncTime en (toSyncState ss) (leEpochSyncTime lenv)
+            insertEpochSyncTime en (toSyncState ss) (envEpochSyncTime env)
           sqlBackend <- lift ask
           persistantCacheSize <- liftIO $ statementCacheSize $ connStmtMap sqlBackend
           liftIO . logInfo tracer $ "Persistant SQL Statement Cache size is " <> textShow persistantCacheSize

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs

@@ -146,8 +146,8 @@ insertShelleyBlock env firstBlockOfEpoch blk details isMember mNewEpoch stakeSli
 
     when (unBlockNo (Generic.blkBlockNo blk) `mod` offlineModBase == 0) .
       lift $ do
-        insertOfflineResults tracer (leOfflineResultQueue lenv)
-        loadOfflineWorkQueue tracer (leOfflineWorkQueue lenv)
+        insertOfflineResults tracer (envOfflineResultQueue env)
+        loadOfflineWorkQueue tracer (envOfflineWorkQueue env)
 
     when (getSyncStatus details == SyncFollowing) $
       -- Serializiing things during syncing can drastically slow down full sync

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Offline.hs

@@ -39,7 +39,7 @@ import qualified Cardano.Crypto.Hash.Class as Crypto
 import           Cardano.Db
 import qualified Cardano.Db as DB
 
-import           Cardano.DbSync.LedgerState
+import           Cardano.DbSync.Api
 import           Cardano.DbSync.Util
 
 import           Database.Persist.Sql (SqlBackend)
@@ -93,18 +93,18 @@ insertOfflineResults trce resultQueue = do
         ResultError {} -> True
 
 
-runOfflineFetchThread :: Trace IO Text -> LedgerEnv -> IO ()
-runOfflineFetchThread trce lenv = do
+runOfflineFetchThread :: Trace IO Text -> SyncEnv -> IO ()
+runOfflineFetchThread trce env = do
     logInfo trce "Running Offline fetch thread"
     forever $ do
       threadDelay 60_000_000 -- 60 second sleep
-      xs <- blockingFlushTBQueue (leOfflineWorkQueue lenv)
+      xs <- blockingFlushTBQueue (envOfflineWorkQueue env)
       manager <- Http.newManager tlsManagerSettings
       now <- liftIO Time.getPOSIXTime
       mapM_ (queueInsert <=< fetchOfflineData trce manager now) xs
   where
     queueInsert :: FetchResult -> IO ()
-    queueInsert = atomically . writeTBQueue (leOfflineResultQueue lenv)
+    queueInsert = atomically . writeTBQueue (envOfflineResultQueue env)
 
 -- -------------------------------------------------------------------------------------------------