allow configuring writing utxo state to file

cardano-scaling · Oct 20, 2023 · 0c3a59f · 0c3a59f
1 parent 548ab34
commit 0c3a59f
Show file tree

Hide file tree

Showing 3 changed files with 66 additions and 6 deletions.
diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs
@@ -1,17 +1,18 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
 
 module Main where
 
 import Hydra.Prelude hiding (fromList)
 
 import Hydra.API.Server (Server (..), withAPIServer)
-import Hydra.API.ServerOutput (ServerOutput (..))
+import Hydra.API.ServerOutput (ServerOutput (PeerConnected, PeerDisconnected))
 import Hydra.Cardano.Api (
   ProtocolParametersConversionError,
   ShelleyBasedEra (..),
   serialiseToRawBytesHex,
-  toLedgerPParams, ProtocolParameters, LedgerEra, StandardCrypto, GenesisParameters (GenesisParameters), ShelleyEra,
+  toLedgerPParams, ProtocolParameters, LedgerEra, StandardCrypto, GenesisParameters (GenesisParameters), ShelleyEra, Tx,
  )
 import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters)
 import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain, withOfflineChain)
@@ -21,7 +22,7 @@ import Hydra.Chain.Direct.Util (readKeyPair)
 import Hydra.HeadLogic (
   Environment (..),
   Event (..),
-  defaultTTL,
+  defaultTTL, StateChanged (tx, newLocalUTxO, TransactionAppliedToLocalUTxO, SnapshotConfirmed, snapshot),
  )
 import qualified Hydra.Ledger.Cardano as Ledger
 import Hydra.Ledger.Cardano.Configuration (
@@ -54,9 +55,9 @@ import Hydra.Options (
   OfflineConfig (..),
   explain,
   parseHydraCommand,
-  validateRunOptions,
+  validateRunOptions, OfflineUTxOWriteBackConfig (WriteBackToInitialUTxO, WriteBackToUTxOFile),
  )
-import Hydra.Persistence (createPersistenceIncremental)
+import Hydra.Persistence (createPersistenceIncremental, PersistenceIncremental (PersistenceIncremental, append, loadAll))
 import Hydra.Utils (genHydraKeys)
 import Hydra.Ledger (Ledger)
 import qualified Hydra.Cardano.Api as Shelley
@@ -65,6 +66,9 @@ import Cardano.Ledger.BaseTypes (unboundRational)
 import qualified Cardano.Ledger.Crypto as Ledger
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import Hydra.Chain (HeadId(HeadId))
+import qualified Data.Aeson as Aeson
+import UnliftIO.IO.File (writeBinaryFileDurableAtomic)
+import Hydra.Snapshot (Snapshot(Snapshot), utxo)
 
 newtype ConfigurationParseException = ConfigurationParseException ProtocolParametersConversionError
   deriving (Show)
@@ -100,7 +104,7 @@ main = do
               Just offlineConfig' -> Left offlineConfig'
 
         withCardanoLedger onlineOrOfflineConfig pparams $ \ledger -> do
-          persistence <- createPersistenceIncremental $ persistenceDir <> "/state"
+          persistence <- createStateChangePersistence (persistenceDir <> "/state") (leftToMaybe onlineOrOfflineConfig)
           (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState
           checkHeadState (contramap Node tracer) env hs
           nodeState <- createNodeState hs
@@ -168,6 +172,36 @@ main = do
     let ledgerEnv = newLedgerEnv protocolParams
     action (Ledger.cardanoLedger globals ledgerEnv)
 
+
+  createStateChangePersistence :: (MonadIO m, MonadThrow m) => FilePath -> Maybe OfflineConfig -> m (PersistenceIncremental (StateChanged Tx) m)
+  createStateChangePersistence persistenceFilePath = \case
+    Just OfflineConfig{initialUTxOFile, utxoWriteBack = Just writeBackConfig } ->
+      createPersistenceWithUTxOWriteBack persistenceFilePath $ case writeBackConfig of 
+        WriteBackToInitialUTxO -> initialUTxOFile
+        WriteBackToUTxOFile customFile -> customFile
+    _ -> createPersistenceIncremental persistenceFilePath
+
+
+  --TODO(Elaine): move this elsewhere
+  createPersistenceWithUTxOWriteBack ::
+    (MonadIO m, MonadThrow m) =>
+    FilePath ->
+    FilePath ->
+    m (PersistenceIncremental (StateChanged Tx) m)
+  createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do
+    PersistenceIncremental{append, loadAll} <- createPersistenceIncremental persistenceFilePath
+    pure PersistenceIncremental { loadAll, append = \stateChange -> do
+      append stateChange
+      case stateChange of 
+        --TODO(Elaine): do we want to do this on snapshot confirmation or on transaction over local utxo
+        -- see onOpenNetworkReqTx
+        -- TransactionAppliedToLocalUTxO{tx, newLocalUTxO} ->
+        --   writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode newLocalUTxO
+        SnapshotConfirmed { snapshot = Snapshot{utxo} } ->
+          writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo
+        _ -> pure ()
+    }
+
 identifyNode :: RunOptions -> RunOptions
 identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId}
 identifyNode opt = opt

diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal
@@ -208,8 +208,11 @@ executable hydra-node
     , hydra-cardano-api
     , hydra-node
     --TODO(Elaine): get rid of these deps by simplifying main target
+    -- move stuff into lib
     , cardano-ledger-core
     , cardano-ledger-shelley
+    , unliftio
+    , aeson
     , hydra-prelude
 
   ghc-options:    -threaded -rtsopts -with-rtsopts=-N4

diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs
@@ -169,18 +169,41 @@ ledgerGenesisFileParser =
         <> help "File containing ledger genesis parameters."
     )
 
+data OfflineUTxOWriteBackConfig = WriteBackToInitialUTxO | WriteBackToUTxOFile FilePath
+  deriving (Eq, Show, Generic, FromJSON, ToJSON)
+
 data OfflineConfig = OfflineConfig
   {
     initialUTxOFile :: FilePath
   , ledgerGenesisFile :: FilePath
   -- TODO(Elaine): need option to dump final utxo to file without going thru snapshot
+  , utxoWriteBack :: Maybe OfflineUTxOWriteBackConfig
   } deriving (Eq, Show, Generic, FromJSON, ToJSON)
 
+-- TODO(Elaine): name this
+offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig)
+offlineUTxOWriteBackOptionsParser =
+  optional $
+    asum
+      [ flag' WriteBackToInitialUTxO
+          ( long "write-back-to-initial-utxo"
+              <> help "Write back to initial UTxO file."
+          )
+      , WriteBackToUTxOFile
+          <$> option
+            str
+            ( long "write-back-to-utxo-file"
+                <> metavar "FILE"
+                <> help "Write back to given UTxO file."
+            )
+      ]
+
 offlineOptionsParser :: Parser OfflineConfig
 offlineOptionsParser =
   OfflineConfig
     <$> initialUTxOFileParser
     <*> ledgerGenesisFileParser
+    <*> offlineUTxOWriteBackOptionsParser
 
 data RunOptions = RunOptions
   { verbosity :: Verbosity