Skip to content

Commit bf98713

Browse files
cootcoot
committed
dmq: using OCert from kes-agent library
We need to use since in the initial version of `dmq-node` because of its own CBOR encoding. It is not cryptographically checked.
1 parent b93a33a commit bf98713

File tree

14 files changed

+724
-182
lines changed

14 files changed

+724
-182
lines changed

‎cabal.project‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,3 +59,13 @@ package acts
5959
flags: -finitary
6060

6161
allow-newer: quickcheck-instances:QuickCheck
62+
63+
-- kes-agent is not yet in CHaP, so we pull it from its GitHub repo
64+
source-repository-package
65+
type: git
66+
location: https://github.com/input-output/kes-agent
67+
tag: 2a9ac9c017aa33c4f64b052c2d91babbbed842d3
68+
--sha256: sha256-ztllx/uDQqPeV8lcmapJTB9y5bjb9HEHYK+4+x5JxiI=
69+
subdir: kes-agent
70+
71+
allow-newer: kes-agent:typed-protocols

‎decentralized-message-queue/app/Main.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE ScopedTypeVariables #-}
2+
{-# LANGUAGE TypeApplications #-}
23

34
module Main where
45

@@ -12,6 +13,8 @@ import Data.Void (Void)
1213
import Options.Applicative
1314
import System.Random (newStdGen, split)
1415

16+
import Cardano.KESAgent.Protocols.StandardCrypto (StandardCrypto)
17+
1518
import DMQ.Configuration
1619
import DMQ.Configuration.CLIOptions (parseCLIOptions)
1720
import DMQ.Configuration.Topology (readTopologyFileOrError)
@@ -53,7 +56,6 @@ runDMQ commandLineConfig = do
5356
} = config' <> commandLineConfig
5457
`act`
5558
defaultConfiguration
56-
5759
let tracer :: ToJSON ev => Tracer IO (WithEventType ev)
5860
tracer = dmqTracer prettyLog
5961

@@ -64,7 +66,7 @@ runDMQ commandLineConfig = do
6466
stdGen <- newStdGen
6567
let (psRng, policyRng) = split stdGen
6668

67-
withNodeKernel psRng $ \nodeKernel -> do
69+
withNodeKernel @StandardCrypto psRng $ \nodeKernel -> do
6870
dmqDiffusionConfiguration <- mkDiffusionConfiguration dmqConfig nt
6971

7072
let dmqNtNApps =

‎decentralized-message-queue/decentralized-message-queue.cabal‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,8 @@ library
5555
aeson-pretty,
5656
base >=4.14 && <4.22,
5757
bytestring >=0.10 && <0.13,
58+
cardano-binary,
59+
cardano-crypto-class,
5860
cborg >=0.2.1 && <0.3,
5961
containers >=0.5 && <0.8,
6062
contra-tracer >=0.1 && <0.3,
@@ -66,6 +68,7 @@ library
6668
hashable >=1.0 && <1.6,
6769
io-classes:{io-classes, si-timers, strict-mvar, strict-stm} ^>=1.8.0.1,
6870
iproute ^>=1.7.15,
71+
kes-agent ^>=0.1,
6972
network ^>=3.2.7,
7073
network-mux ^>=0.9,
7174
optparse-applicative ^>=0.18,
@@ -95,6 +98,7 @@ executable dmq-node
9598
base,
9699
contra-tracer >=0.1 && <0.3,
97100
decentralized-message-queue,
101+
kes-agent,
98102
optparse-applicative,
99103
ouroboros-network,
100104
ouroboros-network-api,
@@ -119,9 +123,13 @@ test-suite dmq-test
119123
build-depends:
120124
QuickCheck,
121125
base >=4.14 && <4.22,
122-
cborg,
126+
bytestring,
123127
cardano-binary,
128+
cardano-crypto-class,
129+
cardano-crypto-tests,
130+
cborg,
124131
decentralized-message-queue,
132+
kes-agent,
125133
ouroboros-network-api,
126134
ouroboros-network-protocols:testlib,
127135
quickcheck-instances,

