summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Crypto
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Crypto')
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs23
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
6import Network.Tox.NodeId 6import Network.Tox.NodeId
7import Network.Tox.Crypto.Transport 7import Network.Tox.Crypto.Transport
8import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..)) 8import Network.Tox.DHT.Transport (Cookie(..),CookieData(..), CookieRequest(..), NoSpam(..))
9import Network.Tox.DHT.Handlers (Client, cookieRequest, cookieRequestH ) 9import Network.Tox.DHT.Handlers (Client, cookieRequest, cookieRequestH )
10import Crypto.Tox 10import Crypto.Tox
11import Control.Concurrent.STM 11import 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
120type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession
121
122addNewSessionHook :: NetCryptoSessions -> NewSessionHook -> STM ()
123addNewSessionHook allsessions@(NCSessions { announceNewSessionHooks }) hook = modifyTVar announceNewSessionHooks (hook:)
124
118forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM () 125forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM ()
119forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) session = do 126forgetCrypto 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
183data HandshakeParams 194data 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.
360updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCryptoSession -> IO () 381updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCryptoSession -> IO ()