diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 6b8954d1..ec6c89f1 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -401,6 +401,7 @@ data Session = Session | |||
401 | , onionRouter :: OnionRouter | 401 | , onionRouter :: OnionRouter |
402 | , announcer :: Announcer | 402 | , announcer :: Announcer |
403 | , signalQuit :: IO () | 403 | , signalQuit :: IO () |
404 | , mbTox :: Maybe Tox.Tox | ||
404 | } | 405 | } |
405 | 406 | ||
406 | exceptionsToClient :: ClientHandle -> IO () -> IO () | 407 | exceptionsToClient :: ClientHandle -> IO () -> IO () |
@@ -784,14 +785,22 @@ clientSession s@Session{..} sock cnum h = do | |||
784 | Nothing -> hPutClient h "No key is selected, see k command." | 785 | Nothing -> hPutClient h "No key is selected, see k command." |
785 | Just mypubkey -> do | 786 | Just mypubkey -> do |
786 | let nidstr = strp s | 787 | let nidstr = strp s |
787 | goParse = either (hPutClient h . ("Bad netcrypto target: "++)) | 788 | goParse = either |
788 | goTarget | 789 | (hPutClient h . ("Bad netcrypto target: "++)) |
789 | $ dhtParseId nidstr | 790 | (goTarget . Tox.id2key) |
791 | $ readEither nidstr | ||
790 | goTarget nid = do | 792 | goTarget nid = do |
791 | msec <- atomically $ do | 793 | msec <- atomically $ do |
792 | ks <- map swap <$> readKeys userkeys (accounts roster) | 794 | ks <- map swap <$> readKeys userkeys (accounts roster) |
793 | return $ Data.List.lookup mypubkey ks | 795 | return $ Data.List.lookup mypubkey ks |
794 | hPutClient h "TODO: convert selected public key to private, call netCrypto.." | 796 | case mbTox of |
797 | Nothing -> hPutClient h "Requires Tox enabled." | ||
798 | Just tox-> do | ||
799 | case msec of | ||
800 | Nothing -> hPutClient h "Error getting secret key" | ||
801 | Just sec -> do | ||
802 | Tox.netCrypto tox sec nid | ||
803 | hPutClient h "Handshake sent" | ||
795 | goParse | 804 | goParse |
796 | ("g", s) | Just DHT{..} <- Map.lookup netname dhts | 805 | ("g", s) | Just DHT{..} <- Map.lookup netname dhts |
797 | -> cmd0 $ do | 806 | -> cmd0 $ do |
@@ -1715,6 +1724,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do | |||
1715 | , onionRouter = orouter | 1724 | , onionRouter = orouter |
1716 | , externalAddresses = liftM2 (++) btips toxips | 1725 | , externalAddresses = liftM2 (++) btips toxips |
1717 | , announcer = announcer | 1726 | , announcer = announcer |
1727 | , mbTox = mbtox | ||
1718 | } | 1728 | } |
1719 | srv <- streamServer (withSession session) (SockAddrUnix "dht.sock") | 1729 | srv <- streamServer (withSession session) (SockAddrUnix "dht.sock") |
1720 | return ( do atomically $ readTVar signalQuit >>= check | 1730 | return ( do atomically $ readTVar signalQuit >>= check |