From 7d124596f3d46c1223d6936a5cde9583c60f6591 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Mon, 23 May 2022 12:28:48 +0200
Subject: [PATCH] Factor some CardanoClient queries to drop hydra-cluster
dependency in hydra-tui
---
hydra-cluster/src/CardanoClient.hs | 131 ++----------------
hydra-node/hydra-node.cabal | 1 +
hydra-node/src/Hydra/Chain/CardanoClient.hs | 141 ++++++++++++++++++++
hydra-node/src/Hydra/Chain/Direct.hs | 73 +---------
hydra-tui/hydra-tui.cabal | 1 -
hydra-tui/src/Hydra/TUI.hs | 14 +-
6 files changed, 164 insertions(+), 197 deletions(-)
create mode 100644 hydra-node/src/Hydra/Chain/CardanoClient.hs
diff --git a/hydra-cluster/src/CardanoClient.hs b/hydra-cluster/src/CardanoClient.hs
index 43eb633129b..5398f099f6e 100644
--- a/hydra-cluster/src/CardanoClient.hs
+++ b/hydra-cluster/src/CardanoClient.hs
@@ -1,35 +1,22 @@
--- | A basic cardano-node client that can talk to a local cardano-node.
+-- | A cardano-node client used in end-to-end tests and benchmarks.
--
--- The idea of this module is to provide a Haskell interface on top of cardano-cli's API,
--- using cardano-api types.
-module CardanoClient where
+-- This modules contains some more functions besides the re-exported basic
+-- querying of hydra-node's 'Hydra.Chain.CardanoClient'.
+module CardanoClient (
+ module Hydra.Chain.CardanoClient,
+ module CardanoClient,
+) where
import Hydra.Prelude
import Hydra.Cardano.Api hiding (Block)
+import Hydra.Chain.CardanoClient
import qualified Cardano.Api.UTxO as UTxO
-import Cardano.Slotting.Time (SystemStart)
import qualified Data.Map as Map
-import qualified Data.Set as Set
-import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
import Ouroboros.Network.Protocol.LocalTxSubmission.Client (SubmitResult (..))
-type NodeSocket = FilePath
-
-data CardanoClient = CardanoClient
- { queryUTxOByAddress :: [Address ShelleyAddr] -> IO UTxO
- , networkId :: NetworkId
- }
-
-mkCardanoClient :: NetworkId -> FilePath -> CardanoClient
-mkCardanoClient networkId filePath =
- CardanoClient
- { queryUTxOByAddress = queryUTxO networkId filePath
- , networkId
- }
-
--- TODO(SN): DRY with Hydra.Ledger.Cardano module
+-- TODO(SN): DRY with Hydra.Cardano.Api
-- | Build an address give a key.
--
@@ -44,61 +31,6 @@ buildScriptAddress script networkId =
let hashed = hashScript script
in makeShelleyAddress networkId (PaymentCredentialByScript hashed) NoStakeAddress
--- |Query UTxO for all given addresses.
---
--- This query is specialised for Shelley addresses in Alonzo era.
--- Throws 'CardanoClientException' if query fails.
-queryUTxO :: NetworkId -> FilePath -> [Address ShelleyAddr] -> IO UTxO
-queryUTxO networkId socket addresses =
- let query =
- QueryInEra
- AlonzoEraInCardanoMode
- ( QueryInShelleyBasedEra
- ShelleyBasedEraAlonzo
- ( QueryUTxO
- (QueryUTxOByAddress (Set.fromList $ map AddressShelley addresses))
- )
- )
- in UTxO.fromApi <$> runQuery networkId socket query
-
-queryUTxOByTxIn :: NetworkId -> FilePath -> [TxIn] -> IO UTxO
-queryUTxOByTxIn networkId socket inputs =
- let query =
- QueryInEra
- AlonzoEraInCardanoMode
- ( QueryInShelleyBasedEra
- ShelleyBasedEraAlonzo
- (QueryUTxO (QueryUTxOByTxIn (Set.fromList inputs)))
- )
- in UTxO.fromApi <$> runQuery networkId socket query
-
--- | Query the whole UTxO from node. Useful for debugging, but should obviously
--- not be used in production code.
-queryUTxOWhole :: NetworkId -> FilePath -> IO UTxO
-queryUTxOWhole networkId socket =
- let query =
- QueryInEra
- AlonzoEraInCardanoMode
- ( QueryInShelleyBasedEra
- ShelleyBasedEraAlonzo
- (QueryUTxO QueryUTxOWhole)
- )
- in UTxO.fromApi <$> runQuery networkId socket query
-
--- | Query current protocol parameters.
---
--- Throws 'CardanoClientException' if query fails.
-queryProtocolParameters :: NetworkId -> FilePath -> IO ProtocolParameters
-queryProtocolParameters networkId socket =
- let query =
- QueryInEra
- AlonzoEraInCardanoMode
- ( QueryInShelleyBasedEra
- ShelleyBasedEraAlonzo
- QueryProtocolParameters
- )
- in runQuery networkId socket query
-
queryStakePools :: NetworkId -> FilePath -> IO (Set PoolId)
queryStakePools networkId socket =
let query =
@@ -110,45 +42,6 @@ queryStakePools networkId socket =
)
in runQuery networkId socket query
-runQuery :: NetworkId -> FilePath -> QueryInMode CardanoMode (Either EraMismatch a) -> IO a
-runQuery networkId socket query =
- queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing query >>= \case
- Left err -> throwIO $ QueryException (show err)
- Right (Left eraMismatch) -> throwIO $ QueryException (show eraMismatch)
- Right (Right result) -> pure result
-
-localNodeConnectInfo :: NetworkId -> FilePath -> LocalNodeConnectInfo CardanoMode
-localNodeConnectInfo = LocalNodeConnectInfo cardanoModeParams
-
-cardanoModeParams :: ConsensusModeParams CardanoMode
-cardanoModeParams = CardanoModeParams $ EpochSlots defaultByronEpochSlots
- where
- -- NOTE(AB): extracted from Parsers in cardano-cli, this is needed to run in 'cardanoMode' which
- -- is the default for cardano-cli
- defaultByronEpochSlots = 21600 :: Word64
-
-queryTipSlotNo :: NetworkId -> FilePath -> IO SlotNo
-queryTipSlotNo networkId socket =
- getLocalChainTip (localNodeConnectInfo networkId socket) >>= \case
- ChainTipAtGenesis -> pure 0
- ChainTip slotNo _ _ -> pure slotNo
-
-queryTip :: NetworkId -> FilePath -> IO ChainPoint
-queryTip networkId socket =
- chainTipToChainPoint <$> getLocalChainTip (localNodeConnectInfo networkId socket)
-
-querySystemStart :: NetworkId -> FilePath -> IO SystemStart
-querySystemStart networkId socket =
- queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing QuerySystemStart >>= \case
- Left err -> throwIO $ QueryException (show err)
- Right result -> pure result
-
-queryEraHistory :: NetworkId -> FilePath -> IO (EraHistory CardanoMode)
-queryEraHistory networkId socket =
- queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing (QueryEraHistory CardanoModeIsMultiEra) >>= \case
- Left err -> throwIO $ QueryException (show err)
- Right result -> pure result
-
-- | Build a "raw" transaction from a bunch of inputs, outputs and fees.
buildRaw :: [TxIn] -> [TxOut CtxTx] -> Lovelace -> Either TxBodyError TxBody
buildRaw ins outs fee =
@@ -273,11 +166,11 @@ submit :: NetworkId -> FilePath -> Tx -> IO ()
submit networkId socket tx =
submitTxToNodeLocal (localNodeConnectInfo networkId socket) (TxInMode tx AlonzoEraInCardanoMode) >>= \case
SubmitSuccess -> pure ()
- SubmitFail err -> throwIO $ SubmitException{reason = show err, tx}
+ SubmitFail err -> throwIO $ ClientSubmitException{reason = show err, tx}
data CardanoClientException
- = QueryException Text
- | SubmitException {reason :: Text, tx :: Tx}
+ = ClientQueryException QueryException
+ | ClientSubmitException {reason :: Text, tx :: Tx}
deriving (Show)
instance Exception CardanoClientException
diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal
index 3ad0cfc4d0f..3b401389395 100644
--- a/hydra-node/hydra-node.cabal
+++ b/hydra-node/hydra-node.cabal
@@ -76,6 +76,7 @@ library
exposed-modules:
Hydra.API.Server
Hydra.Chain
+ Hydra.Chain.CardanoClient
Hydra.Chain.Direct
Hydra.Chain.Direct.Context
Hydra.Chain.Direct.State
diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs
new file mode 100644
index 00000000000..b7e04f907cc
--- /dev/null
+++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs
@@ -0,0 +1,141 @@
+-- | A basic cardano-node client that can talk to a local cardano-node.
+--
+-- The idea of this module is to provide a Haskell interface on top of
+-- cardano-cli's API, using cardano-api types.
+module Hydra.Chain.CardanoClient where
+
+import Hydra.Prelude
+
+import Hydra.Cardano.Api hiding (Block)
+
+import qualified Cardano.Api.UTxO as UTxO
+import Cardano.Slotting.Time (SystemStart)
+import qualified Data.Set as Set
+import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
+
+type NodeSocket = FilePath
+
+newtype QueryException
+ = QueryException Text
+ deriving (Eq, Show)
+
+instance Exception QueryException
+
+-- * CardanoClient handle
+
+-- | Handle interface for abstract querying of a cardano node.
+data CardanoClient = CardanoClient
+ { queryUTxOByAddress :: [Address ShelleyAddr] -> IO UTxO
+ , networkId :: NetworkId
+ }
+
+-- | Construct a 'CardanoClient' handle.
+mkCardanoClient :: NetworkId -> NodeSocket -> CardanoClient
+mkCardanoClient networkId nodeSocket =
+ CardanoClient
+ { queryUTxOByAddress = queryUTxO networkId nodeSocket
+ , networkId
+ }
+
+-- * Individual functions
+
+queryTip :: NetworkId -> FilePath -> IO ChainPoint
+queryTip networkId socket =
+ chainTipToChainPoint <$> getLocalChainTip (localNodeConnectInfo networkId socket)
+
+queryTipSlotNo :: NetworkId -> FilePath -> IO SlotNo
+queryTipSlotNo networkId socket =
+ getLocalChainTip (localNodeConnectInfo networkId socket) >>= \case
+ ChainTipAtGenesis -> pure 0
+ ChainTip slotNo _ _ -> pure slotNo
+
+-- | Throws at least 'QueryException' if query fails.
+querySystemStart :: NetworkId -> FilePath -> IO SystemStart
+querySystemStart networkId socket =
+ queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing QuerySystemStart >>= \case
+ Left err -> throwIO $ QueryException (show err)
+ Right result -> pure result
+
+-- | Throws at least 'QueryException' if query fails.
+queryEraHistory :: NetworkId -> FilePath -> IO (EraHistory CardanoMode)
+queryEraHistory networkId socket =
+ queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing (QueryEraHistory CardanoModeIsMultiEra) >>= \case
+ Left err -> throwIO $ QueryException (show err)
+ Right result -> pure result
+
+-- | Query current protocol parameters.
+--
+-- Throws at least 'QueryException' if query fails.
+queryProtocolParameters :: NetworkId -> FilePath -> IO ProtocolParameters
+queryProtocolParameters networkId socket =
+ let query =
+ QueryInEra
+ AlonzoEraInCardanoMode
+ ( QueryInShelleyBasedEra
+ ShelleyBasedEraAlonzo
+ QueryProtocolParameters
+ )
+ in runQuery networkId socket query
+
+-- | Query UTxO for all given addresses.
+--
+-- Throws at least 'QueryException' if query fails.
+queryUTxO :: NetworkId -> FilePath -> [Address ShelleyAddr] -> IO UTxO
+queryUTxO networkId socket addresses =
+ let query =
+ QueryInEra
+ AlonzoEraInCardanoMode
+ ( QueryInShelleyBasedEra
+ ShelleyBasedEraAlonzo
+ ( QueryUTxO
+ (QueryUTxOByAddress (Set.fromList $ map AddressShelley addresses))
+ )
+ )
+ in UTxO.fromApi <$> runQuery networkId socket query
+
+-- | Query UTxO for given tx inputs.
+--
+-- Throws at least 'QueryException' if query fails.
+queryUTxOByTxIn :: NetworkId -> FilePath -> [TxIn] -> IO UTxO
+queryUTxOByTxIn networkId socket inputs =
+ let query =
+ QueryInEra
+ AlonzoEraInCardanoMode
+ ( QueryInShelleyBasedEra
+ ShelleyBasedEraAlonzo
+ (QueryUTxO (QueryUTxOByTxIn (Set.fromList inputs)))
+ )
+ in UTxO.fromApi <$> runQuery networkId socket query
+
+-- | Query the whole UTxO from node. Useful for debugging, but should obviously
+-- not be used in production code.
+--
+-- Throws at least 'QueryException' if query fails.
+queryUTxOWhole :: NetworkId -> FilePath -> IO UTxO
+queryUTxOWhole networkId socket =
+ let query =
+ QueryInEra
+ AlonzoEraInCardanoMode
+ ( QueryInShelleyBasedEra
+ ShelleyBasedEraAlonzo
+ (QueryUTxO QueryUTxOWhole)
+ )
+ in UTxO.fromApi <$> runQuery networkId socket query
+
+-- | Throws at least 'QueryException' if query fails.
+runQuery :: NetworkId -> FilePath -> QueryInMode CardanoMode (Either EraMismatch a) -> IO a
+runQuery networkId socket query =
+ queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing query >>= \case
+ Left err -> throwIO $ QueryException (show err)
+ Right (Left eraMismatch) -> throwIO $ QueryException (show eraMismatch)
+ Right (Right result) -> pure result
+
+localNodeConnectInfo :: NetworkId -> FilePath -> LocalNodeConnectInfo CardanoMode
+localNodeConnectInfo = LocalNodeConnectInfo cardanoModeParams
+
+cardanoModeParams :: ConsensusModeParams CardanoMode
+cardanoModeParams = CardanoModeParams $ EpochSlots defaultByronEpochSlots
+ where
+ -- NOTE(AB): extracted from Parsers in cardano-cli, this is needed to run in 'cardanoMode' which
+ -- is the default for cardano-cli
+ defaultByronEpochSlots = 21600 :: Word64
diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs
index 239d6948bd9..b2ca935608e 100644
--- a/hydra-node/src/Hydra/Chain/Direct.hs
+++ b/hydra-node/src/Hydra/Chain/Direct.hs
@@ -29,7 +29,6 @@ import Cardano.Ledger.Shelley.Rules.Ledger (LedgerPredicateFailure (UtxowFailure
import Cardano.Ledger.Shelley.Rules.Utxow (UtxowPredicateFailure (UtxoFailure))
import Cardano.Ledger.Slot (EpochInfo)
import Cardano.Slotting.EpochInfo (hoistEpochInfo)
-import Cardano.Slotting.Time (SystemStart)
import Control.Exception (IOException)
import Control.Monad (foldM)
import Control.Monad.Class.MonadSTM (
@@ -53,20 +52,10 @@ import Data.Sequence.Strict (StrictSeq)
import Hydra.Cardano.Api (
CardanoMode,
ChainPoint (..),
- ChainTip (..),
- ConsensusModeIsMultiEra (CardanoModeIsMultiEra),
- ConsensusModeParams (CardanoModeParams),
- EpochSlots (EpochSlots),
EraHistory (EraHistory),
- EraInMode (AlonzoEraInCardanoMode),
LedgerEra,
- LocalNodeConnectInfo (LocalNodeConnectInfo),
NetworkId,
PaymentKey,
- ProtocolParameters,
- QueryInEra (QueryInShelleyBasedEra),
- QueryInMode (QueryEraHistory, QueryInEra, QuerySystemStart),
- QueryInShelleyBasedEra (QueryProtocolParameters),
ShelleyBasedEra (ShelleyBasedEraAlonzo),
SigningKey,
SlotNo,
@@ -76,8 +65,6 @@ import Hydra.Cardano.Api (
fromLedgerTx,
fromLedgerTxIn,
fromLedgerUTxO,
- getLocalChainTip,
- queryNodeLocalState,
toConsensusPointHF,
toLedgerPParams,
toLedgerTx,
@@ -91,6 +78,7 @@ import Hydra.Chain (
PostChainTx (..),
PostTxError (..),
)
+import Hydra.Chain.CardanoClient (queryEraHistory, queryProtocolParameters, querySystemStart, queryTipSlotNo)
import Hydra.Chain.Direct.State (
SomeOnChainHeadState (..),
TokHeadState (..),
@@ -127,7 +115,7 @@ import Hydra.Chain.Direct.Wallet (
import Hydra.Data.ContestationPeriod (posixToUTCTime)
import Hydra.Logging (Tracer, traceWith)
import Hydra.Party (Party)
-import Ouroboros.Consensus.Cardano.Block (EraMismatch, GenTx (..), HardForkApplyTxErr (ApplyTxErrAlonzo), HardForkBlock (BlockAlonzo))
+import Ouroboros.Consensus.Cardano.Block (GenTx (..), HardForkApplyTxErr (ApplyTxErrAlonzo), HardForkBlock (BlockAlonzo))
import qualified Ouroboros.Consensus.HardFork.History as Consensus
import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
import Ouroboros.Consensus.Network.NodeToClient (Codecs' (..))
@@ -733,60 +721,3 @@ instance ToJSON DirectChainLog where
[ "tag" .= String "Wallet"
, "contents" .= log
]
-
--- * Querying the cardano node
-
-newtype QueryException
- = QueryException Text
- deriving (Eq, Show)
-
-instance Exception QueryException
-
-queryTipSlotNo :: NetworkId -> FilePath -> IO SlotNo
-queryTipSlotNo networkId socket =
- getLocalChainTip (localNodeConnectInfo networkId socket) >>= \case
- ChainTipAtGenesis -> pure 0
- ChainTip slotNo _ _ -> pure slotNo
-
-querySystemStart :: NetworkId -> FilePath -> IO SystemStart
-querySystemStart networkId socket =
- queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing QuerySystemStart >>= \case
- Left err -> throwIO $ QueryException (show err)
- Right result -> pure result
-
-queryEraHistory :: NetworkId -> FilePath -> IO (EraHistory CardanoMode)
-queryEraHistory networkId socket =
- queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing (QueryEraHistory CardanoModeIsMultiEra) >>= \case
- Left err -> throwIO $ QueryException (show err)
- Right result -> pure result
-
--- | Query current protocol parameters.
---
--- Throws 'CardanoClientException' if query fails.
-queryProtocolParameters :: NetworkId -> FilePath -> IO ProtocolParameters
-queryProtocolParameters networkId socket =
- let query =
- QueryInEra
- AlonzoEraInCardanoMode
- ( QueryInShelleyBasedEra
- ShelleyBasedEraAlonzo
- QueryProtocolParameters
- )
- in runQuery networkId socket query
-
-runQuery :: NetworkId -> FilePath -> QueryInMode CardanoMode (Either EraMismatch a) -> IO a
-runQuery networkId socket query =
- queryNodeLocalState (localNodeConnectInfo networkId socket) Nothing query >>= \case
- Left err -> throwIO $ QueryException (show err)
- Right (Left eraMismatch) -> throwIO $ QueryException (show eraMismatch)
- Right (Right result) -> pure result
-
-localNodeConnectInfo :: NetworkId -> FilePath -> LocalNodeConnectInfo CardanoMode
-localNodeConnectInfo = LocalNodeConnectInfo cardanoModeParams
-
-cardanoModeParams :: ConsensusModeParams CardanoMode
-cardanoModeParams = CardanoModeParams $ EpochSlots defaultByronEpochSlots
- where
- -- NOTE(AB): extracted from Parsers in cardano-cli, this is needed to run in 'cardanoMode' which
- -- is the default for cardano-cli
- defaultByronEpochSlots = 21600 :: Word64
diff --git a/hydra-tui/hydra-tui.cabal b/hydra-tui/hydra-tui.cabal
index d06882652fb..f39e421f1e3 100644
--- a/hydra-tui/hydra-tui.cabal
+++ b/hydra-tui/hydra-tui.cabal
@@ -89,7 +89,6 @@ library
, cardano-ledger-shelley-ma
, containers
, hydra-cardano-api
- , hydra-cluster
, hydra-node
, hydra-prelude
, io-classes
diff --git a/hydra-tui/src/Hydra/TUI.hs b/hydra-tui/src/Hydra/TUI.hs
index c047ffae948..5b12ee54591 100644
--- a/hydra-tui/src/Hydra/TUI.hs
+++ b/hydra-tui/src/Hydra/TUI.hs
@@ -16,11 +16,6 @@ import Brick.Forms (Form, FormFieldState, checkboxField, editShowableFieldWithVa
import Brick.Widgets.Border (hBorder, vBorder)
import Brick.Widgets.Border.Style (ascii)
import qualified Cardano.Api.UTxO as UTxO
-import CardanoClient (
- CardanoClient (..),
- buildAddress,
- mkCardanoClient,
- )
import Data.List (nub, (\\))
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
@@ -39,6 +34,7 @@ import Graphics.Vty (
)
import qualified Graphics.Vty as Vty
import Graphics.Vty.Attributes (defAttr)
+import Hydra.Chain.CardanoClient (CardanoClient (..), mkCardanoClient)
import Hydra.Chain.Direct.Util (isMarkedOutput)
import Hydra.Client (Client (..), HydraEvent (..), withClient)
import Hydra.ClientInput (ClientInput (..))
@@ -309,7 +305,7 @@ handleCommitEvent ::
EventM n (Next State)
handleCommitEvent Client{sendInput, sk} CardanoClient{queryUTxOByAddress, networkId} s = case s ^? headStateL of
Just Initializing{} -> do
- utxo <- liftIO $ queryUTxOByAddress [buildAddress (getVerificationKey sk) networkId]
+ utxo <- liftIO $ queryUTxOByAddress [ourAddress]
-- XXX(SN): this is a hydra implementation detail and should be moved
-- somewhere hydra specific
let utxoWithoutFuel = Map.filter (not . isMarkedOutput) (UTxO.toMap utxo)
@@ -317,6 +313,12 @@ handleCommitEvent Client{sendInput, sk} CardanoClient{queryUTxOByAddress, networ
_ ->
continue $ s & feedbackL ?~ UserFeedback Error "Invalid command."
where
+ ourAddress =
+ makeShelleyAddress
+ networkId
+ (PaymentCredentialByKey . verificationKeyHash $ getVerificationKey sk)
+ NoStakeAddress
+
commitDialog u =
Dialog title form submit
where