summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/dhtd.hs44
1 files changed, 42 insertions, 2 deletions
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
44import Control.Concurrent.Lifted 44import Control.Concurrent.Lifted
45import GHC.Conc (labelThread) 45import GHC.Conc (labelThread)
46#endif 46#endif
47import qualified Data.HashMap.Strict as HashMap
48import qualified Data.Vector as V
47 49
48import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys) 50import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys)
49import Network.UPNP as UPNP 51import Network.UPNP as UPNP
@@ -160,7 +162,24 @@ loadNodes netname = do
160 attempt <- tryIOError $ do 162 attempt <- tryIOError $ do
161 J.decode <$> L.readFile fname 163 J.decode <$> L.readFile fname
162 >>= maybe (ioError $ userError "Nothing") return 164 >>= maybe (ioError $ userError "Nothing") return
163 either (const $ return []) return attempt 165 either (const $ fallbackLoad fname) return attempt
166
167fallbackLoad fname = do
168 attempt <- tryIOError $ do
169 J.decode <$> L.readFile fname
170 >>= maybe (ioError $ userError "Nothing") return
171 let go r = do
172 let m = HashMap.lookup "nodes" (r :: J.Object)
173 ns0 = case m of Just (J.Array v) -> V.toList v
174 Nothing -> []
175 ns1 = zip (map J.fromJSON ns0) ns0
176 issuc (J.Error _,_) = False
177 issuc _ = True
178 (ss,fs) = partition issuc ns1
179 ns = map (\(J.Success n,_) -> n) ss
180 mapM_ print (map snd fs) >> return ns
181 either (const $ return []) go attempt
182
164 183
165pingNodes :: String -> DHT -> IO Bool 184pingNodes :: String -> DHT -> IO Bool
166pingNodes netname DHT{dhtPing} = do 185pingNodes netname DHT{dhtPing} = do
@@ -603,7 +622,6 @@ parseArgs (arg:args) opts = parseArgs args opts
603 . break (=='=') ) 622 . break (=='=') )
604 $ groupBy (const (/= ',')) arg 623 $ groupBy (const (/= ',')) arg
605 624
606
607main :: IO () 625main :: IO ()
608main = do 626main = do
609 args <- getArgs 627 args <- getArgs
@@ -752,6 +770,28 @@ main = do
752 pubkey <- Tox.id2key <$> readEither str 770 pubkey <- Tox.id2key <$> readEither str
753 Right (pubkey :: PublicKey, ()) 771 Right (pubkey :: PublicKey, ())
754 return r 772 return r
773 })
774 , ("friend", DHTAnnouncable { announceSendData = \(pubkey,nospam) -> \case
775 Just addr -> do
776 let fr = Tox.FriendRequest nospam txt
777 -- nospam = 0xD64A8B00
778 txt = "Testing Friend Request!"
779 sendMessage
780 (Tox.toxToRoute tox)
781 (addr :: Tox.AnnouncedRendezvous)
782 (pubkey,Tox.OnionFriendRequest fr)
783 return $ Just ()
784 Nothing -> return Nothing
785 , announceParseAddress = readEither
786 , announceParseData = \str nospamstr -> do
787 r <- return $ do
788 pubkey <- Tox.id2key <$> readEither str
789 Tox.NoSpam nospam chksum <- readEither nospamstr
790 maybe (Right ())
791 (Tox.verifyChecksum pubkey)
792 chksum
793 Right (pubkey :: PublicKey, nospam)
794 return r
755 })] 795 })]
756 } 796 }
757 dhts = Map.fromList $ 797 dhts = Map.fromList $