From 9eef4cbd00586df2fad36f3cab3d04b807b92e2f Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 31 Oct 2017 17:42:15 -0400 Subject: WIP: a command (recurring announcements) (Part 4) --- examples/dhtd.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'examples/dhtd.hs') diff --git a/examples/dhtd.hs b/examples/dhtd.hs index fa4ce95b..931e1ba0 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -311,6 +311,8 @@ forkSearch method nid DHTQuery{qsearch,qshowTok,qshowR} dhtSearches dhtBuckets , searchResults = results } modifyTVar' dhtSearches $ Map.insert (method,nid) new + -- Finally, we write the search loop action into a tvar that will be executed in a new + -- thread. writeTVar kvar $ Just $ searchLoop qsearch nid storeResult st reportSearchResults :: (Show t, Ord t1, Ord t, Hashable t) => @@ -552,10 +554,10 @@ clientSession s@Session{..} sock cnum h = do (dtastr,ys) = break isSpace $ dropWhile isSpace xs a = Map.lookup method dhtAnnouncables q = Map.lookup method dhtQuery - doit :: Char -> proxy ni -> Announcer -> AnnounceMethod ni r -> r -> IO () + doit :: Char -> proxy ni -> Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO () doit '+' _ = schedule doit '-' _ = cancel - doit _ _ = \_ _ _ -> hPutClient h "Starting(+) or canceling(-)?" + doit _ _ = \_ _ _ _ -> hPutClient h "Starting(+) or canceling(-)?" matchingResult :: ( Typeable sr , Typeable stok @@ -573,9 +575,12 @@ clientSession s@Session{..} sock cnum h = do DHTQuery { qsearch } <- q (Refl,Refl,nr@Refl) <- matchingResult qsearch announceSendData dta <- either (const Nothing) Just $ announceParseData dtastr - return $ doit op nr announcer - (AnnounceMethod qsearch announceSendData) - dta + return $ do + akey <- atomically $ packAnnounceKey announcer (method ++ ":" ++ dtastr) + doit op nr announcer + akey + (AnnounceMethod qsearch announceSendData) + dta fromMaybe (hPutClient h "error.") mameth ("s", s) | Just dht@DHT{..} <- Map.lookup netname dhts -- cgit v1.2.3