6 files changed, 28 insertions, 32 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index b24a90fb..09817d4e 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -412,7 +412,6 @@ data Session = Session
     , swarms            :: Mainline.SwarmsDatabase
     , cryptosessions    :: Tox.NetCryptoSessions
     , toxkeys           :: TVar Tox.AnnouncedKeys
-    , userkeys          :: TVar [(SecretKey,PublicKey)]
     , roster            :: Tox.ContactInfo
     , announceToLan     :: IO ()
     , connectionManager :: Maybe ConnectionManager
@@ -451,13 +450,6 @@ clientSession0 s sock cnum h = do
   `catch` \e -> if isEOFError e then return ()
                                 else throwIO e
 
-readKeys :: TVar [(SecretKey, PublicKey)]
-            -> TVar (HashMap.HashMap Tox.NodeId Account) -- ContactInfo { accounts }
-            -> STM [(SecretKey, PublicKey)]
-readKeys userkeys roster = do
-    uks <- readTVar userkeys
-    as <- readTVar roster
-    return $ uks ++ map ((userSecret *** Tox.id2key) . swap) (HashMap.toList as)
 
 clientSession :: Session -> t1 -> t -> ClientHandle -> IO ()
 clientSession s@Session{..} sock cnum h = do
@@ -644,7 +636,7 @@ clientSession s@Session{..} sock cnum h = do
         --      k secrets          (list key pairs, including secret keys)
 
         ("k", s) | ""           <- strp s -> cmd0 $ do
-                        ks <- atomically $ readKeys userkeys (accounts roster)
+                        ks <- atomically $ myKeyPairs roster
                         let spaces k | Just sel <- selectedKey, (sel == k) = " *"
                                      | otherwise                           = "  "
                         hPutClient h $ unlines $ map (\(_,k) -> mappend (spaces k) . show . Tox.key2id $ k) ks
@@ -652,8 +644,7 @@ clientSession s@Session{..} sock cnum h = do
                         secret <- generateSecretKey
                         let pubkey = toPublic secret
                         oldks <- atomically $ do
-                            ks <- readTVar userkeys
-                            modifyTVar userkeys ((secret,pubkey):)
+                            ks <- myKeyPairs roster
                             Tox.addContactInfo roster secret
                             return ks
                         let asString = show . Tox.key2id
@@ -661,14 +652,14 @@ clientSession s@Session{..} sock cnum h = do
                                                   ++ [mappend " *" . show . Tox.key2id $ pubkey]
                         switchKey $ Just pubkey
                  | "secrets"    <- strp s -> cmd0 $ do
-                        ks <- atomically $ readKeys userkeys (accounts roster)
+                        ks <- atomically $ myKeyPairs roster
                         skey <- maybe (return Nothing) (atomically . dhtSecretKey)
                                       $ Map.lookup netname dhts
                         hPutClient h . showReport $ map mkrow ks ++ case skey >>= encodeSecret of
                             Just x  -> [("",""),("dht-key:",B.unpack x)]
                             Nothing -> []
                  | ("sel",_:expr) <- break isSpace s -> do
-                         ks <- atomically $ map (show . Tox.key2id . snd) <$> readKeys userkeys (accounts roster)
+                         ks <- atomically $ map (show . Tox.key2id . snd) <$> myKeyPairs roster
                          case find (isInfixOf expr) ks of
                             Just k -> do
                                 hPutClient h $ "Selected key: "++k
@@ -682,8 +673,7 @@ clientSession s@Session{..} sock cnum h = do
                         let toPair x = (x,toPublic x)
                             pairs = map (toPair . f) mbSecs
                         oldks <- atomically $ do
-                            oldks <- readTVar userkeys
-                            modifyTVar userkeys (pairs ++)
+                            oldks <- myKeyPairs roster
                             forM pairs $ \(sk,_) -> Tox.addContactInfo roster sk
                             return oldks
                         hPutClient h $ unlines $ map (mappend "  " . show . Tox.key2id . snd) oldks
