TxSubmission, part 1: code refactoring

ouroboros-network-api/ouroboros-network-api.cabal

@@ -67,6 +67,7 @@ library
                        nothunks,
                        serialise         >=0.2   && <0.3,
                        text              >=1.2 && <2.2,
+                       quiet,
 
                        cardano-slotting,
                        cardano-strict-containers,

ouroboros-network-api/src/Ouroboros/Network/SizeInBytes.hs

@@ -1,22 +1,30 @@
+{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
 
 module Ouroboros.Network.SizeInBytes (SizeInBytes (..)) where
 
 import Control.DeepSeq (NFData (..))
+import Data.Monoid (Sum (..))
 import Data.Word (Word32)
+import GHC.Generics
 
 import Data.Measure qualified as Measure
 import NoThunks.Class (NoThunks (..))
+import Quiet (Quiet (..))
 
 newtype SizeInBytes = SizeInBytes { getSizeInBytes :: Word32 }
-  deriving (Show, Eq, Ord)
-  deriving Enum     via Word32
-  deriving Num      via Word32
-  deriving Real     via Word32
-  deriving Integral via Word32
-  deriving NoThunks via Word32
+  deriving (Eq, Ord)
+  deriving Show      via Quiet SizeInBytes
+  deriving Enum      via Word32
+  deriving Num       via Word32
+  deriving Real      via Word32
+  deriving Integral  via Word32
+  deriving NoThunks  via Word32
+  deriving Semigroup via Sum Word32
+  deriving Monoid    via Sum Word32
+  deriving Generic
   deriving newtype NFData
   deriving Measure.Measure        via Word32
   deriving Measure.BoundedMeasure via Word32

ouroboros-network-framework/ouroboros-network-framework.cabal

@@ -91,6 +91,7 @@ library
                      , si-timers
                      , strict-stm
 
+                     , nothunks       ^>=0.2
                      , psqueues
                      -- ^ only to derive nothunk instances
 

ouroboros-network-protocols/CHANGELOG.md

@@ -25,6 +25,8 @@
 * Refactored CBOR mini-protocols codecs to a more modular structure
 * Added `deepseq` dependency and implemented `NFData` for `testlib` types.
 * Added miniprotocols codec benchmarks
+* Use `SizeInBytes` newtype instead of the `TxSizeInBytes` type aliase.
+  `TxSizeInBytes` is now deprecated.
 
 ## 0.8.0.0 -- 2024-02-21
 

ouroboros-network-protocols/ouroboros-network-protocols.cabal

@@ -98,8 +98,10 @@ library
                        bytestring        >=0.10 && <0.13,
                        cborg             >=0.2.1 && <0.3,
                        deepseq,
+                       quiet,
 
                        io-classes       ^>=1.5.0,
+                       nothunks,
                        si-timers,
 
                        ouroboros-network-api

ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Client.hs

@@ -27,8 +27,6 @@ module Ouroboros.Network.Protocol.TxSubmission2.Client
   , txSubmissionClientPeer
   ) where
 
-import Data.Word (Word16)
-
 import Network.TypedProtocol.Core
 
 import Ouroboros.Network.Protocol.TxSubmission2.Type
@@ -56,16 +54,16 @@ data ClientStIdle txid tx m a = ClientStIdle {
 
     recvMsgRequestTxIds      :: forall blocking.
                                 TokBlockingStyle blocking
-                             -> Word16
-                             -> Word16
+                             -> NumTxIdsToAck
+                             -> NumTxIdsToReq
                              -> m (ClientStTxIds blocking txid tx m a),
 
     recvMsgRequestTxs        :: [txid]
                              -> m (ClientStTxs txid tx m a)
   }
 
 data ClientStTxIds blocking txid tx m a where
-  SendMsgReplyTxIds :: BlockingReplyList blocking (txid, TxSizeInBytes)
+  SendMsgReplyTxIds :: BlockingReplyList blocking (txid, SizeInBytes)
                     -> ClientStIdle           txid tx m a
                     -> ClientStTxIds blocking txid tx m a
 

ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Codec.hs

@@ -102,7 +102,10 @@ encodeTxSubmission2 encodeTxId encodeTx = encode
     encode (ClientAgency TokInit)  MsgInit =
         CBOR.encodeListLen 1
      <> CBOR.encodeWord 6
