fixup! ouroboros-network-framework: drivers for annotated decoders

Author: coot

ouroboros-network-framework/src/Ouroboros/Network/Driver/Limits.hs

@@ -344,7 +344,7 @@ runAnnotatedDecoderWithLimit limit size Channel{recv} =
     -- This leaves just one special case: if the decoder finishes with that
     -- final chunk, we must check if it consumed too much of the final chunk.
     --
-    go :: bytes
+    go :: [bytes]     -- ^ accumulation of chunks received from the network
        -> Word        -- ^ size of consumed input so far
        -> Maybe bytes -- ^ any trailing data
        -> DecodeStep bytes failure m (bytes -> a)
@@ -353,7 +353,7 @@ runAnnotatedDecoderWithLimit limit size Channel{recv} =
     go !bytes !sz !_ (DecodeDone f trailing)
       | let sz' = sz - maybe 0 size trailing
       , sz' > limit = return (Left Nothing)
-      | otherwise   = return (Right (f bytes, trailing))
+      | otherwise   = return (Right (f (mconcat $ reverse bytes), trailing))
 
     go !_ !_ !_ (DecodeFail failure) = return (Left (Just failure))
 
@@ -364,12 +364,15 @@ runAnnotatedDecoderWithLimit limit size Channel{recv} =
       mbs <- recv
       let !sz' = sz + maybe 0 size mbs
       step <- k mbs
-      go (bytes <> fromMaybe mempty mbs) sz' Nothing step
+      go (case mbs of
+            Nothing -> bytes
+            Just bs -> bs : bytes)
+         sz' Nothing step
 
     go !bytes !sz (Just trailing) (DecodePartial k) = do
       let sz' = sz + size trailing
       step <- k (Just trailing)
-      go (bytes <> trailing) sz' Nothing step
+      go (trailing : bytes) sz' Nothing step
 
 
 -- | Run a peer with limits.

ouroboros-network-framework/src/Ouroboros/Network/Driver/Simple.hs

@@ -49,7 +49,7 @@ import Control.Monad.Class.MonadFork
 import Control.Monad.Class.MonadThrow
 import Control.Tracer (Tracer (..), contramap, traceWith)
 import Data.Functor.Identity (Identity (..))
-import Data.Maybe (fromMaybe)
+import Data.Maybe (maybeToList)
 
 
 -- $intro
@@ -326,13 +326,16 @@ runAnnotatedDecoderWithChannel
   -> DecodeStep bytes failure m (bytes -> a)
   -> m (Either failure (a, Maybe bytes))
 
-runAnnotatedDecoderWithChannel Channel{recv} bs0 = go (fromMaybe mempty bs0) bs0
+runAnnotatedDecoderWithChannel Channel{recv} bs0 = go (maybeToList bs0) bs0
   where
-    go :: bytes -> Maybe bytes -> DecodeStep bytes failure m (bytes -> a) -> m (Either failure (a, Maybe bytes))
-    go bytes  _ (DecodeDone f trailing)        = return $ Right (f bytes, trailing)
-    go _bytes _ (DecodeFail failure)           = return (Left failure)
-    go bytes Nothing         (DecodePartial k) = recv >>= \bs -> k bs >>= go (bytes <> fromMaybe mempty bs) Nothing
-    go bytes (Just trailing) (DecodePartial k) = k (Just trailing) >>= go (bytes <> trailing) Nothing
+    go :: [bytes]
+       -> Maybe bytes
+       -> DecodeStep bytes failure m (bytes -> a)
+       -> m (Either failure (a, Maybe bytes))
+    go !bytes  _ (DecodeDone f trailing)        = return $ Right (f $ mconcat (reverse bytes), trailing)
+    go _bytes _ (DecodeFail failure)            = return (Left failure)
+    go !bytes Nothing         (DecodePartial k) = recv >>= \bs -> k bs >>= go (maybe bytes (: bytes) bs) Nothing
+    go !bytes (Just trailing) (DecodePartial k) = k (Just trailing) >>= go (trailing : bytes) Nothing
 
 
 data Role = Client | Server