@@ -697,9 +687,8 @@ clientSession s@Session{..} sock cnum h = do
                         let toPair x = (x,toPublic x)
                             pairs = map (toPair . f) mbSecs
                         ks <- atomically $ do
-                            modifyTVar userkeys (filter (`notElem` pairs) )
                             forM pairs $ \(_,pk) -> Tox.delContactInfo roster pk
-                            readTVar userkeys
+                            myKeyPairs roster
                         hPutClient h . showReport $ map mkrow ks
                         switchKey $ do
                             k <- selectedKey
@@ -946,7 +935,7 @@ clientSession s@Session{..} sock cnum h = do
                                          $ readEither nidstr
                         goTarget (Left nodeinfo) = do
                             msec <- atomically $ do
-                                ks <- map swap <$> readKeys userkeys (accounts roster)
+                                ks <- map swap <$> myKeyPairs roster
                                 return $ Data.List.lookup mypubkey ks
                             case mbTox of
                                 Nothing -> hPutClient h "Requires Tox enabled."
@@ -966,7 +955,7 @@ clientSession s@Session{..} sock cnum h = do
                                                     hPutClient h "Handshake sent"
                         goTarget (Right nid) = do
                             msec <- atomically $ do
-                                ks <- map swap <$> readKeys userkeys (accounts roster)
+                                ks <- map swap <$> myKeyPairs roster
                                 return $ Data.List.lookup mypubkey ks
                             case mbTox of
                                 Nothing -> hPutClient h "Requires Tox enabled."
@@ -1931,13 +1920,12 @@ main = runResourceT $ liftBaseWith $ \resT -> do
         installHandler sigTERM (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing
         installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing
         let defaultToxData = do
-                toxids <- atomically $ newTVar []
                 rster <- Tox.newContactInfo
                 orouter <- newOnionRouter (hPutStrLn stderr)
-                return (toxids, rster, orouter)
-        (toxids,rstr,orouter) <- fromMaybe defaultToxData $ do
+                return (rster, orouter)
+        (rstr,orouter) <- fromMaybe defaultToxData $ do
             tox <- mbtox
-            return $ return ( userKeys (Tox.toxCryptoKeys tox), Tox.toxContactInfo tox, Tox.toxOnionRoutes tox )
+            return $ return ( Tox.toxContactInfo tox, Tox.toxOnionRoutes tox )
         let session = clientSession0 $ Session
                 { netname           = concat $ take 1 $ Map.keys dhts -- initial default DHT
                 , selectedKey       = Nothing
@@ -1946,7 +1934,6 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                 , swarms            = swarms
                 , cryptosessions    = netCryptoSessionsState
                 , toxkeys           = keysdb
-                , userkeys          = toxids
                 , roster            = rstr
                 , announceToLan     = fromMaybe (return ()) $ Tox.toxAnnounceToLan <$> mbtox
                 , connectionManager = ConnectionManager <$> mconns
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index acb98e3e..864e17df 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -527,7 +527,7 @@ data TransportCrypto = TransportCrypto
     , rendezvousPublic :: PublicKey
     , transportSymmetric :: STM SymmetricKey
     , transportNewNonce :: STM Nonce24
-    , userKeys :: TVar [(SecretKey,PublicKey)]
+    , userKeys :: STM [(SecretKey,PublicKey)]
     , pendingCookies :: TVar [(SockAddr, (Int, PublicKey))]
     , secretsCache :: SecretsCache
     }
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index a3291a0f..69982c81 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -145,7 +145,7 @@ newCrypto = do
             let (nonce, drg2) = withDRG drg1 (Nonce24 <$> getRandomBytes 24)
             writeTVar noncevar drg2
             return nonce
-        , userKeys = ukeys
+        , userKeys = return []
         , pendingCookies = cookieKeys
         , secretsCache = cache
         }
@@ -415,11 +415,13 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
                                     return (crypto,sessionsState)
                                  Just s -> return (transportCrypto s, s)
 