‎decentralized-message-queue/src/DMQ/Diffusion/Applications.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,10 +22,10 @@ import Ouroboros.Network.RethrowPolicy (ioErrorRethrowPolicy,
2222
muxErrorRethrowPolicy)
2323

2424
diffusionApplications
25-
:: NodeKernel ntnAddr m
25+
:: NodeKernel crypto ntnAddr m
2626
-> Configuration
2727
-> Diffusion.Configuration NoExtraFlags m ntnFd ntnAddr ntcFd ntcAddr
28-
-> NTN.LimitsAndTimeouts ntnAddr
28+
-> NTN.LimitsAndTimeouts crypto ntnAddr
2929
-> NTN.Apps ntnAddr m a ()
3030
-> PeerSelectionPolicy ntnAddr m
3131
-> Diffusion.Applications ntnAddr NodeToNodeVersion NodeToNodeVersionData

‎decentralized-message-queue/src/DMQ/Diffusion/NodeKernel.hs‎

Lines changed: 13 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ import Ouroboros.Network.TxSubmission.Mempool.Simple qualified as Mempool
3636
import DMQ.Protocol.SigSubmission.Type (Sig (sigExpiresAt), SigId)
3737

3838

39-
data NodeKernel ntnAddr m =
39+
data NodeKernel crypto ntnAddr m =
4040
NodeKernel {
4141
-- | The fetch client registry, used for the keep alive clients.
4242
fetchClientRegistry :: FetchClientRegistry (ConnectionId ntnAddr) () () m
@@ -45,18 +45,18 @@ data NodeKernel ntnAddr m =
4545
-- the PeerSharing protocol
4646
, peerSharingRegistry :: PeerSharingRegistry ntnAddr m
4747
, peerSharingAPI :: PeerSharingAPI ntnAddr StdGen m
48-
, mempool :: Mempool m Sig
49-
, sigChannelVar :: TxChannelsVar m ntnAddr SigId Sig
48+
, mempool :: Mempool m (Sig crypto)
49+
, sigChannelVar :: TxChannelsVar m ntnAddr SigId (Sig crypto)
5050
, sigMempoolSem :: TxMempoolSem m
51-
, sigSharedTxStateVar :: SharedTxStateVar m ntnAddr SigId Sig
51+
, sigSharedTxStateVar :: SharedTxStateVar m ntnAddr SigId (Sig crypto)
5252
}
5353

5454
newNodeKernel :: ( MonadLabelledSTM m
5555
, MonadMVar m
5656
, Ord ntnAddr
5757
)
5858
=> StdGen
59-
-> m (NodeKernel ntnAddr m)
59+
-> m (NodeKernel crypto ntnAddr m)
6060
newNodeKernel rng = do
6161
publicPeerSelectionStateVar <- makePublicPeerSelectionStateVar
6262

@@ -86,7 +86,8 @@ newNodeKernel rng = do
8686
}
8787

8888

