Skip to content

Commit 540aa74

Browse files
v0d1chv0d1ch
committed
Add more queries to make mkTinyWallet work with CardanoChainConfig
Signed-off-by: Sasha Bogicevic <[email protected]>
1 parent 19ab5a3 commit 540aa74

File tree

5 files changed

+103
-45
lines changed

5 files changed

+103
-45
lines changed

‎hydra-node/src/Hydra/Chain/Blockfrost.hs‎

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,13 @@ import Cardano.Slotting.EpochInfo.API (EpochInfo, hoistEpochInfo)
88
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
99
import Hydra.Cardano.Api (
1010
EraHistory (..),
11+
PaymentCredential (PaymentCredentialByKey),
12+
StakeAddressReference (NoStakeAddress),
1113
SystemStart (..),
14+
makeShelleyAddress,
1215
runExcept,
1316
toLedgerUTxO,
17+
verificationKeyHash,
1418
)
1519
import Hydra.Chain.Blockfrost.Client (
1620
queryEraHistory,
@@ -20,7 +24,7 @@ import Hydra.Chain.Blockfrost.Client (
2024
queryUTxO,
2125
runBlockfrostM,
2226
toCardanoNetworkId,
23-
toCardanoPParams,
27+
queryProtocolParameters,
2428
)
2529
import Hydra.Chain.CardanoClient (QueryPoint (..))
2630
import Hydra.Chain.Direct.Handlers (
@@ -71,11 +75,12 @@ mkTinyWallet ::
7175
BlockfrostChainConfig ->
7276
IO (TinyWallet IO)
7377
mkTinyWallet tracer config = do
74-
keyPair@(_, sk) <- readKeyPair cardanoSigningKey
78+
keyPair@(vk, _) <- readKeyPair cardanoSigningKey
7579
prj <- Blockfrost.projectFromFile projectPath
7680
runBlockfrostM prj $ do
7781
Blockfrost.Genesis{_genesisSystemStart, _genesisNetworkMagic} <- queryGenesisParameters
7882
let networkId = toCardanoNetworkId _genesisNetworkMagic
83+
let address = makeShelleyAddress networkId (PaymentCredentialByKey $ verificationKeyHash vk) NoStakeAddress
7984
eraHistory <- queryEraHistory
8085
let queryEpochInfo = pure $ toEpochInfo eraHistory
8186
-- NOTE: we don't need to provide address here since it is derived from the
@@ -84,11 +89,11 @@ mkTinyWallet tracer config = do
8489
point <- case queryPoint of
8590
QueryAt point -> pure point
8691
QueryTip -> queryTip
87-
utxo <- queryUTxO sk networkId
92+
utxo <- queryUTxO [address]
8893
let walletUTxO = Ledger.unUTxO $ toLedgerUTxO utxo
8994
let systemStart = SystemStart $ posixSecondsToUTCTime _genesisSystemStart
9095
pure $ WalletInfoOnChain{walletUTxO, systemStart, tip = point}
91-
let querySomePParams = runBlockfrostM prj toCardanoPParams
96+
let querySomePParams = runBlockfrostM prj queryProtocolParameters
9297
liftIO $ newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo querySomePParams
9398
where
9499
BlockfrostChainConfig{projectPath, cardanoSigningKey} = config

‎hydra-node/src/Hydra/Chain/Blockfrost/Client.hs‎

Lines changed: 16 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ publishHydraScripts projectPath sk = do
101101
, _genesisSystemStart = systemStart'
102102
} <-
103103
queryGenesisParameters
104-
pparams <- toCardanoPParams
104+
pparams <- queryProtocolParameters
105105
let address = Blockfrost.Address (vkAddress networkMagic)
106106
let networkId = toCardanoNetworkId networkMagic
107107
let changeAddress = mkVkAddress networkId vk
@@ -185,13 +185,13 @@ toCardanoValue = foldMap convertAmount
185185

186186
-- ** Helpers
187187

188-
unwrapAddress :: AddressInEra -> Text
189-
unwrapAddress = \case
188+
addressToText :: AddressInEra -> Text
189+
addressToText = \case
190190
ShelleyAddressInEra addr -> serialiseToBech32 addr
191191
ByronAddressInEra{} -> error "Byron."
192192

193193
textAddrOf :: NetworkId -> VerificationKey PaymentKey -> Text
194-
textAddrOf networkId vk = unwrapAddress (mkVkAddress @Era networkId vk)
194+
textAddrOf networkId vk = addressToText (mkVkAddress @Era networkId vk)
195195

196196
toCardanoNetworkId :: Integer -> NetworkId
197197
toCardanoNetworkId = \case
@@ -229,8 +229,8 @@ data BlockfrostConversion
229229
, minFeeRefScriptCostPerByte :: NonNegativeInterval
230230
}
231231

