diff options
Diffstat (limited to 'src/Network/Tox')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 23 |
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 | |||
5 | 5 | ||
6 | import Network.Tox.NodeId | 6 | import Network.Tox.NodeId |
7 | import Network.Tox.Crypto.Transport | 7 | import Network.Tox.Crypto.Transport |
8 | import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..)) | 8 | import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..), NoSpam(..)) |
9 | import Network.Tox.DHT.Handlers (Client, cookieRequest, cookieRequestH ) | 9 | import Network.Tox.DHT.Handlers (Client, cookieRequest, cookieRequestH ) |
10 | import Crypto.Tox | 10 | import Crypto.Tox |
11 | import Control.Concurrent.STM | 11 | import Control.Concurrent.STM |
@@ -60,6 +60,7 @@ data SessionView = SessionView | |||
60 | { svNick :: TVar ByteString | 60 | { svNick :: TVar ByteString |
61 | , svStatus :: TVar UserStatus | 61 | , svStatus :: TVar UserStatus |
62 | , svStatusMsg :: TVar ByteString | 62 | , svStatusMsg :: TVar ByteString |
63 | , svNoSpam :: TVar (Maybe NoSpam) | ||
63 | , svGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr)) | 64 | , svGroups :: TVar (Map.Map GroupChatId (Set.Set SockAddr)) |
64 | -- allthough these directories are not visible to others on the net | 65 | -- allthough these directories are not visible to others on the net |
65 | -- they are included in this type, because it facilitates organizing | 66 | -- they are included in this type, because it facilitates organizing |
@@ -113,8 +114,14 @@ data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAdd | |||
113 | , inboundQueueCapacity :: Word32 | 114 | , inboundQueueCapacity :: Word32 |
114 | , outboundQueueCapacity :: Word32 | 115 | , outboundQueueCapacity :: Word32 |
115 | , nextSessionId :: TVar SessionID | 116 | , nextSessionId :: TVar SessionID |
117 | , announceNewSessionHooks :: TVar [IOHook (Maybe NoSpam) NetCryptoSession] | ||
116 | } | 118 | } |
117 | 119 | ||
120 | type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession | ||
121 | |||
122 | addNewSessionHook :: NetCryptoSessions -> NewSessionHook -> STM () | ||
123 | addNewSessionHook allsessions@(NCSessions { announceNewSessionHooks }) hook = modifyTVar announceNewSessionHooks (hook:) | ||
124 | |||
118 | forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM () | 125 | forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM () |
119 | forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) session = do | 126 | forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) session = do |
120 | let addr = ncSockAddr session | 127 | let addr = ncSockAddr session |
@@ -152,6 +159,7 @@ newSessionsState crypto unrechook hooks = do | |||
152 | nick <- atomically $ newTVar B.empty | 159 | nick <- atomically $ newTVar B.empty |
153 | status <- atomically $ newTVar Online | 160 | status <- atomically $ newTVar Online |
154 | statusmsg <- atomically $ newTVar B.empty | 161 | statusmsg <- atomically $ newTVar B.empty |
162 | nospam <- atomically $ newTVar Nothing | ||
155 | grps <- atomically $ newTVar Map.empty | 163 | grps <- atomically $ newTVar Map.empty |
156 | pname <- getProgName | 164 | pname <- getProgName |
157 | cachedir <- sensibleCacheDirCreateIfMissing pname | 165 | cachedir <- sensibleCacheDirCreateIfMissing pname |
@@ -160,6 +168,7 @@ newSessionsState crypto unrechook hooks = do | |||
160 | homedir <- getHomeDirectory | 168 | homedir <- getHomeDirectory |
161 | svDownloadDir0 <- atomically $ newTVar (homedir </> "Downloads") | 169 | svDownloadDir0 <- atomically $ newTVar (homedir </> "Downloads") |
162 | nextSessionId0 <- atomically $ newTVar 0 | 170 | nextSessionId0 <- atomically $ newTVar 0 |
171 | announceNewSessionHooks0 <- atomically $ newTVar [] | ||
163 | return NCSessions { netCryptoSessions = x | 172 | return NCSessions { netCryptoSessions = x |
164 | , netCryptoSessionsByKey = x2 | 173 | , netCryptoSessionsByKey = x2 |
165 | , transportCrypto = crypto | 174 | , transportCrypto = crypto |
@@ -168,6 +177,7 @@ newSessionsState crypto unrechook hooks = do | |||
168 | , sessionView = SessionView { svNick = nick | 177 | , sessionView = SessionView { svNick = nick |
169 | , svStatus = status | 178 | , svStatus = status |
170 | , svStatusMsg = statusmsg | 179 | , svStatusMsg = statusmsg |
180 | , svNoSpam = nospam | ||
171 | , svGroups = grps | 181 | , svGroups = grps |
172 | , svCacheDir = cachedir | 182 | , svCacheDir = cachedir |
173 | , svTmpDir = tmpdir | 183 | , svTmpDir = tmpdir |
@@ -178,6 +188,7 @@ newSessionsState crypto unrechook hooks = do | |||
178 | , inboundQueueCapacity = 200 | 188 | , inboundQueueCapacity = 200 |
179 | , outboundQueueCapacity = 400 | 189 | , outboundQueueCapacity = 400 |
180 | , nextSessionId = nextSessionId0 | 190 | , nextSessionId = nextSessionId0 |
191 | , announceNewSessionHooks = announceNewSessionHooks0 | ||
181 | } | 192 | } |
182 | 193 | ||
183 | data HandshakeParams | 194 | data HandshakeParams |
@@ -355,6 +366,16 @@ freshCryptoSession sessions | |||
355 | case byKeyResult of | 366 | case byKeyResult of |
356 | Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession]) | 367 | Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession]) |
357 | Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs)) | 368 | Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs)) |
369 | -- run announceNewSessionHooks | ||
370 | hooks <- atomically $ readTVar (announceNewSessionHooks sessions) | ||
371 | flip fix (hooks,netCryptoSession) $ \loop (hooks,session) -> | ||
372 | case hooks of | ||
373 | [] -> return () | ||
374 | (h:hs) -> do | ||
375 | r <- h Nothing session | ||
376 | case r of | ||
377 | Just f -> loop (hs, f session) | ||
378 | Nothing -> return () | ||
358 | 379 | ||
359 | -- | Called when we get a handshake, but there's already a session entry. | 380 | -- | Called when we get a handshake, but there's already a session entry. |
360 | updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCryptoSession -> IO () | 381 | updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCryptoSession -> IO () |