Handle need for separate UTxO query with cardano-node 10.4

Author: neilmayhew

libs/ledger-state/README.md

@@ -51,12 +51,15 @@ $ cardano-node run \
     --port 3001 &
 ```
 
-Dump the ledger state:
+Dump the ledger state and utxo:
 
 ```shell
 $ cardano-cli query ledger-state --mainnet \
     --socket-path "${CARDANO_NODE_SOCKET_PATH}" \
     --out-file "${CARDANO_DATA}/new-epoch-state.bin"
+$ cardano-cli query utxo --mainnet --whole-utxo --output-cbor \
+    --socket-path "${CARDANO_NODE_SOCKET_PATH}" \
+    --out-file "${CARDANO_DATA}/utxo.hex"
 ```
 
 Bring the node back into the foreground and use Ctrl-C to stop it:
@@ -103,6 +106,7 @@ menu, therefore paths to those files must be supplied as environment variables.
 ```shell
 $ export BENCH_GENESIS_PATH=${CARDANO_DATA}/shelley-genesis.json
 $ export BENCH_LEDGER_STATE_PATH=${CARDANO_DATA}/new-epoch-state.bin
+$ export BENCH_UTXO_PATH=${CARDANO_DATA}/utxo.hex
 $ cabal bench ledger-state:performance --benchmark-option=--csv=ledger-state:performance.csv
 ```
 

libs/ledger-state/bench/Performance.hs

@@ -21,7 +21,7 @@ import Cardano.Ledger.Shelley.Genesis (
  )
 import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.State
-import Cardano.Ledger.State.UTxO (CurrentEra, readNewEpochState)
+import Cardano.Ledger.State.UTxO (CurrentEra, readHexUTxO, readNewEpochState)
 import Cardano.Ledger.UMap
 import Cardano.Ledger.Val
 import Cardano.Slotting.EpochInfo (fixedEpochInfo)
@@ -40,7 +40,7 @@ import Data.MapExtras (extractKeys, extractKeysSmallSet)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import GHC.Stack (HasCallStack)
-import Lens.Micro ((^.))
+import Lens.Micro ((&), (.~), (^.))
 import System.Environment (getEnv)
 import System.Exit (die)
 import System.Random.Stateful
@@ -49,11 +49,27 @@ import Test.Cardano.Ledger.Core.Arbitrary (uniformSubSet)
 
 main :: IO ()
 main = do
-  let ledgerVarName = "BENCH_LEDGER_STATE_PATH"
-      genesisVarName = "BENCH_GENESIS_PATH"
-  ledgerStateFilePath <- getEnv ledgerVarName
+  let genesisVarName = "BENCH_GENESIS_PATH"
+      utxoVarName = "BENCH_UTXO_PATH"
+      ledgerStateVarName = "BENCH_LEDGER_STATE_PATH"
   genesisFilePath <- getEnv genesisVarName
+  utxoFilePath <- getEnv utxoVarName
+  ledgerStateFilePath <- getEnv ledgerStateVarName
+
   genesis <- either error id <$> eitherDecodeFileStrict' genesisFilePath
+  putStrLn $ "Importing UTxO from: " ++ show utxoFilePath
+  utxo <- readHexUTxO utxoFilePath
+  putStrLn "Done importing UTxO"
+  putStrLn $ "Importing NewEpochState from: " ++ show ledgerStateFilePath
+  es' <- readNewEpochState ledgerStateFilePath
+  putStrLn "Done importing NewEpochState"
+
+  let nesUTxOL = nesEsL . esLStateL . lsUTxOStateL . utxoL
+      es = es' & nesUTxOL .~ utxo
+      utxoMap = unUTxO utxo
+      utxoSize = Map.size utxoMap
+      largeKeysNum = 100000
+      stdGen = mkStdGen 2022
 
   let toMempoolState :: NewEpochState CurrentEra -> MempoolState CurrentEra
       toMempoolState NewEpochState {nesEs = EpochState {esLState}} = esLState
@@ -62,20 +78,15 @@ main = do
       applyTx' mempoolEnv mempoolState =
         either (error . show) seqTuple
           . applyTx globals mempoolEnv mempoolState
-      reapplyTx' mempoolEnv mempoolState tx =
-        case reapplyTx globals mempoolEnv mempoolState tx of
-          Left err -> error (show err)
-          Right st -> st
-  putStrLn $ "Importing NewEpochState from: " ++ show ledgerStateFilePath
-  es <- readNewEpochState ledgerStateFilePath
-  putStrLn "Done importing NewEpochState"
-  let utxoMap = unUTxO $ getUTxO es
-      utxoSize = Map.size utxoMap
-      largeKeysNum = 100000
-      stdGen = mkStdGen 2022
+      reapplyTx' mempoolEnv mempoolState =
+        either (error . show) id
+          . reapplyTx globals mempoolEnv mempoolState
+
   when (utxoSize < largeKeysNum) $
-    die $ "UTxO size is too small (" <> show utxoSize <> " < " <> show largeKeysNum <> ")"
+    die $
+      "UTxO size is too small (" <> show utxoSize <> " < " <> show largeKeysNum <> ")"
   largeKeys <- selectRandomMapKeys 100000 stdGen utxoMap
+
   defaultMain
     [ env (pure (mkMempoolEnv es slotNo, toMempoolState es)) $ \ ~(mempoolEnv, mempoolState) ->
         bgroup
@@ -103,15 +114,15 @@ main = do
               (pure [validatedTx1, validatedTx2, validatedTx3])
               $ bench "Tx1+Tx2+Tx3" . whnf (F.foldl' (\ms -> fst . applyTx' mempoolEnv ms . extractTx) mempoolState)
           ]
-    , env (pure (getUTxO es)) $ \utxo ->
+    , env (pure utxo) $ \utxo' ->
         bgroup
           "UTxO"
-          [ bench "balance" $ nf balance utxo
-          , bench "coinBalance" $ nf coinBalance utxo
+          [ bench "balance" $ nf balance utxo'
+          , bench "coinBalance" $ nf coinBalance utxo'
           , -- We need to filter out all multi-assets to prevent `areAllAdaOnly`
             -- from short circuiting and producing results that are way better
             -- than the worst case
-            env (pure $ Map.filter (\txOut -> isAdaOnly (txOut ^. valueTxOutL)) $ unUTxO utxo) $
+            env (pure $ Map.filter (\txOut -> isAdaOnly (txOut ^. valueTxOutL)) $ unUTxO utxo') $
               bench "areAllAdaOnly" . nf areAllAdaOnly
           ]
     , env (pure es) $ \newEpochState ->

libs/ledger-state/ledger-state.cabal

@@ -36,6 +36,7 @@ library
 
   build-depends:
     base >=4.14 && <5,
+    base16-bytestring,
     bytestring,
     cardano-crypto-class,
     cardano-ledger-alonzo,

libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs

@@ -32,12 +32,16 @@ import qualified Cardano.Ledger.UMap as UM (ptrMap)
 import Conduit
 import Control.Exception (throwIO)
 import Control.Foldl (Fold (..))
+import Control.Monad ((<=<))
 import Control.SetAlgebra (range)
+import Data.Bifunctor (first)
+import qualified Data.ByteString.Base16.Lazy as Base16
 import qualified Data.ByteString.Lazy as LBS
 import Data.Foldable as F
 import qualified Data.IntMap.Strict as IntMap
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import Data.Typeable
 import qualified Data.VMap as VMap
 import Lens.Micro
@@ -57,11 +61,20 @@ readEpochState ::
   IO (EpochState CurrentEra)
 readEpochState = readDecCBOR
 
+readHexUTxO ::
+  FilePath ->
+  IO (UTxO CurrentEra)
+readHexUTxO = readDecCBORHex
+
 readDecCBOR :: FromCBOR a => FilePath -> IO a
-readDecCBOR fp =
-  LBS.readFile fp <&> Plain.decodeFull >>= \case
-    Left exc -> throwIO exc
-    Right res -> pure res
+readDecCBOR = either throwIO pure . Plain.decodeFull <=< LBS.readFile
+
+readDecCBORHex :: FromCBOR a => FilePath -> IO a
+readDecCBORHex = either throwIO pure . decodeFullHex <=< LBS.readFile
+  where
+    decodeFullHex =
+      Plain.decodeFull
+        <=< first (DecoderErrorCustom "Invalid Hex encoding:" . T.pack) . Base16.decode
 
 writeEpochState :: FilePath -> EpochState CurrentEra -> IO ()
 writeEpochState fp = LBS.writeFile fp . Plain.serialize