wip todo

Author: crocodile-dentist

dmq-node/src/DMQ/NodeToClient/LocalMsgSubmission.hs

@@ -6,32 +6,33 @@ import Data.Maybe
 
 import DMQ.Protocol.LocalMsgSubmission.Server
 import DMQ.Protocol.LocalMsgSubmission.Type
+import Ouroboros.Network.TxSubmission.Mempool.Simple
 import Ouroboros.Network.TxSubmission.Inbound.V2
 
 -- | Local transaction submission server, for adding txs to the 'Mempool'
 --
 localMsgSubmissionServer ::
      MonadSTM m
-  => Tracer m (TraceLocalMsgSubmission msg msgid SigMempoolFail)
+  => Tracer m (TraceLocalMsgSubmission msg msgid (MempoolAddFail sig))
   -> TxSubmissionMempoolWriter msgid msg idx m
   -> m (LocalMsgSubmissionServer msg m ())
 localMsgSubmissionServer tracer TxSubmissionMempoolWriter { mempoolAddTxs } =
-    pure server
-  where
-    failure =
-      -- TODO remove dummy hardcode when mempool returns reason
-      (SubmitFail SigExpired, server) <$ traceWith tracer (TraceSubmitFailure SigExpired)
-    success msgid =
-      (SubmitSuccess, server) <$ traceWith tracer (TraceSubmitAccept msgid)
+    pure undefined --server
+  -- where
+  --   failure =
+  --     -- TODO remove dummy hardcode when mempool returns reason
+  --     (SubmitFail SigExpired, server) <$ traceWith tracer (TraceSubmitFailure SigExpired)
+  --   success msgid =
+  --     (SubmitSuccess, server) <$ traceWith tracer (TraceSubmitAccept msgid)
 
-    server = LocalTxSubmissionServer {
-      recvMsgSubmitTx = \msg -> do
-        traceWith tracer $ TraceReceivedMsg msg
-        -- TODO mempool should return 'SubmitResult'
-        maybe failure success . listToMaybe =<< mempoolAddTxs [msg]
+  --   server = LocalTxSubmissionServer {
+  --     recvMsgSubmitTx = \msg -> do
+  --       traceWith tracer $ TraceReceivedMsg msg
+  --       -- TODO mempool should return 'SubmitResult'
+  --       maybe failure success . listToMaybe =<< mempoolAddTxs [msg]
 
-    , recvMsgDone = ()
-    }
+  --   , recvMsgDone = ()
+  --   }
 
 
 data TraceLocalMsgSubmission msg msgid reject =

dmq-node/src/DMQ/Protocol/LocalMsgSubmission/Codec.hs

@@ -20,33 +20,35 @@ import DMQ.Protocol.SigSubmission.Type (Sig (..))
 
 import Network.TypedProtocol.Codec.CBOR
 import Ouroboros.Network.Protocol.LocalTxSubmission.Codec qualified as LTX
+import Ouroboros.Network.TxSubmission.Mempool.Simple
 
 codecLocalMsgSubmission
   :: forall crypto m.
      ( MonadST m
      , Crypto crypto
      )
-  => (SigMempoolFail -> CBOR.Encoding)
-  -> (forall s. CBOR.Decoder s SigMempoolFail)
+  => (MempoolAddFail (Sig crypto) -> CBOR.Encoding)
+  -> (forall s. CBOR.Decoder s (MempoolAddFail (Sig crypto)))
   -> AnnotatedCodec (LocalMsgSubmission (Sig crypto)) CBOR.DeserialiseFailure m ByteString
 codecLocalMsgSubmission =
   LTX.anncodecLocalTxSubmission' SigWithBytes SigSubmission.encodeSig SigSubmission.decodeSig
 
-encodeReject :: SigMempoolFail -> CBOR.Encoding
-encodeReject = \case
-  SigInvalid reason -> CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> CBOR.encodeString reason
-  SigDuplicate      -> CBOR.encodeListLen 1 <> CBOR.encodeWord 1
-  SigExpired        -> CBOR.encodeListLen 1 <> CBOR.encodeWord 2
-  SigResultOther reason
-                    -> CBOR.encodeListLen 2 <> CBOR.encodeWord 3 <> CBOR.encodeString reason
-
-decodeReject :: CBOR.Decoder s SigMempoolFail
-decodeReject = do
-  len <- CBOR.decodeListLen
-  tag <- CBOR.decodeWord
-  case (tag, len) of
-    (0, 2)     -> SigInvalid <$> CBOR.decodeString
-    (1, 1)     -> pure SigDuplicate
-    (2, 1)     -> pure SigExpired
-    (3, 2)     -> SigResultOther <$> CBOR.decodeString
-    _otherwise -> fail $ printf "unrecognized (tag,len) = (%d, %d)" tag len
+encodeReject :: MempoolAddFail (Sig crypto) -> CBOR.Encoding
+encodeReject = undefined
+-- encodeReject = \case
+--   SigInvalid reason -> CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> CBOR.encodeString reason
+--   SigDuplicate      -> CBOR.encodeListLen 1 <> CBOR.encodeWord 1
+--   SigExpired        -> CBOR.encodeListLen 1 <> CBOR.encodeWord 2
+--   SigResultOther reason
+--                     -> CBOR.encodeListLen 2 <> CBOR.encodeWord 3 <> CBOR.encodeString reason
+
+decodeReject :: CBOR.Decoder s (MempoolAddFail (Sig crypto))
+decodeReject = return undefined --do
+  -- len <- CBOR.decodeListLen
+  -- tag <- CBOR.decodeWord
+  -- case (tag, len) of
+  --   (0, 2)     -> SigInvalid <$> CBOR.decodeString
+  --   (1, 1)     -> pure SigDuplicate
+  --   (2, 1)     -> pure SigExpired
+  --   (3, 2)     -> SigResultOther <$> CBOR.decodeString
+  --   _otherwise -> fail $ printf "unrecognized (tag,len) = (%d, %d)" tag len