refactor

src/Simplex/Messaging/Client.hs

@@ -676,30 +676,29 @@ data ClientBatch err msg
   | CBLargeTransmission (Request err msg)
 
 batchClientTransmissions :: forall err msg. Bool -> Int -> NonEmpty (PCTransmission err msg) -> [ClientBatch err msg]
-batchClientTransmissions batch blkSize ts
-  | batch =
-      let (bs, b, _, n, rs) = foldr addToBatch ([], mempty, 0, 0, []) ts
-       in if n == 0 then bs else CBTransmissions b n rs : bs
-  | otherwise = map mkBatch1 $ L.toList ts
+batchClientTransmissions batch bSize
+  | batch = addBatch . foldr addTransmission ([], mempty, 0, 0, [])
+  | otherwise = map mkBatch1 . L.toList
   where
     mkBatch1 :: PCTransmission err msg -> ClientBatch err msg
     mkBatch1 (t, r)
       -- 2 bytes are reserved for pad size
-      | LB.length s <= fromIntegral (blkSize - 2) = CBTransmission (lazyByteString s) r
+      | LB.length s <= fromIntegral (bSize - 2) = CBTransmission (lazyByteString s) r
       | otherwise = CBLargeTransmission r
       where
         s = tEncode t
-    addToBatch :: PCTransmission err msg -> ([ClientBatch err msg], Builder, Int, Int, [Request err msg]) -> ([ClientBatch err msg], Builder, Int, Int, [Request err msg])
-    addToBatch (t, r) (bs, b, len, n, rs)
-      | len' <= blkSize - 3 && n < 255 = (bs, s <> b, len', 1 + n, r : rs)
-      | sLen <= blkSize - 3 = (bs', s, sLen, 1, [r])
-      | otherwise = (CBLargeTransmission r : (if n == 0 then bs else bs'), mempty, 0, 0, [])
+    addTransmission :: PCTransmission err msg -> ([ClientBatch err msg], Builder, Int, Int, [Request err msg]) -> ([ClientBatch err msg], Builder, Int, Int, [Request err msg])
+    addTransmission (t, r) acc@(bs, b, len, n, rs)
+      | len' <= bSize - 3 && n < 255 = (bs, s <> b, len', 1 + n, r : rs)
+      | sLen <= bSize - 3 = (addBatch acc, s, sLen, 1, [r])
+      | otherwise = (CBLargeTransmission r : addBatch acc, mempty, 0, 0, [])
       where
-        s = encodeLarge s'
-        sLen = 2 + (fromIntegral $ LB.length s')
-        s' = tEncode t
+        s = encodeLarge t'
+        sLen = 2 + fromIntegral (LB.length t') -- 2-bytes length is added by encodeLarge
+        t' = tEncode t
         len' = sLen + len
-        bs' = CBTransmissions b n rs : bs
+    addBatch :: ([ClientBatch err msg], Builder, Int, Int, [Request err msg]) -> [ClientBatch err msg]
+    addBatch (bs, b, _, n, rs) = if n == 0 then bs else CBTransmissions b n rs : bs
 
 -- | Send Protocol command
 sendProtocolCommand :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> Maybe C.APrivateSignKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg

src/Simplex/Messaging/Protocol.hs

@@ -1308,27 +1308,29 @@ data TransportBatch = TBTransmissions Int Builder | TBTransmission Builder | TBL
 
 -- | encodes and batches transmissions into blocks,
 batchTransmissions :: Bool -> Int -> NonEmpty SentRawTransmission -> [TransportBatch]
-batchTransmissions batch bSize ts
-  | batch =
-      let (bs, b, _, n) = foldr addToBatch ([], mempty, 0, 0) ts
-        in if n == 0 then bs else TBTransmissions n b : bs
-  | otherwise = map (mkBatch1 . tEncode) (L.toList ts)
+batchTransmissions batch bSize
+  | batch = addBatch . foldr addTransmission ([], mempty, 0, 0)
+  | otherwise = map mkBatch1 . L.toList
   where
-    mkBatch1 :: LB.ByteString -> TransportBatch
-    mkBatch1 s
-      | LB.length s > fromIntegral (bSize - 2) = TBLargeTransmission
-      | otherwise = TBTransmission $ lazyByteString s
-    addToBatch :: SentRawTransmission -> ([TransportBatch], Builder, Int, Int) -> ([TransportBatch], Builder, Int, Int)
-    addToBatch t (bs, b, len, n)
-      | len' <= bSize - 3 && n < 255 = (bs, s <> b, len', 1 + n)
-      | sLen <= bSize - 3 = (bs', s, sLen, 1)
-      | otherwise = (TBLargeTransmission : (if n == 0 then bs else bs'), mempty, 0, 0)
+    mkBatch1 :: SentRawTransmission -> TransportBatch
+    mkBatch1 t
+      -- 2 bytes are reserved for pad size
+      | LB.length s <= fromIntegral (bSize - 2) = TBTransmission (lazyByteString s)
+      | otherwise = TBLargeTransmission
       where
-        s = encodeLarge s'
-        sLen = 2 + fromIntegral (LB.length s')
-        s' = tEncode t
+        s = tEncode t
+    addTransmission :: SentRawTransmission -> ([TransportBatch], Builder, Int, Int) -> ([TransportBatch], Builder, Int, Int)
+    addTransmission t acc@(bs, b, len, n)
+      | len' <= bSize - 3 && n < 255 = (bs, s <> b, len', 1 + n)
+      | sLen <= bSize - 3 = (addBatch acc, s, sLen, 1)
+      | otherwise = (TBLargeTransmission : addBatch acc, mempty, 0, 0)
+      where
+        s = encodeLarge t'
+        sLen = 2 + fromIntegral (LB.length t') -- 2-bytes length is added by encodeLarge
+        t' = tEncode t
         len' = sLen + len
-        bs' = TBTransmissions n b : bs
+    addBatch :: ([TransportBatch], Builder, Int, Int) -> [TransportBatch]
+    addBatch (bs, b, _, n) = if n == 0 then bs else TBTransmissions n b : bs
 
 tEncode :: SentRawTransmission -> LB.ByteString
 tEncode (sig, t) = LB.chunk (smpEncode $ C.signatureBytes sig) (LB.fromStrict t)