summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2018-05-29 23:32:01 +0000
committerJames Crayne <jim.crayne@gmail.com>2018-05-29 23:32:01 +0000
commit55533838c0089fb94dd4f007d4e3f0b676a8ffc4 (patch)
treed18d214c6eb5ee53239a6a51f74b8843a2514c25 /examples/dhtd.hs
parent037981b15324ca3c1d4f560b928228be43f0729c (diff)
netcrypto command should not use dhtParseId
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs18
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
406exceptionsToClient :: ClientHandle -> IO () -> IO () 407exceptionsToClient :: 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