1 files changed, 43 insertions, 9 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index dcc63ae0..306433c1 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -62,8 +62,11 @@ data SessionView = SessionView
         , svDownloadDir :: TVar FilePath -- ^ where to put files the user downloads
         }
 
+type SessionID = Word64
 
-data NetCryptoSession = NCrypto { ncState         :: TVar NetCryptoSessionStatus
+data NetCryptoSession = NCrypto { ncState          :: TVar NetCryptoSessionStatus
+                                , ncSessionId      :: SessionID
+                                , ncTheirPublicKey :: PublicKey -- Tox id w/o nospam
                                 , ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number
                                 , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number
                                 , ncHandShake     :: TVar (Maybe (Handshake Encrypted))
@@ -86,7 +89,7 @@ data NetCryptoSession = NCrypto { ncState         :: TVar NetCryptoSessionStatus
                                 , ncView :: TVar SessionView
                                 , ncPacketQueue :: PacketQueue CryptoData
                                 , ncBufferStart :: TVar Word32
-                                , ncDequeueThread :: ThreadId
+                                , ncDequeueThread :: Maybe ThreadId
                                 }
 
 data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
@@ -97,14 +100,34 @@ data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAdd
                                     , sessionView :: SessionView
                                     , msgTypeArray :: MsgTypeArray
                                     , inboundQueueCapacity :: Word32
+                                    , nextSessionId :: TVar SessionID
                                     }
 
+forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM ()
+forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) session = do
+    let addr = ncSockAddr session
+        sid = ncSessionId session
+        sPubKey = ncTheirPublicKey session
+    byAddrMap <- readTVar netCryptoSessions
+ {- byKeyMap  <- readTVar netCryptoSessionsByKey -}
+    case Map.lookup addr byAddrMap of
+        Nothing -> return () -- already gone
+        Just _ -> do
+            modifyTVar netCryptoSessions      (Map.delete addr)
+            modifyTVar netCryptoSessionsByKey (Map.update (\xs -> case filter (\x -> ncSessionId x /= sid) xs of
+                                                                    [] -> Nothing
+                                                                    ys -> Just ys) sPubKey)
+
 -- | initiate a netcrypto session, blocking
 netCrypto :: TransportCrypto -> NetCryptoSessions -> SecretKey -> PublicKey -> IO NetCryptoSession
 netCrypto crypto allsessions myseckey theirpubkey = do
-    -- convert public key to NodeInfo check Roster
-    -- if no session:
-    -- 1) send dht key
+-- convert public key to NodeInfo check Roster
+-- if no session:
+-- 1) send dht key, actually maybe send dht-key regardless
+-- 2) send handshakes to last seen ip's, if any
+--
+-- if sessions found, is it using this private key?
+-- if not, send handshake, this is separate session
     error "todo"
 
 newSessionsState :: TransportCrypto
@@ -124,6 +147,7 @@ newSessionsState crypto unrechook hooks = do
     configdir <- sensibleVarLib pname
     homedir <- getHomeDirectory
     svDownloadDir0 <- atomically $ newTVar (homedir </> "Downloads")
+    nextSessionId0 <- atomically $ newTVar 0
     return NCSessions { netCryptoSessions = x
                       , netCryptoSessionsByKey = x2
                       , transportCrypto = crypto
@@ -140,6 +164,7 @@ newSessionsState crypto unrechook hooks = do
                                                   }
                       , msgTypeArray = allMsgTypes -- todo make this a parameter
                       , inboundQueueCapacity = 200
+                      , nextSessionId = nextSessionId0
                       }
 
 data HandshakeParams
@@ -180,6 +205,8 @@ newHandShakeData crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieR
                 }) freshCookie
 
 -- | called when we recieve a crypto handshake with valid cookie
+-- TODO set priority on contact addr to 0 if it is older than ForgetPeriod,
+-- then increment it regardless. (Keep addr in MinMaxPSQ in Roster.Contact)
 freshCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> IO ()
 freshCryptoSession  sessions
                     addr
@@ -194,6 +221,10 @@ freshCryptoSession  sessions
     let crypto = transportCrypto sessions
         allsessions = netCryptoSessions sessions
         allsessionsByKey = netCryptoSessionsByKey sessions
+    sessionId <- atomically $ do
+        x <- readTVar (nextSessionId sessions)
+        modifyTVar    (nextSessionId sessions) (+1)
+        return x
     ncState0 <- atomically $ newTVar Accepted
     ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce
     n24 <- atomically $ transportNewNonce crypto
@@ -220,6 +251,8 @@ freshCryptoSession  sessions
     bufstart <- atomically $ newTVar 0
     let netCryptoSession0 =
             NCrypto { ncState         = ncState0
+                    , ncSessionId     = sessionId
+                    , ncTheirPublicKey = remotePublicKey
                     , ncTheirBaseNonce= ncTheirBaseNonce0
                     , ncMyPacketNonce   = ncMyPacketNonce0
                     , ncHandShake     = ncHandShake0
@@ -235,16 +268,16 @@ freshCryptoSession  sessions
                     , ncView = ncView0
                     , ncPacketQueue        = pktq
                     , ncBufferStart        = bufstart
-                    , ncDequeueThread      = error "you want the NetCrypto-Dequeue thread id, but is it started?"
+                    , ncDequeueThread      = Nothing -- error "you want the NetCrypto-Dequeue thread id, but is it started?"
                     }
     threadid <- forkIO $ do
         tid <- myThreadId
         labelThread tid ("NetCryptoDequeue." ++ show (key2id remotePublicKey))
         fix $ \loop -> do
             cd <- atomically $ PQ.dequeue pktq
-            _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=tid}) cd
+            _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) cd
             loop
-    let netCryptoSession = netCryptoSession0 {ncDequeueThread=threadid}
+    let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid}
     atomically $ do
         modifyTVar allsessions (Map.insert addr netCryptoSession)
         byKeyResult <- readTVar allsessionsByKey >>= return . Map.lookup remotePublicKey
@@ -298,7 +331,8 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
                 digest = hashFinalize hctx'
             guard (cookieHash == digest)
             -- known friend?
-            -- todo
+            -- todo TODO, see Roster.hs,
+            -- talk to not yet existent Network-Manager to ascertain current permissions
             return
              HParam
                 { hpTheirBaseNonce = Just baseNonce