summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs54
1 files changed, 24 insertions, 30 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 000583c5..fe639af1 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1231,49 +1231,43 @@ netcrypto
1231 -> Maybe (Tox.Tox extra2) 1231 -> Maybe (Tox.Tox extra2)
1232 -> String 1232 -> String
1233 -> IO () 1233 -> IO ()
1234netcrypto dht selectedKey h roster mbTox keystr | Just DHT{..} <- dht = do 1234netcrypto _ _ h _ Nothing _ = hPutClient h "Requires Tox enabled."
1235 case selectedKey of 1235netcrypto _ Nothing h _ _ _ = hPutClient h "No key is selected, see k command."
1236 Nothing -> hPutClient h "No key is selected, see k command." 1236netcrypto dht (Just mypubkey) h roster (Just tox) keystr | Just DHT{..} <- dht = do
1237 Just mypubkey -> do
1238 let goParse = either 1237 let goParse = either
1239 (\_ -> either (hPutClient h . ("Bad netcrypto target: "++)) 1238 (\_ -> either (hPutClient h . ("Bad netcrypto target: "++))
1240 (goTarget . Left) 1239 (goTarget . Left)
1241 (readEither keystr)) -- attempt read as NodeInfo type 1240 (readEither keystr)) -- attempt read as NodeInfo type
1242 (goTarget . Right . Tox.id2key) 1241 (goTarget . Right . Tox.id2key)
1243 $ readEither keystr -- attempt read as NodeId type 1242 $ readEither keystr -- attempt read as NodeId type
1243 goParse
1244 where
1244 goTarget (Left userkey_nodeinfo) = do 1245 goTarget (Left userkey_nodeinfo) = do
1245 msec <- atomically $ do 1246 msec <- atomically $ do
1246 fmap userSecret . HashMap.lookup (Tox.key2id mypubkey) <$> readTVar (accounts roster) 1247 fmap userSecret . HashMap.lookup (Tox.key2id mypubkey) <$> readTVar (accounts roster)
1247 case mbTox of 1248 case msec of
1248 Nothing -> hPutClient h "Requires Tox enabled." 1249 Nothing -> hPutClient h "Error getting secret key"
1249 Just tox-> do 1250 Just sec -> do
1250 case msec of 1251 let their_pub = Tox.id2key $ Tox.nodeId userkey_nodeinfo
1251 Nothing -> hPutClient h "Error getting secret key" 1252 their_addr = Tox.nodeAddr userkey_nodeinfo
1252 Just sec -> do 1253 let acsVar = accounts (Tox.toxContactInfo tox)
1253 let their_pub = Tox.id2key $ Tox.nodeId userkey_nodeinfo 1254 acsmap <- atomically $ readTVar acsVar
1254 their_addr = Tox.nodeAddr userkey_nodeinfo 1255 case HashMap.lookup (Tox.key2id mypubkey) acsmap of
1255 let acsVar = accounts (Tox.toxContactInfo tox) 1256 Nothing -> hPutClient h "Unable to find account for selected key"
1256 acsmap <- atomically $ readTVar acsVar 1257 Just account -> do
1257 case HashMap.lookup (Tox.key2id mypubkey) acsmap of 1258 now <- getPOSIXTime
1258 Nothing -> hPutClient h "Unable to find account for selected key" 1259 atomically $ setContactAddr now their_pub their_addr account
1259 Just account -> do 1260 Tox.netCrypto tox sec their_pub
1260 now <- getPOSIXTime 1261 hPutClient h "Handshake sent"
1261 atomically $ setContactAddr now their_pub their_addr account
1262 Tox.netCrypto tox sec their_pub
1263 hPutClient h "Handshake sent"
1264 goTarget (Right their_pub) = do 1262 goTarget (Right their_pub) = do
1265 msec <- atomically $ do 1263 msec <- atomically $ do
1266 ks <- map swap <$> myKeyPairs roster 1264 ks <- map swap <$> myKeyPairs roster
1267 return $ Data.List.lookup mypubkey ks 1265 return $ Data.List.lookup mypubkey ks
1268 case mbTox of 1266 case msec of
1269 Nothing -> hPutClient h "Requires Tox enabled." 1267 Nothing -> hPutClient h "Error getting secret key"
1270 Just tox-> do 1268 Just sec -> do
1271 case msec of 1269 Tox.netCrypto tox sec their_pub
1272 Nothing -> hPutClient h "Error getting secret key" 1270 hPutClient h "Handshake sent"
1273 Just sec -> do
1274 Tox.netCrypto tox sec their_pub
1275 hPutClient h "Handshake sent"
1276 goParse
1277 1271
1278readExternals :: (ni -> SockAddr) -> [TVar (BucketList ni)] -> IO [SockAddr] 1272readExternals :: (ni -> SockAddr) -> [TVar (BucketList ni)] -> IO [SockAddr]
1279readExternals nodeAddr vars = do 1273readExternals nodeAddr vars = do