dmq: local message submission

Author: crocodile-dentist

decentralized-message-queue/src/DMQ/Protocol/LocalMsgSubmission/Client.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE DataKinds  #-}
+
+-- | A higher level API to implement clients for local message submission
+-- miniprotocol. This aliases the client from the 'LocalTxSubmission' protocol.
+--
+-- For execution, 'localMsgSubmissionClientPeer' reinterprets this high level
+-- description into the underlying typed protocol representation.
+--
+module DMQ.Protocol.LocalMsgSubmission.Client
+  ( -- * Client API types (re-exports)
+    LocalMsgSubmissionClient
+  , LocalMsgClientStIdle
+    -- * Translates the client into a typed protocol
+  , localMsgSubmissionClientPeer
+  ) where
+
+import DMQ.Protocol.LocalMsgSubmission.Type
+import Network.TypedProtocol.Peer.Client
+import Ouroboros.Network.Protocol.LocalTxSubmission.Client
+
+-- | Type aliases for the high level client API
+--
+type LocalMsgSubmissionClient = LocalTxSubmissionClient
+type LocalMsgClientStIdle     = LocalTxClientStIdle
+
+
+-- | A non-pipelined 'Peer' representing the 'LocalMsgSubmissionClient'.
+--
+-- Translates a high level client description into the underlying typed
+-- protocol representation.
+--
+localMsgSubmissionClientPeer
+  :: forall msg reject m a. Monad m
+  => LocalMsgSubmissionClient msg reject m a
+  -> Client (LocalMsgSubmission msg reject) NonPipelined StIdle m a
+localMsgSubmissionClientPeer = localTxSubmissionClientPeer

decentralized-message-queue/src/DMQ/Protocol/LocalMsgSubmission/Codec.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE RankNTypes       #-}
+
+-- | The codec for the local message submission miniprotocol
+--
+module DMQ.Protocol.LocalMsgSubmission.Codec where
+
+import Codec.CBOR.Decoding qualified as CBOR
+import Codec.CBOR.Encoding qualified as CBOR
+import Codec.CBOR.Read qualified as CBOR
+import Control.Monad.Class.MonadST
+import Data.ByteString.Lazy (ByteString)
+
+import DMQ.Protocol.LocalMsgSubmission.Type
+import Network.TypedProtocol.Codec.CBOR
+import Ouroboros.Network.Protocol.LocalTxSubmission.Codec
+
+codecLocalMsgSubmission
+  :: forall msg reject m.
+     MonadST m
+  => (msg -> CBOR.Encoding)
+  -> (forall s. CBOR.Decoder s msg)
+  -> (reject -> CBOR.Encoding)
+  -> (forall s. CBOR.Decoder s reject)
+  -> Codec (LocalMsgSubmission msg reject) CBOR.DeserialiseFailure m ByteString
+codecLocalMsgSubmission =
+  codecLocalTxSubmission

decentralized-message-queue/src/DMQ/Protocol/LocalMsgSubmission/Server.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE DataKinds  #-}
+
+-- | A higher level API to implement server for local message submission
+-- miniprotocol. This aliases the server from the 'LocalTxSubmission' protocol.
+--
+-- For execution, 'localMsgSubmissionServerPeer' reinterprets this high level
+-- description into the underlying typed protocol representation.
+--
+module DMQ.Protocol.LocalMsgSubmission.Server
+  ( -- * Server API types (re-exports)
+    LocalMsgSubmissionServer
+    -- * Translates the server into a typed protocol
+  , localMsgSubmissionServerPeer
+  ) where
+
+import DMQ.Protocol.LocalMsgSubmission.Type
+import Network.TypedProtocol.Peer.Server
+import Ouroboros.Network.Protocol.LocalTxSubmission.Server
+
+-- | Type aliases for the high level client API
+--
+type LocalMsgSubmissionServer = LocalTxSubmissionServer
+
+
+-- | A non-pipelined 'Peer' representing the 'LocalMsgSubmissionServer'.
+--
+-- Translates a high level server description into the underying typed
+-- protocol representation.
+--
+localMsgSubmissionServerPeer
+  :: forall msg reject m a.
+     Monad m
+  => m (LocalMsgSubmissionServer msg reject m a)
+  -> Server (LocalMsgSubmission msg reject) NonPipelined StIdle m a
+localMsgSubmissionServerPeer = localTxSubmissionServerPeer

decentralized-message-queue/src/DMQ/Protocol/LocalMsgSubmission/Type.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE DataKinds                #-}
+{-# LANGUAGE FlexibleInstances        #-}
+{-# LANGUAGE PolyKinds                #-}
+{-# LANGUAGE TypeFamilies             #-}
+
+-- | This module provides the type of LocalMsgProtocol via LocalTxSubmission
+--
+module DMQ.Protocol.LocalMsgSubmission.Type
+  ( module DMQ.Protocol.LocalMsgSubmission.Type
+    -- * re-exports
+  , module Core
+  , module Ouroboros
+  , SubmitResult (..)
+  ) where
+
+import Ouroboros.Network.Protocol.LocalTxSubmission.Type as Ouroboros
+import Network.TypedProtocol.Core as Core
+
+-- | The LocalMsgSubmission protocol is an alias for the LocalTxSubmission
+--
+type LocalMsgSubmission = Ouroboros.LocalTxSubmission