announceNewSessionHooks, addNewSessionHook

1 files changed, 22 insertions, 1 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 6a79da1b..10a24e50 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -5,7 +5,7 @@ module Network.Tox.Crypto.Handlers where
 
 import Network.Tox.NodeId
 import Network.Tox.Crypto.Transport
-import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..))
+import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..), NoSpam(..))
 import Network.Tox.DHT.Handlers (Client, cookieRequest, cookieRequestH )
 import Crypto.Tox
 import Control.Concurrent.STM
@@ -60,6 +60,7 @@ data SessionView = SessionView
         { svNick :: TVar ByteString
         , svStatus :: TVar UserStatus
         , svStatusMsg :: TVar ByteString
+        , svNoSpam :: TVar (Maybe NoSpam)
         , svGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr))
         -- allthough these directories are not visible to others on the net
         -- they are included in this type, because it facilitates organizing
@@ -113,8 +114,14 @@ data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAdd
                                     , inboundQueueCapacity :: Word32
                                     , outboundQueueCapacity :: Word32
                                     , nextSessionId :: TVar SessionID
+                                    , announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession]
                                     }
 
+type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession
+
+addNewSessionHook :: NetCryptoSessions -> NewSessionHook -> STM ()
+addNewSessionHook allsessions@(NCSessions { announceNewSessionHooks }) hook = modifyTVar announceNewSessionHooks (hook:)
+
 forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM ()
 forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) session = do
     let addr = ncSockAddr session
@@ -152,6 +159,7 @@ newSessionsState crypto unrechook hooks = do
     nick <- atomically $ newTVar B.empty
     status <- atomically $ newTVar Online
     statusmsg <- atomically $ newTVar B.empty
+    nospam <- atomically $ newTVar Nothing
     grps <- atomically $ newTVar Map.empty
     pname <- getProgName
     cachedir <- sensibleCacheDirCreateIfMissing pname
@@ -160,6 +168,7 @@ newSessionsState crypto unrechook hooks = do
     homedir <- getHomeDirectory
     svDownloadDir0 <- atomically $ newTVar (homedir </> "Downloads")
     nextSessionId0 <- atomically $ newTVar 0
+    announceNewSessionHooks0 <- atomically $ newTVar []
     return NCSessions { netCryptoSessions = x
                       , netCryptoSessionsByKey = x2
                       , transportCrypto = crypto
@@ -168,6 +177,7 @@ newSessionsState crypto unrechook hooks = do
                       , sessionView = SessionView { svNick = nick
                                                   , svStatus = status
                                                   , svStatusMsg = statusmsg
+                                                  , svNoSpam = nospam
                                                   , svGroups = grps
                                                   , svCacheDir = cachedir
                                                   , svTmpDir = tmpdir
@@ -178,6 +188,7 @@ newSessionsState crypto unrechook hooks = do
                       , inboundQueueCapacity = 200
                       , outboundQueueCapacity = 400
                       , nextSessionId = nextSessionId0
+                      , announceNewSessionHooks = announceNewSessionHooks0
                       }
 
 data HandshakeParams
@@ -355,6 +366,16 @@ freshCryptoSession  sessions
         case byKeyResult of
             Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession])
             Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs))
+    -- run announceNewSessionHooks
+    hooks <- atomically $ readTVar (announceNewSessionHooks sessions)
+    flip fix (hooks,netCryptoSession) $ \loop (hooks,session) ->
+        case hooks of
+            [] -> return ()
+            (h:hs) -> do 
+                r <- h Nothing session
+                case r of
+                  Just f -> loop (hs, f session)
+                  Nothing -> return ()
 
 -- | Called when we get a handshake, but there's already a session entry.
 updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCryptoSession -> IO ()