dhtd & Network.Tox.Crypto.Handlers changes:

        * merge PerSession into NetCryptoSession
        * define defaultUnRecHook function
        * netcrypto command wip for testing
        * update to sessions command

1 files changed, 37 insertions, 47 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 47a4cd46..df8cf1c4 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -107,6 +107,7 @@ import XMPPServer
 import Connection
 import ToxToXMPP
 import qualified Connection.Tcp as Tcp (ConnectionEvent(..))
+import Control.Concurrent.Supply
 
 
 showReport :: [(String,String)] -> String
@@ -396,7 +397,6 @@ data Session = Session
     , userkeys          :: TVar [(SecretKey,PublicKey)]
     , roster            :: Tox.ContactInfo
     , announceToLan     :: IO ()
-    , sessions          :: TVar [PerSession]
     , connectionManager :: Maybe ConnectionManager
     , onionRouter       :: OnionRouter
     , announcer         :: Announcer
@@ -433,7 +433,7 @@ clientSession0 s sock cnum h = do
                                 else throwIO e
 
 readKeys :: TVar [(SecretKey, PublicKey)]
-            -> TVar (HashMap.HashMap Tox.NodeId Account)
+            -> TVar (HashMap.HashMap Tox.NodeId Account) -- ContactInfo { accounts }
             -> STM [(SecretKey, PublicKey)]
 readKeys userkeys roster = do
     uks <- readTVar userkeys
@@ -475,6 +475,7 @@ clientSession s@Session{..} sock cnum h = do
             , ["k"]
             , ["roster"]
             , ["sessions"]
+            , ["netcrypto"]
             , ["onion"]
             , ["g"]
             , ["p"]
@@ -679,17 +680,19 @@ clientSession s@Session{..} sock cnum h = do
                 hPutClientChunk h $ unlines [ dns, "", "Friend Requests" ]
                 hPutClient h $ showReport frs
 