-    encode (ServerAgency TokIdle) (MsgRequestTxIds blocking ackNo reqNo) =
+    encode (ServerAgency TokIdle) (MsgRequestTxIds
+                                     blocking
+                                     (NumTxIdsToAck ackNo)
+                                     (NumTxIdsToReq reqNo)) =
         CBOR.encodeListLen 4
      <> CBOR.encodeWord 0
      <> CBOR.encodeBool (case blocking of
@@ -115,14 +118,15 @@ encodeTxSubmission2 encodeTxId encodeTx = encode
         CBOR.encodeListLen 2
      <> CBOR.encodeWord 1
      <> CBOR.encodeListLenIndef
-     <> foldr (\(txid, sz) r -> CBOR.encodeListLen 2
+     <> foldr (\(txid, SizeInBytes sz) r ->
+                                CBOR.encodeListLen 2
                              <> encodeTxId txid
                              <> CBOR.encodeWord32 sz
                              <> r)
               CBOR.encodeBreak
               txids'
       where
-        txids' :: [(txid, TxSizeInBytes)]
+        txids' :: [(txid, SizeInBytes)]
         txids' = case txids of
                    BlockingReply    xs -> NonEmpty.toList xs
                    NonBlockingReply xs -> xs
@@ -166,11 +170,12 @@ decodeTxSubmission2 decodeTxId decodeTx = decode
           return (SomeMessage MsgInit)
         (ServerAgency TokIdle,       4, 0) -> do
           blocking <- CBOR.decodeBool
-          ackNo    <- CBOR.decodeWord16
-          reqNo    <- CBOR.decodeWord16
-          return $! case blocking of
-            True  -> SomeMessage (MsgRequestTxIds TokBlocking    ackNo reqNo)
-            False -> SomeMessage (MsgRequestTxIds TokNonBlocking ackNo reqNo)
+          ackNo    <- NumTxIdsToAck <$> CBOR.decodeWord16
+          reqNo    <- NumTxIdsToReq <$> CBOR.decodeWord16
+          return $!
+            if blocking
+            then SomeMessage (MsgRequestTxIds TokBlocking    ackNo reqNo)
+            else SomeMessage (MsgRequestTxIds TokNonBlocking ackNo reqNo)
 
         (ClientAgency (TokTxIds b),  2, 1) -> do
           CBOR.decodeListLenIndef
@@ -179,7 +184,7 @@ decodeTxSubmission2 decodeTxId decodeTx = decode
                      (do CBOR.decodeListLenOf 2
                          txid <- decodeTxId
                          sz   <- CBOR.decodeWord32
-                         return (txid, sz))
+                         return (txid, SizeInBytes sz))
           case (b, txids) of
             (TokBlocking, t:ts) ->
               return $

ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Server.hs

@@ -17,13 +17,13 @@ module Ouroboros.Network.Protocol.TxSubmission2.Server
     TxSubmissionServerPipelined (..)
   , ServerStIdle (..)
   , Collect (..)
-  , TxSizeInBytes
     -- * Execution as a typed protocol
   , txSubmissionServerPeerPipelined
+    -- * deprecated API
+  , TxSizeInBytes
   ) where
 
 import Data.List.NonEmpty (NonEmpty)
-import Data.Word (Word16)
 
 import Network.TypedProtocol.Core
 import Network.TypedProtocol.Pipelined
@@ -44,7 +44,7 @@ data TxSubmissionServerPipelined txid tx m a where
 data Collect txid tx =
        -- | The result of 'SendMsgRequestTxIdsPipelined'. It also carries
        -- the number of txids originally requested.
-       CollectTxIds Word16 [(txid, TxSizeInBytes)]
+       CollectTxIds NumTxIdsToReq [(txid, SizeInBytes)]
 
        -- | The result of 'SendMsgRequestTxsPipelined'. The actual reply only
        -- contains the transactions sent, but this pairs them up with the
@@ -58,18 +58,18 @@ data ServerStIdle (n :: N) txid tx m a where
   -- |
   --
   SendMsgRequestTxIdsBlocking
-    :: Word16                               -- ^ number of txids to acknowledge
-    -> Word16                               -- ^ number of txids to request
+    :: NumTxIdsToAck                        -- ^ number of txids to acknowledge
+    -> NumTxIdsToReq                        -- ^ number of txids to request
     -> m a                                  -- ^ Result if done
