add ViewSnapshot to ncLastNMsg queue

1 files changed, 55 insertions, 5 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 9567ea87..0ad868a7 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -42,6 +42,7 @@ import GHC.Conc (labelThread)
 import PingMachine
 import qualified Data.IntMap.Strict as IntMap
 import Control.Concurrent.Supply
+import Data.InOrOut
 
 -- util, todo: move to another module
 maybeToEither :: Maybe b -> Either String b
@@ -92,6 +93,54 @@ data SessionView = SessionView
         , svDownloadDir :: TVar FilePath -- ^ where to put files the user downloads
         }
 
+-- | A static version of 'SessionView'
+--   useful for serializing to logs
+--   or storing in the ncLastNMsgs queue
+data ViewSnapshot = ViewSnapshot
+        { vNick        :: ByteString
+        , vStatus      :: UserStatus
+        , vStatusMsg   :: ByteString
+        , vTyping      :: TypingStatus
+        , vNoSpam      :: Maybe NoSpam
+        , vTheirNick        :: ByteString
+        , vTheirStatus      :: UserStatus
+        , vTheirStatusMsg   :: ByteString
+        , vTheirTyping      :: TypingStatus
+        , vTheirNoSpam      :: Maybe NoSpam
+        , vGroups      :: Map.Map GroupChatId (Set.Set SockAddr)
+        }
+
+-- | Take snapshot of SessionView
+--
+-- This is useful for storing the context of
+-- remembered messages.
+viewSnapshot :: SessionView -> STM ViewSnapshot
+viewSnapshot v = do
+    nick        <- readTVar (svNick v)
+    status      <- readTVar (svStatus v)
+    statusMsg   <- readTVar (svStatusMsg v)
+    typing      <- readTVar (svTyping v)
+    noSpam      <- readTVar (svNoSpam v)
+    theirNick        <- readTVar (svTheirNick v)
+    theirStatus      <- readTVar (svTheirStatus v)
+    theirStatusMsg   <- readTVar (svTheirStatusMsg v)
+    theirTyping      <- readTVar (svTheirTyping v)
+    theirNoSpam      <- readTVar (svTheirNoSpam v)
+    groups      <- readTVar (svGroups v)
+    return ViewSnapshot
+            { vNick = nick
+            , vStatus = status
+            , vStatusMsg = statusMsg
+            , vTyping = typing
+            , vNoSpam = noSpam
+            , vTheirNick = theirNick
+            , vTheirStatus = theirStatus
+            , vTheirStatusMsg = theirStatusMsg
+            , vTheirTyping = theirTyping
+            , vTheirNoSpam = theirNoSpam
+            , vGroups = groups
+            }
+
 type SessionID = Word64
 
 -- | Application specific listener type (Word64)
@@ -141,15 +190,14 @@ data NetCryptoSession = NCrypto
                                                 CryptoMessage
                                                 (CryptoPacket Encrypted)
                                                 CryptoData
-    , ncLastNMsgs :: PacketQueue (Bool{-Handled?-},CryptoMessage)
+    , ncLastNMsgs :: PacketQueue (Bool{-Handled?-},(ViewSnapshot,InOrOut CryptoMessage))
     -- ^ cyclic buffer, holds the last N non-handshake crypto messages
     --   even if there is no attached user interface.
     , ncListeners :: TVar (IntMap.IntMap (ListenerType,TMChan CryptoMessage))
     -- ^ user interfaces may "listen" by inserting themselves into this map
     -- with a unique id and a new TChan, and then reading from the TChan
     , ncMsgNumVar  :: TVar  Word32
-    -- ^ The number of non-handshake crypto messages recieved in this session
-    --   TODO: there is already a packet num etc, do we need two?
+    -- ^ The number of non-handshake crypto messages written to ncLastNMsgs total
     , ncDropCntVar :: TVar  Word32
     -- ^ The number of crypto messages that were overwritten in the ncLastNMsgs
     --   before anybody got to see them.
@@ -400,7 +448,7 @@ freshCryptoSession  sessions
                 writeTVar ncMyPacketNonce0 n24plus1
                 return (return (f n24, n24, ncOutgoingIdMap0))
     pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0
-    msgQ <- atomically (PQ.newOverwrite 10 0 :: STM (PacketQueue (Bool,CryptoMessage)))
+    msgQ <- atomically (PQ.newOverwrite 10 0 :: STM (PacketQueue (Bool,(ViewSnapshot,InOrOut CryptoMessage))))
     listeners <- atomically $ newTVar IntMap.empty
     msgNum <- atomically $ newTVar 0
     dropNum <- atomically $ newTVar 0
@@ -816,7 +864,9 @@ hookHelper handledFlg typ  session  cm = do
         dropCntVar = ncDropCntVar session
     atomically $ do
         num <- readTVar msgNumVar
-        (wraps,offset) <- PQ.enqueue msgQ num (handledFlg,cm)
+        view <- readTVar (ncView session)
+        snapshot <- viewSnapshot view
+        (wraps,offset) <- PQ.enqueue msgQ num (handledFlg,(snapshot,Out cm))
         capacity <- PQ.getCapacity msgQ
         let dropped = wraps * capacity + offset
         modifyTVar' msgNumVar (+1)