sessions command, for debuging netcrypto

1 files changed, 9 insertions, 0 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index b7737656..a4c99cab 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -11,6 +11,7 @@ module Data.PacketQueue
     , enqueue
     , observeOutOfBand
     , PacketOutQueue
+    , packetQueueViewList
     , newOutGoing
     , readyOutGoing
     , tryAppendQueueOutgoing
@@ -25,6 +26,7 @@ import Control.Concurrent.STM.TArray
 import Control.Monad
 import Data.Word
 import Data.Array.MArray
+import Data.Maybe
 
 data PacketQueue a = PacketQueue
     { pktq    :: TArray Word32 (Maybe a)
@@ -33,6 +35,13 @@ data PacketQueue a = PacketQueue
     , buffend :: TVar Word32 -- on incoming, highest packet number handled + 1
     }
 
+packetQueueViewList :: PacketQueue a -> STM [(Word32,a)]
+packetQueueViewList p = do
+    let f (n,Nothing) = Nothing
+        f (n,Just x)  = Just (n,x)
+    catMaybes . map f <$> getAssocs (pktq p)
+
+
 -- | Create a new PacketQueue.
 new :: Word32 -- ^ Capacity of queue.
     -> Word32 -- ^ Initial sequence number.