-    -> (NonEmpty (txid, TxSizeInBytes)
+    -> (NonEmpty (txid, SizeInBytes)
         -> m (ServerStIdle Z txid tx m a))
     -> ServerStIdle        Z txid tx m a
 
   -- |
   --
   SendMsgRequestTxIdsPipelined
-    :: Word16
-    -> Word16
+    :: NumTxIdsToAck
+    -> NumTxIdsToReq
     -> m (ServerStIdle (S n) txid tx m a)
     -> ServerStIdle       n  txid tx m a
 

ouroboros-network-protocols/src/Ouroboros/Network/Protocol/TxSubmission2/Type.hs

@@ -1,30 +1,56 @@
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE EmptyCase           #-}
-{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE PolyKinds           #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving  #-}
-{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE EmptyCase                  #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds                  #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TypeFamilies               #-}
 
 -- | The type of the transaction submission protocol.
 --
 -- This is used to relay transactions between nodes.
 --
-module Ouroboros.Network.Protocol.TxSubmission2.Type where
+module Ouroboros.Network.Protocol.TxSubmission2.Type
+  ( TxSubmission2 (..)
+  , Message (..)
+  , ClientHasAgency (..)
+  , ServerHasAgency (..)
+  , NobodyHasAgency (..)
+  , TokBlockingStyle (..)
+  , StBlockingStyle (..)
+  , BlockingReplyList (..)
+  , NumTxIdsToAck (..)
+  , NumTxIdsToReq (..)
+    -- re-exports
+  , SizeInBytes (..)
+    -- deprecated API
+  , TxSizeInBytes
+  ) where
 
+import Control.DeepSeq
 import Data.List.NonEmpty (NonEmpty)
-import Data.Word (Word16, Word32)
+import Data.Monoid (Sum (..))
+import Data.Word (Word16)
+import GHC.Generics
+import NoThunks.Class (NoThunks (..))
+
+import Quiet (Quiet (..))
 
 import Network.TypedProtocol.Core
 
-import Control.DeepSeq
+import Ouroboros.Network.SizeInBytes (SizeInBytes (..))
 import Ouroboros.Network.Util.ShowProxy
 
 -- | Transactions are typically not big, but in principle in future we could
 -- have ones over 64k large.
 --
-type TxSizeInBytes = Word32
+type TxSizeInBytes = SizeInBytes
+{-# DEPRECATED TxSizeInBytes "Use 'Ouroboros.Network.SizeInBytes.SizeInBytes' instead" #-}
 
 -- | The kind of the transaction-submission protocol, and the types of the
 -- states in the protocol state machine.
@@ -96,6 +122,21 @@ data StBlockingStyle where
   StNonBlocking :: StBlockingStyle
 
 
+newtype NumTxIdsToAck = NumTxIdsToAck { getNumTxIdsToAck :: Word16 }
+  deriving (Eq, Ord, NFData, Generic)
+  deriving newtype (Num, Enum, Real, Integral, Bounded, NoThunks)
+  deriving Semigroup via (Sum Word16)
+  deriving Monoid via (Sum Word16)
+  deriving Show via (Quiet NumTxIdsToAck)
+
+newtype NumTxIdsToReq = NumTxIdsToReq { getNumTxIdsToReq :: Word16 }
+  deriving (Eq, Ord, NFData, Generic)
+  deriving newtype (Num, Enum, Real, Integral, Bounded, NoThunks)
+  deriving Semigroup via (Sum Word16)
+  deriving Monoid via (Sum Word16)
+  deriving Show via (Quiet NumTxIdsToReq)
+
+
 -- | There are some constraints of the protocol that are not captured in the
 -- types of the messages, but are documented with the messages. Violation
 -- of these constraints is also a protocol error. The constraints are intended
@@ -169,8 +210,8 @@ instance Protocol (TxSubmission2 txid tx) where
     --
     MsgRequestTxIds
       :: TokBlockingStyle blocking
-      -> Word16 -- ^ Acknowledge this number of outstanding txids
-      -> Word16 -- ^ Request up to this number of txids.
+      -> NumTxIdsToAck -- ^ Acknowledge this number of outstanding txids
+      -> NumTxIdsToReq -- ^ Request up to this number of txids.
       -> Message (TxSubmission2 txid tx) StIdle (StTxIds blocking)
 
     -- | Reply with a list of transaction identifiers for available