-        ("sessions", s) | "" <- strp s
+        ("sessions", s') | "" <- strp s'
             -> cmd0 $ do
-                sessions' <- atomically $ readTVar sessions :: IO [PerSession]
-                let sessionsReport = mapM showPerSession sessions'
-                    headers = ["Key", "NextMsg", "Dropped","Handled","Unhandled"]
-                    showPerSession (PerSession
-                                        { perSessionMsgs = msgQ
-                                        , perSessionPublicKey = pubKey
-                                        , perSessionAddr = sockAddr
-                                        , perSessionNumVar = msgNumVar
-                                        , perSessionDropCount = dropCntVar
+                sessions <- concat . Map.elems <$> (atomically $ readTVar (Tox.netCryptoSessionsByKey cryptosessions))
+                let sessionsReport = mapM showPerSession sessions
+                    headers = ["SessionID", "YourKey", "TheirKey", "NextMsg", "Dropped","Handled","Unhandled"]
+                    showPerSession (Tox.NCrypto
+                                        { ncSessionId = id
+                                        , ncMyPublicKey = yourkey
+                                        , ncTheirPublicKey = theirkey
+                                        , ncLastNMsgs = msgQ
+                                        , ncSockAddr = sockAddr
+                                        , ncMsgNumVar = msgNumVar
+                                        , ncDropCntVar = dropCntVar
                                         }) = do
                         num <- atomically (readTVar msgNumVar)
                         dropped <- atomically (readTVar dropCntVar)
@@ -697,13 +700,15 @@ clientSession s@Session{..} sock cnum h = do
                         let (h,u) = partition (fst . snd) as
                             countHandled   = length h
                             countUnhandled = length u
-                        return [ show (Tox.key2id pubKey) -- "Key"
+                        return [ printf "%x" id           -- "SessionID"
+                               , show (Tox.key2id yourkey) -- "YourKey"
+                               , show (Tox.key2id theirkey)-- "TheirKey"
                                , show num                 -- "NextMsg"
                                , show dropped             -- "Dropped"
                                , show countHandled        -- "Handled"
                                , show countUnhandled      -- "Unhandled"
                                ]
-                if null sessions'
+                if null sessions
                  then hPutClient h "No sessions."
                  else do
                     rows <- sessionsReport
@@ -724,6 +729,19 @@ clientSession s@Session{..} sock cnum h = do
                 hPutClientChunk h $ "trampolines: " ++ show (IntMap.size ts) ++ "\n"
                 hPutClient h $ showColumns $ ["","responses","timeouts"]:r
 
+        ("netcrypto", s)
+                    | Just DHT{..} <- Map.lookup netname dhts
+                    -> cmd0 $ do
+            case selectedKey of
+                Nothing -> hPutClient h "No key is selected, see k command."
+                Just mypubkey -> do
+                    let nidstr = strp s
+                        goParse = either (hPutClient h . ("Bad netcrypto target: "++))
+                                         goTarget
+                                         $ dhtParseId nidstr
+                        goTarget nid = do
+                            hPutClient h "TODO: convert selected public key to private, call netCrypto.."
+                    goParse
         ("g", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do
                         -- arguments: method
@@ -1258,12 +1276,6 @@ announceToxJabberPeer echan laddr saddr pingflag tsrc tsnk
 
 #endif
 
-data PerSession = PerSession { perSessionMsgs :: PacketQueue (Bool{-Handled?-},Tox.CryptoMessage)
-                             , perSessionPublicKey :: PublicKey
-                             , perSessionAddr :: SockAddr
-                             , perSessionNumVar    :: TVar Word32
-                             , perSessionDropCount :: TVar Word32
-                             }
 
 main :: IO ()
 main = runResourceT $ liftBaseWith $ \resT -> do
@@ -1372,7 +1384,6 @@ main = runResourceT $ liftBaseWith $ \resT -> do
 
     crypto <- Tox.newCrypto
     netCryptoSessionsState <- Tox.newSessionsState crypto Tox.defaultUnRecHook Tox.defaultCryptoDataHooks
-    sessions <- atomically (newTVar []) :: IO (TVar [PerSession])
     (mbtox,quitTox,toxdhts,toxips,(taddrs::[SockAddr])) <- case porttox opts of
         "" -> return (Nothing,return (), Map.empty, return [],[])
         toxport -> do
@@ -1602,16 +1613,6 @@ main = runResourceT $ liftBaseWith $ \resT -> do
             -- allsessionsMap <- atomically $ readTVar (netCryptoSessions netCryptoSessionsState)
             let sockAddr = Tox.ncSockAddr netcrypto
                 pubKey   = Tox.ncTheirPublicKey netcrypto
-            msgQ <- atomically (Data.PacketQueue.newOverwrite 10 0 :: STM (PacketQueue (Bool,Tox.CryptoMessage)))
-            msgNumVar <- atomically (newTVar 0)
-            dropCntVar <- atomically (newTVar 0)
-            let perSession = PerSession { perSessionMsgs = msgQ
-                                        , perSessionPublicKey = pubKey
-                                        , perSessionAddr = sockAddr
-                                        , perSessionNumVar = msgNumVar
-                                        , perSessionDropCount = dropCntVar
-                                        }
-            atomically $ modifyTVar' sessions (perSession:)
             tmchan <- atomically newTMChan
             let Just pingMachine = Tox.ncPingMachine netcrypto
                 pingflag         = readTVar (pingFlag pingMachine)
@@ -1624,21 +1625,11 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                 announceToxJabberPeer (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink
             -- TODO: Update toxContactInfo, connected.
 #endif
-            let handleIncoming typ session cm | any ($ typ) [Tox.isKillPacket, Tox.isOFFLINE] = atomically $ do
-                    closeTMChan tmchan
-                    Tox.forgetCrypto crypto netCryptoSessionsState netcrypto
-                    return Nothing
-                handleIncoming mTyp session cm = do
-                    atomically $ do
-                        num <- readTVar msgNumVar
-                        (wraps,offset) <- enqueue msgQ num (False,cm)
-                        capacity <- getCapacity msgQ
-                        let dropped = wraps * capacity + offset
-                        modifyTVar' msgNumVar (+1)
-                        writeTVar dropCntVar dropped
-                    atomically $ writeTMChan tmchan cm -- (Tox.bufferData cd)
-                    return Nothing
-            atomically $ writeTVar (Tox.ncUnrecognizedHook netcrypto) handleIncoming
+            atomically $ do
+                supply <- readTVar (Tox.listenerIDSupply netCryptoSessionsState)
+                let (listenerId,supply') = freshId supply
+                writeTVar (Tox.listenerIDSupply netCryptoSessionsState) supply'
+                modifyTVar' (Tox.ncListeners netcrypto) (IntMap.insert listenerId (0,tmchan))
             return Nothing
 
     let dhts = Map.union btdhts toxdhts
@@ -1667,7 +1658,6 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                 , userkeys          = toxids
                 , roster            = rstr
                 , announceToLan     = fromMaybe (return ()) $ Tox.toxAnnounceToLan <$> mbtox
-                , sessions          = sessions
                 , connectionManager = ConnectionManager <$> mconns
                 , onionRouter       = orouter
                 , externalAddresses = liftM2 (++) btips toxips