Skip to content

Commit 3a5be18

Browse files
v0d1chv0d1ch
committed
Abstract common information into Hydra.Chain.Cardano
Signed-off-by: Sasha Bogicevic <[email protected]>
1 parent c2fe10d commit 3a5be18

File tree

10 files changed

+208
-96
lines changed

10 files changed

+208
-96
lines changed

‎hydra-cluster/test/Test/BlockfrostChainSpec.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ import Hydra.Chain (
2222
import Hydra.Chain.Blockfrost (BlockfrostBackend (..), withBlockfrostChain)
2323
import Hydra.Chain.Blockfrost.Client qualified as Blockfrost
2424
import Hydra.Chain.Direct (loadChainContext, mkTinyWallet)
25-
import Hydra.Chain.Direct.Handlers (DirectChainLog)
25+
import Hydra.Chain.Direct.Handlers (CardanoChainLog)
2626
import Hydra.Chain.Direct.State (initialChainState)
2727
import Hydra.Chain.ScriptRegistry (publishHydraScripts)
2828
import Hydra.Cluster.Faucet (
@@ -150,7 +150,7 @@ spec = around (showLogsOnFailure "BlockfrostChainSpec") $ do
150150
-- | Wrapper around 'withBlockfrostChain' that threads a 'ChainStateType tx' through
151151
-- 'postTx' and 'waitCallback' calls.
152152
withBlockfrostChainTest ::
153-
Tracer IO DirectChainLog ->
153+
Tracer IO CardanoChainLog ->
154154
ChainConfig ->
155155
Party ->
156156
(CardanoChainTest Tx IO -> IO a) ->

‎hydra-cluster/test/Test/DirectChainSpec.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ import Hydra.Chain (
4949
)
5050
import Hydra.Chain.Blockfrost.Client qualified as Blockfrost
5151
import Hydra.Chain.Direct (DirectBackend (..), IntersectionNotFoundException (..), loadChainContext, mkTinyWallet, withDirectChain)
52-
import Hydra.Chain.Direct.Handlers (DirectChainLog)
52+
import Hydra.Chain.Direct.Handlers (CardanoChainLog)
5353
import Hydra.Chain.Direct.State (initialChainState)
5454
import Hydra.Chain.ScriptRegistry (queryScriptRegistry)
5555
import Hydra.Cluster.Faucet (
@@ -526,8 +526,8 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
526526

527527
data DirectChainTestLog
528528
= FromNode NodeLog
529-
| FromDirectChain Text DirectChainLog
530-
| FromBlockfrostChain Text DirectChainLog
529+
| FromDirectChain Text CardanoChainLog
530+
| FromBlockfrostChain Text CardanoChainLog
531531
| FromFaucet FaucetLog
532532
deriving stock (Show, Generic)
533533
deriving anyclass (ToJSON)
@@ -541,7 +541,7 @@ data CardanoChainTest tx m = CardanoChainTest
541541
-- | Wrapper around 'withDirectChain' that threads a 'ChainStateType tx' through
542542
-- 'postTx' and 'waitCallback' calls.
543543
withDirectChainTest ::
544-
Tracer IO DirectChainLog ->
544+
Tracer IO CardanoChainLog ->
545545
ChainConfig ->
546546
Party ->
547547
(CardanoChainTest Tx IO -> IO a) ->

‎hydra-node/hydra-node.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ library
5858
Hydra.Chain.Backend
5959
Hydra.Chain.Blockfrost
6060
Hydra.Chain.Blockfrost.Client
61+
Hydra.Chain.Cardano
6162
Hydra.Chain.CardanoClient
6263
Hydra.Chain.Direct
6364
Hydra.Chain.Direct.Handlers

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

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,8 @@ import Hydra.Chain (ChainComponent, ChainStateHistory, PostTxError (..), current
2323
import Hydra.Chain.Backend (ChainBackend (..))
2424
import Hydra.Chain.Blockfrost.Client qualified as Blockfrost
2525
import Hydra.Chain.Direct.Handlers (
26+
CardanoChainLog (..),
2627
ChainSyncHandler (..),
27-
DirectChainLog (..),
2828
chainSyncHandler,
2929
mkChain,
3030
newLocalChainState,
@@ -96,7 +96,7 @@ instance ChainBackend BlockfrostBackend where
9696

9797
withBlockfrostChain ::
9898
BlockfrostBackend ->
99-
Tracer IO DirectChainLog ->
99+
Tracer IO CardanoChainLog ->
100100
CardanoChainConfig ->
101101
ChainContext ->
102102
TinyWallet IO ->
@@ -163,7 +163,7 @@ instance Exception BlockfrostConnectException
163163

164164
blockfrostChain ::
165165
(MonadIO m, MonadCatch m, MonadAsync m, MonadDelay m) =>
166-
Tracer m DirectChainLog ->
166+
Tracer m CardanoChainLog ->
167167
TQueue m (Tx, TMVar m (Maybe (PostTxError Tx))) ->
168168
Blockfrost.Project ->
169169
ChainPoint ->
@@ -178,7 +178,7 @@ blockfrostChain tracer queue prj chainPoint handler wallet = do
178178

179179
blockfrostChainFollow ::
180180
(MonadIO m, MonadCatch m, MonadSTM m, MonadDelay m) =>
181-
Tracer m DirectChainLog ->
181+
Tracer m CardanoChainLog ->
182182
Blockfrost.Project ->
183183
ChainPoint ->
184184
ChainSyncHandler m ->
@@ -217,7 +217,7 @@ blockfrostChainFollow tracer prj chainPoint handler wallet = do
217217

218218
rollForward ::
219219
(MonadIO m, MonadThrow m) =>
220-
Tracer m DirectChainLog ->
220+
Tracer m CardanoChainLog ->
221221
Blockfrost.Project ->
222222
ChainSyncHandler m ->
223223
TinyWallet m ->
@@ -268,7 +268,7 @@ blockfrostSubmissionClient ::
268268
forall m.
269269
(MonadIO m, MonadDelay m, MonadSTM m) =>
270270
Blockfrost.Project ->
271-
Tracer m DirectChainLog ->
271+
Tracer m CardanoChainLog ->
272272
TQueue m (Tx, TMVar m (Maybe (PostTxError Tx))) ->
273273
m ()
274274
blockfrostSubmissionClient prj tracer queue = bfClient

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

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
{-# LANGUAGE DuplicateRecordFields #-}
2+
3+
module Hydra.Chain.Cardano where
4+
5+
import Hydra.Prelude
6+
7+
import Cardano.Api.Consensus (EraMismatch (..))
8+
import Cardano.Ledger.Shelley.API qualified as Ledger
9+
import Cardano.Ledger.Slot (EpochInfo)
10+
import Cardano.Slotting.EpochInfo (hoistEpochInfo)
11+
import Control.Concurrent.Class.MonadSTM (
12+
newEmptyTMVar,
13+
newTQueueIO,
14+
putTMVar,
15+
readTQueue,
16+
takeTMVar,
17+
writeTQueue,
18+
)
19+
import Control.Exception (IOException)
20+
import Control.Monad.Trans.Except (runExcept)
21+
import Hydra.Cardano.Api (
22+
AnyCardanoEra (..),
23+
BlockInMode (..),
24+
CardanoEra (..),
25+
ChainPoint (..),
26+
ChainTip,
27+
ConsensusModeParams (..),
28+
EpochSlots (..),
29+
EraHistory (EraHistory),
30+
IsShelleyBasedEra (..),
31+
LocalChainSyncClient (..),
32+
LocalNodeClientProtocols (..),
33+
LocalNodeConnectInfo (..),
34+
NetworkId,
35+
QueryInShelleyBasedEra (..),
36+
SocketPath,
37+
Tx,
38+
TxInMode (..),
39+
TxValidationErrorInCardanoMode,
40+
chainTipToChainPoint,
41+
connectToLocalNode,
42+
getBlockHeader,
43+
getBlockTxs,
44+
getTxBody,
45+
getTxId,
46+
toLedgerUTxO,
47+
)
48+
import Hydra.Chain (
49+
ChainComponent,
50+
ChainStateHistory,
51+
PostTxError (FailedToPostTx, failureReason),
52+
currentState,
53+
)
54+
import Hydra.Chain.Backend (ChainBackend (..))
55+
import Hydra.Chain.Blockfrost (BlockfrostBackend (..), withBlockfrostChain)
56+
import Hydra.Chain.CardanoClient (
57+
QueryPoint (..),
58+
)
59+
import Hydra.Chain.CardanoClient qualified as CardanoClient
60+
import Hydra.Chain.Direct (DirectBackend (..), withDirectChain)
61+
import Hydra.Chain.Direct.Handlers (
62+
CardanoChainLog (..),
63+
ChainSyncHandler,
64+
chainSyncHandler,
65+
mkChain,
66+
newLocalChainState,
67+
onRollBackward,
68+
onRollForward,
69+
)
70+
import Hydra.Chain.Direct.State (
71+
ChainContext (..),
72+
ChainStateAt (..),
73+
)
74+
import Hydra.Chain.Direct.TimeHandle (queryTimeHandle)
75+
import Hydra.Chain.Direct.Wallet (
76+
TinyWallet (..),
77+
WalletInfoOnChain (..),
78+
newTinyWallet,
79+
)
80+
import Hydra.Chain.ScriptRegistry qualified as ScriptRegistry
81+
import Hydra.Logging (Tracer, traceWith)
82+
import Hydra.Logging.Messages (HydraLog (..))
83+
import Hydra.Node.Util (readKeyPair)
84+
import Hydra.Options (CardanoChainConfig (..), ChainBackendOptions (..), DirectOptions (..))
85+
import Hydra.Tx (Party)
86+
import Ouroboros.Consensus.HardFork.History qualified as Consensus
87+
import Ouroboros.Network.Magic (NetworkMagic (..))
88+
import Ouroboros.Network.Protocol.ChainSync.Client (
89+
ChainSyncClient (..),
90+
ClientStIdle (..),
91+
ClientStIntersect (..),
92+
ClientStNext (..),
93+
)
94+
import Ouroboros.Network.Protocol.LocalTxSubmission.Client (
95+
LocalTxClientStIdle (..),
96+
LocalTxSubmissionClient (..),
97+
SubmitResult (..),
98+
)
99+
import Text.Printf (printf)
100+
101+
withCardanoChain ::
102+
forall a.
103+
Tracer IO CardanoChainLog ->
104+
CardanoChainConfig ->
105+
Party ->
106+
-- | Chain state loaded from persistence.
107+
ChainStateHistory Tx ->
108+
ChainComponent Tx IO a
109+
withCardanoChain tracer cfg party chainStateHistory callback action =
110+
case chainBackendOptions of
111+
Direct directOptions -> do
112+
let directBackend = DirectBackend directOptions
113+
wallet <- mkTinyWallet directBackend tracer cfg
114+
ctx <- loadChainContext directBackend cfg party
115+
withDirectChain directBackend tracer cfg ctx wallet chainStateHistory callback action
116+
Blockfrost blockfrostOptions -> do
117+
let blockfrostBackend = BlockfrostBackend blockfrostOptions
118+
wallet <- mkTinyWallet blockfrostBackend tracer cfg
119+
ctx <- loadChainContext blockfrostBackend cfg party
120+
withBlockfrostChain blockfrostBackend tracer cfg ctx wallet chainStateHistory callback action
121+
where
122+
CardanoChainConfig{chainBackendOptions} = cfg
123+
124+
-- | Build the 'ChainContext' from a 'ChainConfig' and additional information.
125+
loadChainContext ::
126+
forall backend.
127+
ChainBackend backend =>
128+
backend ->
129+
CardanoChainConfig ->
130+
-- | Hydra party of our hydra node.
131+
Party ->
132+
-- | The current running era we can use to query the node
133+
IO ChainContext
134+
loadChainContext backend config party = do
135+
(vk, _) <- readKeyPair cardanoSigningKey
136+
scriptRegistry <- queryScriptRegistry backend hydraScriptsTxId
137+
networkId <- queryNetworkId backend
138+
pure $
139+
ChainContext
140+
{ networkId
141+
, ownVerificationKey = vk
142+
, ownParty = party
143+
, scriptRegistry
144+
}
145+
where
146+
CardanoChainConfig
147+
{ hydraScriptsTxId
148+
, cardanoSigningKey
149+
} = config
150+
151+
mkTinyWallet ::
152+
forall backend.
153+
ChainBackend backend =>
154+
backend ->
155+
Tracer IO CardanoChainLog ->
156+
CardanoChainConfig ->
157+
IO (TinyWallet IO)
158+
mkTinyWallet backend tracer config = do
159+
keyPair <- readKeyPair cardanoSigningKey
160+
networkId <- queryNetworkId backend
161+
newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo querySomePParams
162+
where
163+
CardanoChainConfig{cardanoSigningKey} = config
164+
165+
queryEpochInfo = toEpochInfo <$> queryEraHistory backend QueryTip
166+
167+
querySomePParams = queryProtocolParameters backend QueryTip
168+
queryWalletInfo queryPoint address = do
169+
point <- case queryPoint of
170+
QueryAt point -> pure point
171+
QueryTip -> queryTip backend
172+
walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO backend [address]
173+
systemStart <- querySystemStart backend QueryTip
174+
pure $ WalletInfoOnChain{walletUTxO, systemStart, tip = point}
175+
176+
toEpochInfo :: EraHistory -> EpochInfo (Either Text)
177+
toEpochInfo (EraHistory interpreter) =
178+
hoistEpochInfo (first show . runExcept) $
179+
Consensus.interpreterToEpochInfo interpreter

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

Lines changed: 3 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -62,8 +62,8 @@ import Hydra.Chain.CardanoClient (
6262
)
6363
import Hydra.Chain.CardanoClient qualified as CardanoClient
6464
import Hydra.Chain.Direct.Handlers (
65+
CardanoChainLog (..),
6566
ChainSyncHandler,
66-
DirectChainLog (..),
6767
chainSyncHandler,
6868
mkChain,
6969
newLocalChainState,
@@ -141,66 +141,9 @@ instance ChainBackend DirectBackend where
141141
awaitTransaction (DirectBackend DirectOptions{networkId, nodeSocket}) tx =
142142
liftIO $ CardanoClient.awaitTransaction networkId nodeSocket tx
143143

144-
-- | Build the 'ChainContext' from a 'ChainConfig' and additional information.
145-
loadChainContext ::
146-
forall backend.
147-
ChainBackend backend =>
148-
backend ->
149-
CardanoChainConfig ->
150-
-- | Hydra party of our hydra node.
151-
Party ->
152-
-- | The current running era we can use to query the node
153-
IO ChainContext
154-
loadChainContext backend config party = do
155-
(vk, _) <- readKeyPair cardanoSigningKey
156-
scriptRegistry <- queryScriptRegistry backend hydraScriptsTxId
157-
networkId <- queryNetworkId backend
158-
pure $
159-
ChainContext
160-
{ networkId
161-
, ownVerificationKey = vk
162-
, ownParty = party
163-
, scriptRegistry
164-
}
165-
where
166-
CardanoChainConfig
167-
{ hydraScriptsTxId
168-
, cardanoSigningKey
169-
} = config
170-
171-
mkTinyWallet ::
172-
forall backend.
173-
ChainBackend backend =>
174-
backend ->
175-
Tracer IO DirectChainLog ->
176-
CardanoChainConfig ->
177-
IO (TinyWallet IO)
178-
mkTinyWallet backend tracer config = do
179-
keyPair <- readKeyPair cardanoSigningKey
180-
networkId <- queryNetworkId backend
181-
newTinyWallet (contramap Wallet tracer) networkId keyPair queryWalletInfo queryEpochInfo querySomePParams
182-
where
183-
CardanoChainConfig{cardanoSigningKey} = config
184-
185-
queryEpochInfo = toEpochInfo <$> queryEraHistory backend QueryTip
186-
187-
querySomePParams = queryProtocolParameters backend QueryTip
188-
queryWalletInfo queryPoint address = do
189-
point <- case queryPoint of
190-
QueryAt point -> pure point
191-
QueryTip -> queryTip backend
192-
walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO backend [address]
193-
systemStart <- querySystemStart backend QueryTip
194-
pure $ WalletInfoOnChain{walletUTxO, systemStart, tip = point}
195-
196-
toEpochInfo :: EraHistory -> EpochInfo (Either Text)
197-
toEpochInfo (EraHistory interpreter) =
198-
hoistEpochInfo (first show . runExcept) $
199-
Consensus.interpreterToEpochInfo interpreter
200-
201144
withDirectChain ::
202145
DirectBackend ->
203-
Tracer IO DirectChainLog ->
146+
Tracer IO CardanoChainLog ->
204147
CardanoChainConfig ->
205148
ChainContext ->
206149
TinyWallet IO ->
@@ -381,7 +324,7 @@ chainSyncClient handler wallet startingPoint =
381324
txSubmissionClient ::
382325
forall m.
383326
(MonadSTM m, MonadDelay m) =>
384-
Tracer m DirectChainLog ->
327+
Tracer m CardanoChainLog ->
385328
TQueue m (Tx, TMVar m (Maybe (PostTxError Tx))) ->
386329
LocalTxSubmissionClient TxInMode TxValidationErrorInCardanoMode m ()
387330
txSubmissionClient tracer queue =

0 commit comments

Comments
 (0)