diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 54 |
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 () |
1234 | netcrypto dht selectedKey h roster mbTox keystr | Just DHT{..} <- dht = do | 1234 | netcrypto _ _ h _ Nothing _ = hPutClient h "Requires Tox enabled." |
1235 | case selectedKey of | 1235 | netcrypto _ Nothing h _ _ _ = hPutClient h "No key is selected, see k command." |
1236 | Nothing -> hPutClient h "No key is selected, see k command." | 1236 | netcrypto 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 | ||
1278 | readExternals :: (ni -> SockAddr) -> [TVar (BucketList ni)] -> IO [SockAddr] | 1272 | readExternals :: (ni -> SockAddr) -> [TVar (BucketList ni)] -> IO [SockAddr] |
1279 | readExternals nodeAddr vars = do | 1273 | readExternals nodeAddr vars = do |