232-
toCardanoPParams :: MonadIO m => BlockfrostClientT m (PParams LedgerEra)
233-
toCardanoPParams = do
232+
queryProtocolParameters :: MonadIO m => BlockfrostClientT m (PParams LedgerEra)
233+
queryProtocolParameters = do
234234
pparams <- Blockfrost.getLatestEpochProtocolParams
235235
minVersion <- liftIO $ mkVersion $ pparams ^. Blockfrost.protocolMinorVer
236236
let maxVersion = fromIntegral $ pparams ^. Blockfrost.protocolMajorVer
@@ -436,15 +436,17 @@ queryUTxOByTxIn networkId txIn = do
436436
TxIn (TxId txHash) _ = txIn
437437

438438
-- | Query the Blockfrost API for address UTxO and convert to cardano 'UTxO'.
439-
queryUTxO :: SigningKey PaymentKey -> NetworkId -> BlockfrostClientT IO UTxO
440-
queryUTxO sk networkId = do
441-
let address = Blockfrost.Address vkAddress
442-
utxo <- Blockfrost.getAddressUtxos address
443-
let cardanoAddress = mkVkAddress networkId vk
444-
pure $ toCardanoUTxO utxo cardanoAddress
439+
-- NOTE: We accept the address list here to be compatible with cardano-api but in
440+
-- fact this is a single address query always.
441+
queryUTxO :: [Address ShelleyAddr] -> BlockfrostClientT IO UTxO
442+
queryUTxO addresses = do
443+
let addresses' = (\cardanoAddr -> (Blockfrost.Address $ serialiseAddress cardanoAddr, cardanoAddr)) <$> addresses
444+
utxoWithAddresses <- mapM utxoForAddress addresses'
445+
pure $ foldMap ((<> mempty) . uncurry toCardanoUTxO) utxoWithAddresses
445446
where
446-
vk = getVerificationKey sk
447-
vkAddress = textAddrOf networkId vk
447+
utxoForAddress (addr, cardanoAddr) = do
448+
bfUTxO <- Blockfrost.getAddressUtxos addr
449+
pure (bfUTxO, anyAddressInShelleyBasedEra shelleyBasedEra $ toAddressAny cardanoAddr)
448450

449451
-- | Query the Blockfrost API for 'Genesis'
450452
queryGenesisParameters :: BlockfrostClientT IO Blockfrost.Genesis

‎hydra-node/src/Hydra/Chain/Direct.hs‎

