diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 44 |
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 | |||
44 | import Control.Concurrent.Lifted | 44 | import Control.Concurrent.Lifted |
45 | import GHC.Conc (labelThread) | 45 | import GHC.Conc (labelThread) |
46 | #endif | 46 | #endif |
47 | import qualified Data.HashMap.Strict as HashMap | ||
48 | import qualified Data.Vector as V | ||
47 | 49 | ||
48 | import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys) | 50 | import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys) |
49 | import Network.UPNP as UPNP | 51 | import 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 | |||
167 | fallbackLoad 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 | ||
165 | pingNodes :: String -> DHT -> IO Bool | 184 | pingNodes :: String -> DHT -> IO Bool |
166 | pingNodes netname DHT{dhtPing} = do | 185 | pingNodes 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 | |||
607 | main :: IO () | 625 | main :: IO () |
608 | main = do | 626 | main = 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 $ |