From 50d3bb1fc90c4d83d390fa2c5b328935d0ffed1d Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 26 Oct 2017 21:18:26 -0400 Subject: Publish method to send Tox friend-request. --- examples/dhtd.hs | 44 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) (limited to 'examples/dhtd.hs') diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 4dad2fe7..ea2b3459 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -44,6 +44,8 @@ import Control.Concurrent.Lifted.Instrument import Control.Concurrent.Lifted import GHC.Conc (labelThread) #endif +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Vector as V import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys) import Network.UPNP as UPNP @@ -160,7 +162,24 @@ loadNodes netname = do attempt <- tryIOError $ do J.decode <$> L.readFile fname >>= maybe (ioError $ userError "Nothing") return - either (const $ return []) return attempt + either (const $ fallbackLoad fname) return attempt + +fallbackLoad fname = do + attempt <- tryIOError $ do + J.decode <$> L.readFile fname + >>= maybe (ioError $ userError "Nothing") return + let go r = do + let m = HashMap.lookup "nodes" (r :: J.Object) + ns0 = case m of Just (J.Array v) -> V.toList v + Nothing -> [] + ns1 = zip (map J.fromJSON ns0) ns0 + issuc (J.Error _,_) = False + issuc _ = True + (ss,fs) = partition issuc ns1 + ns = map (\(J.Success n,_) -> n) ss + mapM_ print (map snd fs) >> return ns + either (const $ return []) go attempt + pingNodes :: String -> DHT -> IO Bool pingNodes netname DHT{dhtPing} = do @@ -603,7 +622,6 @@ parseArgs (arg:args) opts = parseArgs args opts . break (=='=') ) $ groupBy (const (/= ',')) arg - main :: IO () main = do args <- getArgs @@ -752,6 +770,28 @@ main = do pubkey <- Tox.id2key <$> readEither str Right (pubkey :: PublicKey, ()) return r + }) + , ("friend", DHTAnnouncable { announceSendData = \(pubkey,nospam) -> \case + Just addr -> do + let fr = Tox.FriendRequest nospam txt + -- nospam = 0xD64A8B00 + txt = "Testing Friend Request!" + sendMessage + (Tox.toxToRoute tox) + (addr :: Tox.AnnouncedRendezvous) + (pubkey,Tox.OnionFriendRequest fr) + return $ Just () + Nothing -> return Nothing + , announceParseAddress = readEither + , announceParseData = \str nospamstr -> do + r <- return $ do + pubkey <- Tox.id2key <$> readEither str + Tox.NoSpam nospam chksum <- readEither nospamstr + maybe (Right ()) + (Tox.verifyChecksum pubkey) + chksum + Right (pubkey :: PublicKey, nospam) + return r })] } dhts = Map.fromList $ -- cgit v1.2.3