Lines changed: 8 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -59,11 +59,7 @@ import Hydra.Chain.CardanoClient (
5959
QueryException (..),
6060
QueryPoint (..),
6161
queryCurrentEraExpr,
62-
queryEraHistory,
6362
queryInShelleyBasedEraExpr,
64-
querySystemStart,
65-
queryTip,
66-
queryUTxO,
6763
runQueryExpr,
6864
)
6965
import Hydra.Chain.Direct.Handlers (
@@ -133,29 +129,24 @@ loadChainContext config party = do
133129

134130
mkTinyWallet ::
135131
Tracer IO DirectChainLog ->
136-
DirectChainConfig ->
132+
CardanoChainConfig ->
137133
IO (TinyWallet IO)
138134
mkTinyWallet tracer config = do
139135
keyPair <- readKeyPair cardanoSigningKey
136+
networkId <- queryNetworkId chainBackend
140137
newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo querySomePParams
141138
where
142-
DirectChainConfig{networkId, nodeSocket, cardanoSigningKey} = config
143-
144-
queryEpochInfo = toEpochInfo <$> queryEraHistory networkId nodeSocket QueryTip
139+
CardanoChainConfig{chainBackend, cardanoSigningKey} = config
145140

146-
querySomePParams =
147-
runQueryExpr networkId nodeSocket QueryTip $ do
148-
AnyCardanoEra era <- queryCurrentEraExpr
149-
case era of
150-
ConwayEra{} -> queryInShelleyBasedEraExpr shelleyBasedEra QueryProtocolParameters
151-
_ -> liftIO . throwIO $ QueryEraMismatchException EraMismatch{ledgerEraName = show era, otherEraName = "Conway"}
141+
queryEpochInfo = toEpochInfo <$> queryEraHistory chainBackend QueryTip
152142

143+
querySomePParams = queryProtocolParameters chainBackend QueryTip
153144
queryWalletInfo queryPoint address = do
154145
point <- case queryPoint of
155146
QueryAt point -> pure point
156-
QueryTip -> queryTip networkId nodeSocket
157-
walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO networkId nodeSocket QueryTip [address]
158-
systemStart <- querySystemStart networkId nodeSocket QueryTip
147+
QueryTip -> queryTip chainBackend
148+
walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO chainBackend [address]
149+
systemStart <- querySystemStart chainBackend QueryTip
159150
pure $ WalletInfoOnChain{walletUTxO, systemStart, tip = point}
160151

161152
toEpochInfo :: EraHistory -> EpochInfo (Either Text)

‎hydra-node/src/Hydra/Node.hs‎

Lines changed: 66 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ module Hydra.Node where
1111
import Hydra.Prelude
1212

1313
import Blockfrost.Client qualified as Blockfrost
14+
import Cardano.Api.Consensus (EraMismatch (..))
1415
import Conduit (MonadUnliftIO, ZipSink (..), foldMapC, foldlC, mapC, mapM_C, runConduitRes, (.|))
1516
import Control.Concurrent.Class.MonadSTM (
1617
MonadLabelledSTM,
@@ -20,9 +21,29 @@ import Control.Concurrent.Class.MonadSTM (
2021
writeTVar,
2122
)
2223
import Control.Monad.Trans.Writer (execWriter, tell)
24+
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
2325
import Hydra.API.ClientInput (ClientInput)
2426
import Hydra.API.Server (Server, sendMessage)
25-
import Hydra.Cardano.Api (AsType (AsPaymentKey, AsSigningKey, AsVerificationKey), GenesisParameters, NetworkId, ShelleyEra, TxId, getVerificationKey)
27+
import Hydra.Cardano.Api (
28+
Address,
29+
AnyCardanoEra (AnyCardanoEra),
30+
AsType (AsPaymentKey, AsSigningKey, AsVerificationKey),
31+
CardanoEra (..),
32+
ChainPoint,
33+
EraHistory,
34+
GenesisParameters,
35+
LedgerEra,
36+
NetworkId,
37+
PParams,
38+
QueryInShelleyBasedEra (QueryProtocolParameters),
39+
ShelleyAddr,
40+
ShelleyEra,
41+
SystemStart (..),
42+
TxId,
43+
UTxO,
44+
getVerificationKey,
45+
shelleyBasedEra,
46+
)
2647
import Hydra.Chain (
2748
Chain (..),
2849
ChainEvent (..),
@@ -438,6 +459,11 @@ class BackendOps a where
438459
queryGenesisParameters :: (MonadIO m, MonadThrow m) => a -> m (GenesisParameters ShelleyEra)
439460
queryScriptRegistry :: (MonadIO m, MonadThrow m) => a -> [TxId] -> m ScriptRegistry
440461
queryNetworkId :: (MonadIO m, MonadThrow m) => a -> m NetworkId
462+
queryTip :: (MonadIO m, MonadThrow m) => a -> m ChainPoint
463+
queryUTxO :: (MonadIO m, MonadThrow m) => a -> [Address ShelleyAddr] -> m UTxO
464+
queryEraHistory :: (MonadIO m, MonadThrow m) => a -> CardanoClient.QueryPoint -> m EraHistory
465+
querySystemStart :: (MonadIO m, MonadThrow m) => a -> CardanoClient.QueryPoint -> m SystemStart
466+
queryProtocolParameters :: (MonadIO m, MonadThrow m) => a -> CardanoClient.QueryPoint -> m (PParams LedgerEra)
441467

442468
-- TODO: Perhaps use Reader monad for fetching configuration?
443469
instance BackendOps ChainBackend where
@@ -461,3 +487,42 @@ instance BackendOps ChainBackend where
461487
-- TODO: This calls to queryGenesisParameters again, but we only need the network magic
462488
Blockfrost.Genesis{_genesisNetworkMagic} <- Blockfrost.runBlockfrostM prj Blockfrost.queryGenesisParameters
463489
pure $ Blockfrost.toCardanoNetworkId _genesisNetworkMagic
490+
queryTip = \case
491+
DirectBackend{networkId, nodeSocket} ->
492+
liftIO $ CardanoClient.queryTip networkId nodeSocket
493+
BlockfrostBackend{projectPath} -> do
494+
prj <- liftIO $ Blockfrost.projectFromFile projectPath
495+
Blockfrost.runBlockfrostM prj Blockfrost.queryTip
496+
queryUTxO backend addresses =
497+
case backend of
498+
DirectBackend{networkId, nodeSocket} ->
499+
liftIO $ CardanoClient.queryUTxO networkId nodeSocket CardanoClient.QueryTip addresses
500+
BlockfrostBackend{projectPath} -> do
501+
prj <- liftIO $ Blockfrost.projectFromFile projectPath
502+
Blockfrost.runBlockfrostM prj $ Blockfrost.queryUTxO addresses
503+
queryEraHistory backend queryPoint =
504+
case backend of
505+
DirectBackend{networkId, nodeSocket} ->
506+
liftIO $ CardanoClient.queryEraHistory networkId nodeSocket queryPoint
507+
BlockfrostBackend{projectPath} -> do
508+
prj <- liftIO $ Blockfrost.projectFromFile projectPath
509+
Blockfrost.runBlockfrostM prj Blockfrost.queryEraHistory
510+
querySystemStart backend queryPoint =
511+
case backend of
512+
DirectBackend{networkId, nodeSocket} ->
513+
liftIO $ CardanoClient.querySystemStart networkId nodeSocket queryPoint
514+
BlockfrostBackend{projectPath} -> do
515+
prj <- liftIO $ Blockfrost.projectFromFile projectPath
516+
Blockfrost.Genesis{_genesisSystemStart} <- Blockfrost.runBlockfrostM prj Blockfrost.queryGenesisParameters
517+
pure $ SystemStart $ posixSecondsToUTCTime _genesisSystemStart
518+
queryProtocolParameters backend queryPoint =
519+
case backend of
520+
DirectBackend{networkId, nodeSocket} ->
521+
liftIO $ CardanoClient.runQueryExpr networkId nodeSocket queryPoint $ do
522+
AnyCardanoEra era <- CardanoClient.queryCurrentEraExpr
523+
case era of
524+
ConwayEra{} -> CardanoClient.queryInShelleyBasedEraExpr shelleyBasedEra QueryProtocolParameters
525+
_ -> liftIO . throwIO $ CardanoClient.QueryEraMismatchException EraMismatch{ledgerEraName = show era, otherEraName = "Conway"}
526+
BlockfrostBackend{projectPath} -> do
527+
prj <- liftIO $ Blockfrost.projectFromFile projectPath
528+
Blockfrost.runBlockfrostM prj Blockfrost.queryProtocolParameters

‎hydra-node/src/Hydra/Node/Run.hs‎

Lines changed: 4 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -126,16 +126,11 @@ run opts = do
126126
prepareChainComponent tracer Environment{party, otherParties} = \case
127127
Offline cfg ->
128128
pure $ withOfflineChain cfg party otherParties
129-
Direct DirectChainConfig{} -> undefined
130-
Cardano cardanoCfg@CardanoChainConfig{chainBackend} -> do
131-
let cfg = undefined
132-
ctx <- loadChainContext cardanoCfg party
129+
Direct DirectChainConfig{} -> error "Direct chain config is deprecated"
130+
Cardano cfg@CardanoChainConfig{} -> do
131+
ctx <- loadChainContext cfg party
133132
wallet <- mkTinyWallet (contramap DirectChain tracer) cfg
134-
case chainBackend of
135-
DirectBackend{} ->
136-
pure $ withDirectChain (contramap DirectChain tracer) cfg ctx wallet
137-
BlockfrostBackend{} ->
138-
pure undefined
133+
pure $ withDirectChain (contramap DirectChain tracer) cfg ctx wallet
139134

140135
RunOptions
141136
{ verbosity

0 commit comments

Comments
 (0)