From 514d0cad3f2ccaf0e89aadb4ab3067884ec20a6c Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 30 May 2018 23:53:44 -0400 Subject: tox: Removed obsolete "userKeys" TVar, use keys from ContactInfo. --- examples/dhtd.hs | 35 +++++++++++------------------------ 1 file changed, 11 insertions(+), 24 deletions(-) (limited to 'examples/dhtd.hs') 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 -- cgit v1.2.3