5
5
module Main where
6
6
7
7
import Control.Monad (void )
8
- import Control.Monad.Class.MonadAsync
9
8
import Control.Tracer (Tracer (.. ), nullTracer , traceWith )
10
9
11
10
import Data.Act
@@ -15,7 +14,9 @@ import Data.Void (Void)
15
14
import Options.Applicative
16
15
import System.Random (newStdGen , split )
17
16
17
+ import Cardano.Crypto.DSIGN.Class qualified as DSIGN
18
18
import Cardano.KESAgent.Protocols.StandardCrypto (StandardCrypto )
19
+ import Cardano.Ledger.Hashes
19
20
20
21
import DMQ.Configuration
21
22
import DMQ.Configuration.CLIOptions (parseCLIOptions )
@@ -31,9 +32,11 @@ import DMQ.Tracer
31
32
32
33
import DMQ.Diffusion.PeerSelection (policy )
33
34
import DMQ.NodeToClient.LocalStateQueryClient
35
+ import DMQ.Protocol.SigSubmission.Validate
34
36
import Ouroboros.Network.Diffusion qualified as Diffusion
35
37
import Ouroboros.Network.PeerSelection.PeerSharing.Codec (decodeRemoteAddress ,
36
38
encodeRemoteAddress )
39
+ import Ouroboros.Network.SizeInBytes
37
40
import Ouroboros.Network.Snocket
38
41
import Ouroboros.Network.TxSubmission.Mempool.Simple qualified as Mempool
39
42
@@ -78,50 +81,62 @@ runDMQ commandLineConfig = do
78
81
diffusionTracers = dmqDiffusionTracers dmqConfig tracer
79
82
80
83
Diffusion. withIOManager \ iocp -> do
81
- let localSnocket' = localSnocket iocp
84
+ let localSnocket' = localSnocket iocp
85
+ mkStakePoolMonitor = connectToCardanoNode tracer localSnocket' snocketPath
82
86
83
- withNodeKernel @ StandardCrypto psRng $ \ nodeKernel -> do
87
+ withNodeKernel @ StandardCrypto psRng mkStakePoolMonitor \ nodeKernel -> do
84
88
dmqDiffusionConfiguration <- mkDiffusionConfiguration dmqConfig nt
85
89
86
- let stakePoolMonitor = connectToCardanoNode tracer localSnocket' snocketPath nodeKernel
87
-
88
- withAsync stakePoolMonitor \ aid -> do
89
- link aid
90
- let dmqNtNApps =
91
- ntnApps tracer
92
- dmqConfig
93
- nodeKernel
94
- (dmqCodecs
95
- -- TODO: `maxBound :: Cardano.Network.NodeToNode.NodeToNodeVersion`
96
- -- is unsafe here!
97
- (encodeRemoteAddress maxBound )
98
- (decodeRemoteAddress maxBound ))
99
- dmqLimitsAndTimeouts
100
- defaultSigDecisionPolicy
101
- dmqNtCApps =
102
- let sigSize _ = 0 -- TODO
103
- maxMsgs = 1000 -- TODO: make this negotiated in the handshake?
104
- mempoolReader = Mempool. getReader sigId sigSize (mempool nodeKernel)
105
- mempoolWriter = Mempool. getWriter sigId (const () ) (\ _ _ -> pure True ) (mempool nodeKernel)
106
- in NtC. ntcApps mempoolReader mempoolWriter maxMsgs
107
- (NtC. dmqCodecs encodeReject decodeReject)
108
- dmqDiffusionArguments =
109
- diffusionArguments (if handshakeTracer
110
- then WithEventType " Handshake" >$< tracer
111
- else nullTracer)
112
- (if localHandshakeTracer
113
- then WithEventType " Handshake" >$< tracer
114
- else nullTracer)
115
- dmqDiffusionApplications =
116
- diffusionApplications nodeKernel
117
- dmqConfig
118
- dmqDiffusionConfiguration
119
- dmqLimitsAndTimeouts
120
- dmqNtNApps
121
- dmqNtCApps
122
- (policy policyRng)
123
-
124
- Diffusion. run dmqDiffusionArguments
125
- diffusionTracers
126
- dmqDiffusionConfiguration
127
- dmqDiffusionApplications
90
+ let sigSize :: Sig StandardCrypto -> SizeInBytes
91
+ sigSize _ = 0 -- TODO
92
+ mempoolReader = Mempool. getReader sigId sigSize (mempool nodeKernel)
93
+ dmqNtNApps =
94
+ let ntnMempoolWriter = Mempool. writerAdapter $
95
+ Mempool. getWriter sigId
96
+ (poolValidationCtx $ stakePools nodeKernel)
97
+ (validateSig FailDefault (KeyHash . DSIGN. hashVerKeyDSIGN))
98
+ SigDuplicate
99
+ (mempool nodeKernel)
100
+ in ntnApps tracer
101
+ dmqConfig
102
+ mempoolReader
103
+ ntnMempoolWriter
104
+ sigSize
105
+ nodeKernel
106
+ (dmqCodecs
107
+ -- TODO: `maxBound :: Cardano.Network.NodeToNode.NodeToNodeVersion`
108
+ -- is unsafe here!
109
+ (encodeRemoteAddress maxBound )
110
+ (decodeRemoteAddress maxBound ))
111
+ dmqLimitsAndTimeouts
112
+ defaultSigDecisionPolicy
113
+ dmqNtCApps =
114
+ let maxMsgs = 1000 -- TODO: make this negotiated in the handshake?
115
+ ntcMempoolWriter =
116
+ Mempool. getWriter sigId
117
+ (poolValidationCtx $ stakePools nodeKernel)
118
+ (validateSig FailSoft (KeyHash . DSIGN. hashVerKeyDSIGN))
119
+ SigDuplicate
120
+ (mempool nodeKernel)
121
+ in NtC. ntcApps mempoolReader ntcMempoolWriter maxMsgs
122
+ (NtC. dmqCodecs encodeReject decodeReject)
123
+ dmqDiffusionArguments =
124
+ diffusionArguments (if handshakeTracer
125
+ then WithEventType " Handshake" >$< tracer
126
+ else nullTracer)
127
+ (if localHandshakeTracer
128
+ then WithEventType " Handshake" >$< tracer
129
+ else nullTracer)
130
+ dmqDiffusionApplications =
131
+ diffusionApplications nodeKernel
132
+ dmqConfig
133
+ dmqDiffusionConfiguration
134
+ dmqLimitsAndTimeouts
135
+ dmqNtNApps
136
+ dmqNtCApps
137
+ (policy policyRng)
138
+
139
+ Diffusion. run dmqDiffusionArguments
140
+ diffusionTracers
141
+ dmqDiffusionConfiguration
142
+ dmqDiffusionApplications
0 commit comments