+    roster <- newContactInfo
     let crypto = fromMaybe crypto0 $do
             k <- suppliedDHTKey
             return crypto0
                 { transportSecret = k
                 , transportPublic = toPublic k
+                , userKeys = myKeyPairs roster
                 }
     forM_ suppliedDHTKey $ \k -> do
         maybe (hPutStrLn stderr "failed to encode suppliedDHTKey")
@@ -433,7 +435,8 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
     let ignoreErrors _ = return () -- Set this to (hPutStrLn stderr) to debug onion route building.
     orouter <- newOnionRouter ignoreErrors
     (dhtcrypt,onioncrypt,dtacrypt,cryptonet) <- toxTransport crypto orouter lookupClose udp
-    let sessionsState = sessionsState0 { sessionTransport = cryptonet }
+    let sessionsState = sessionsState0 { sessionTransport = cryptonet
+                                       , transportCrypto = crypto }
     let dhtnet0 = layerTransportM (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt
         tbl4 = DHT.routing4 $ mkrouting (error "missing client")
         tbl6 = DHT.routing6 $ mkrouting (error "missing client")
@@ -453,7 +456,6 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
                     (hookQueries orouter DHT.transactionKey)
                     (const id)
 
-    roster <- newContactInfo
     return Tox
         { toxDHT            = dhtclient
         , toxOnion          = onionclient
diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
index d9d9a510..df3365a2 100644
--- a/src/Network/Tox/ContactInfo.hs
+++ b/src/Network/Tox/ContactInfo.hs
@@ -12,10 +12,11 @@ import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe
 import qualified Data.Set            as Set
          ;import Data.Set            (Set)
+import Network.Socket
 import Network.Tox.DHT.Transport     as DHT
+import Network.Tox.NodeId            (id2key)
 import Network.Tox.Onion.Transport   as Onion
 import System.IO
-import Network.Socket
 
 newtype ContactInfo = ContactInfo
       -- | Map our toxid public key to an Account record.
@@ -150,3 +151,9 @@ friendRequests (ContactInfo roster) = do
                                $ HashMap.toList cs
         return remotes
 
+myKeyPairs :: ContactInfo -> STM [(SecretKey,PublicKey)]
+myKeyPairs (ContactInfo accounts) = do
+    acnts <- readTVar accounts
+    forM (HashMap.toList acnts) $ \(nid, Account{userSecret}) -> do
+        return (userSecret,id2key nid)
+
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 95cb1bc8..9e5bd94e 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -543,7 +543,7 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
         allsessions = netCryptoSessions sessions
         anyRight [] f     = return $ Left "missing key"
         anyRight (x:xs) f = f x >>= either (const $ anyRight xs f) (return . Right)
-    seckeys <- map fst <$> atomically (readTVar (userKeys crypto))
+    seckeys <- map fst <$> atomically (userKeys crypto)
     symkey <- atomically $ transportSymmetric crypto
     now <- getPOSIXTime
     dput XNetCrypto ("Decrypt cookie with n24=" ++ show n24 ++ "\n    symkey= " ++ show symkey)
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 550a7730..d604a5c8 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -848,7 +848,7 @@ instance Read AnnouncedRendezvous where
 selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector
 selectAlias crypto pkey = do
         ks <- filter (\(sk,pk) -> pk == id2key pkey)
-                                <$> readTVar (userKeys crypto)
+                                <$> userKeys crypto
         maybe (return SearchingAlias)
               (return . uncurry AnnouncingAlias)
               (listToMaybe ks)
@@ -859,7 +859,7 @@ parseDataToRoute
          -> (OnionMessage Encrypted,OnionDestination r)
          -> IO (Either ((PublicKey,OnionData),AnnouncedRendezvous) (OnionMessage Encrypted, OnionDestination r))
 parseDataToRoute crypto (OnionToRouteResponse dta, od) = do
-  ks <- atomically $ readTVar $ userKeys crypto
+  ks <- atomically $ userKeys crypto
 
   omsg0 <- decryptMessage crypto (rendezvousSecret crypto,rendezvousPublic crypto)
                                 (asymmNonce dta)