89-
withNodeKernel :: ( MonadAsync m
89+
withNodeKernel :: forall crypto ntnAddr m a.
90+
( MonadAsync m
9091
, MonadFork m
9192
, MonadDelay m
9293
, MonadLabelledSTM m
@@ -96,7 +97,7 @@ withNodeKernel :: ( MonadAsync m
9697
, Ord ntnAddr
9798
)
9899
=> StdGen
99-
-> (NodeKernel ntnAddr m -> m a)
100+
-> (NodeKernel crypto ntnAddr m -> m a)
100101
-- ^ as soon as the callback exits the `mempoolWorker` will be
101102
-- killed
102103
-> m a
@@ -107,19 +108,20 @@ withNodeKernel rng k = do
107108
>> k nodeKernel
108109

109110

110-
mempoolWorker :: ( MonadDelay m
111+
mempoolWorker :: forall crypto m.
112+
( MonadDelay m
111113
, MonadSTM m
112114
, MonadTime m
113115
)
114-
=> Mempool m Sig
116+
=> Mempool m (Sig crypto)
115117
-> m Void
116118
mempoolWorker (Mempool v) = loop
117119
where
118120
loop = do
119121
now <- getCurrentPOSIXTime
120122
rt <- atomically $ do
121-
(sigs :: Seq.Seq Sig) <- readTVar v
122-
let sigs' :: Seq.Seq Sig
123+
(sigs :: Seq.Seq (Sig crypto)) <- readTVar v
124+
let sigs' :: Seq.Seq (Sig crypto)
123125
(resumeTime, sigs') =
124126
foldr (\a (rt, as) -> if sigExpiresAt a <= now
125127
then (rt, as)

‎decentralized-message-queue/src/DMQ/NodeToNode.hs‎

Lines changed: 36 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@ import Data.Aeson qualified as Aeson
4343
import Data.ByteString.Lazy qualified as BL
4444
import Data.Functor.Contravariant ((>$<))
4545
import Data.Hashable (Hashable)
46+
import Data.Typeable
4647
import Data.Void (Void)
4748
import System.Random (mkStdGen)
4849

@@ -51,6 +52,8 @@ import Network.Mux.Types (Mode (..))
5152
import Network.Mux.Types qualified as Mx
5253
import Network.TypedProtocol.Codec (AnnotatedCodec, Codec)
5354

55+
import Cardano.KESAgent.KES.Crypto (Crypto (..))
56+
5457
import DMQ.Configuration (Configuration, Configuration' (..), I (..))
5558
import DMQ.Diffusion.NodeKernel (NodeKernel (..))
5659
import DMQ.NodeToNode.Version
@@ -142,8 +145,10 @@ data Apps addr m a b =
142145
}
143146

144147
ntnApps
145-
:: forall m addr .
146-
( Alternative (STM m)
148+
:: forall crypto m addr .
149+
( Crypto crypto
150+
, Typeable crypto
151+
, Alternative (STM m)
147152
, MonadAsync m
148153
, MonadDelay m
149154
, MonadFork m
@@ -158,9 +163,9 @@ ntnApps
158163
)
159164
=> (forall ev. Aeson.ToJSON ev => Tracer m (WithEventType ev))
160165
-> Configuration
161-
-> NodeKernel addr m
162-
-> Codecs addr m
163-
-> LimitsAndTimeouts addr
166+
-> NodeKernel crypto addr m
167+
-> Codecs crypto addr m
168+
-> LimitsAndTimeouts crypto addr
164169
-> TxDecisionPolicy
165170
-> Apps addr m () ()
166171
ntnApps
@@ -206,18 +211,19 @@ ntnApps
206211
, aPeerSharingServer
207212
}
208213
where
209-
sigSize :: Sig -> SizeInBytes
214+
sigSize :: Sig crypto -> SizeInBytes
210215
sigSize _ = 0 -- TODO
211216

212217
mempoolReader = Mempool.getReader sigId sigSize mempool
213-
mempoolWriter = Mempool.getWriter sigId sigValid mempool
214-
where
215-
-- Note: invalid signatures are just omitted from the mempool. For DMQ
216-
-- we need to validate signatures when we received them, and shutdown
217-
-- connection if we receive one, rather than validate them in the
218-
-- mempool.
219-
sigValid :: Sig -> Bool
220-
sigValid _ = True
218+
-- TODO: invalid signatures are just omitted from the mempool. For DMQ
219+
-- we need to validate signatures when we received them, and shutdown
220+
-- connection if we receive one, rather than validate them in the
221+
-- mempool.
222+
mempoolWriter = Mempool.getWriter sigId
223+
(pure ())
224+
(\_ _ -> Right () :: Either Void ())
225+
(\_ -> True)
226+
mempool
221227

222228
aSigSubmissionClient
223229
:: NodeToNodeVersion
@@ -262,7 +268,7 @@ ntnApps
262268
mempoolWriter
263269
sigSize
264270
(remoteAddress connId)
265-
$ \(peerSigAPI :: PeerTxAPI m SigId Sig) ->
271+
$ \(peerSigAPI :: PeerTxAPI m SigId (Sig crypto)) ->
266272
runPipelinedAnnotatedPeerWithLimits
267273
(if sigSubmissionServerTracer
268274
then WithEventType "SigSubmissionServer" . Mx.WithBearer connId >$< tracer
@@ -273,7 +279,7 @@ ntnApps
273279
channel
274280
$ txSubmissionServerPeerPipelined
275281
$ txSubmissionInboundV2
276-
nullTracer
282+
nullTracer -- TODO
277283
_SIG_SUBMISSION_INIT_DELAY
278284
mempoolWriter
279285
peerSigAPI
@@ -405,7 +411,7 @@ peerSharingMiniProtocolNum :: Mx.MiniProtocolNum
405411
peerSharingMiniProtocolNum = Mx.MiniProtocolNum 13
406412

407413
nodeToNodeProtocols
408-
:: LimitsAndTimeouts addr
414+
:: LimitsAndTimeouts crypto addr
409415
-> Protocols appType initiatorCtx responderCtx bytes m a b
410416
-> NodeToNodeVersion
411417
-- ^ negotiated version number
@@ -463,7 +469,7 @@ nodeToNodeProtocols LimitsAndTimeouts {
463469
)
464470

465471
initiatorProtocols
466-
:: LimitsAndTimeouts addr
472+
:: LimitsAndTimeouts crypto addr
467473
-> Apps addr m a b
468474
-> NodeToNodeVersion
469475
-> NodeToNodeVersionData
@@ -488,7 +494,7 @@ initiatorProtocols limitsAndTimeouts
488494
version
489495

490496
initiatorAndResponderProtocols
491-
:: LimitsAndTimeouts addr
497+
:: LimitsAndTimeouts crypto addr
492498
-> Apps addr m a b
493499
-> NodeToNodeVersion
494500
-> NodeToNodeVersionData
@@ -521,36 +527,39 @@ initiatorAndResponderProtocols limitsAndTimeouts
521527
})
522528
version
523529

524-
data Codecs addr m =
530+
data Codecs crypto addr m =
525531
Codecs {
526-
sigSubmissionCodec :: AnnotatedCodec SigSubmission
532+
sigSubmissionCodec :: AnnotatedCodec (SigSubmission crypto)
527533
CBOR.DeserialiseFailure m BL.ByteString
528534
, keepAliveCodec :: Codec KeepAlive
529535
CBOR.DeserialiseFailure m BL.ByteString
530536
, peerSharingCodec :: Codec (Protocol.PeerSharing addr)
531537
CBOR.DeserialiseFailure m BL.ByteString
532538
}
533539

534-
dmqCodecs :: MonadST m
540+
dmqCodecs :: ( Crypto crypto
541+
, Typeable crypto
542+
, MonadST m
543+
)
535544
=> (addr -> CBOR.Encoding)
536545
-> (forall s. CBOR.Decoder s addr)
537-
-> Codecs addr m
546+
-> Codecs crypto addr m
538547
dmqCodecs encodeAddr decodeAddr =
539548
Codecs {
540549
sigSubmissionCodec = codecSigSubmission
541550
, keepAliveCodec = codecKeepAlive_v2
542551
, peerSharingCodec = codecPeerSharing encodeAddr decodeAddr
543552
}
544553

545-
data LimitsAndTimeouts addr =
554+
data LimitsAndTimeouts crypto addr =
546555
LimitsAndTimeouts {
547556
-- sig-submission
548557
sigSubmissionLimits
549558
:: MiniProtocolLimits
550559
, sigSubmissionSizeLimits
551-
:: ProtocolSizeLimits SigSubmission BL.ByteString
560+
:: ProtocolSizeLimits (SigSubmission crypto) BL.ByteString
552561
, sigSubmissionTimeLimits
553-
:: ProtocolTimeLimits SigSubmission
562+
:: ProtocolTimeLimits (SigSubmission crypto)
554563

555564
-- keep-alive
556565
, keepAliveLimits
@@ -569,7 +578,7 @@ data LimitsAndTimeouts addr =
569578
:: ProtocolSizeLimits (Protocol.PeerSharing addr) BL.ByteString
570579
}
571580

572-
dmqLimitsAndTimeouts :: LimitsAndTimeouts addr
581+
dmqLimitsAndTimeouts :: LimitsAndTimeouts crypto addr
573582
dmqLimitsAndTimeouts =
574583
LimitsAndTimeouts {
575584
sigSubmissionLimits =

0 commit comments

Comments
 (0)