From 3c76544afbd017a4704e62c67cf1a21def6324ad Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Thu, 10 Sep 2020 12:00:17 +0200 Subject: [PATCH 1/3] launch background worker threads --- src/Hash2Pub/PostService.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 608551f..b943ea6 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -121,8 +121,8 @@ instance DHT d => Service PostService d where -- web server (Warp.runSettings warpSettings $ postServiceApplication thisService) $ concurrently - -- post queue processing - (processIncomingPosts thisService) + -- background processing workers + (launchWorkerThreads thisService) -- statistics/ measurements (launchStatsThreads thisService) -- update thread ID after fork @@ -604,6 +604,12 @@ instance {-# OVERLAPPABLE #-} Read a => MimeUnrender PlainText a where -- TODO: make configurable numParallelDeliveries = 10 +launchWorkerThreads :: DHT d => PostService d -> IO () +launchWorkerThreads serv = concurrently_ + (processIncomingPosts serv) + $ concurrently_ + (fetchTagPosts serv) + (relayWorker serv) -- | process the pending relay inbox of incoming posts from the internal queue: -- Look up responsible relay node for given hashtag and forward post to it From 3ac89d301c9755cab1ccedc548fd1e62a8c48d7c Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Thu, 10 Sep 2020 13:09:28 +0200 Subject: [PATCH 2/3] bugfix: subscribe as default if not subscribed yet, when posting to a tag --- src/Hash2Pub/PostService.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index b943ea6..d84b58b 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -611,6 +611,7 @@ launchWorkerThreads serv = concurrently_ (fetchTagPosts serv) (relayWorker serv) + -- | process the pending relay inbox of incoming posts from the internal queue: -- Look up responsible relay node for given hashtag and forward post to it processIncomingPosts :: DHT d => PostService d -> IO () @@ -642,7 +643,7 @@ processIncomingPosts serv = forever $ do now <- getPOSIXTime subscriptionStatus <- HMap.lookup (hashtagToId tag) <$> readTVarIO (ownSubscriptions serv) -- if not yet subscribed or subscription expires within 2 minutes, (re)subscribe to tag - when (maybe False (\subLease -> now - subLease < 120) subscriptionStatus) $ + when (maybe True (\subLease -> now - subLease < 120) subscriptionStatus) $ void $ clientSubscribeTo serv tag -- for evaluation, return the tag of the successfully forwarded post From 8f917130c495d932ae7132a88710a83964bb6a10 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Thu, 10 Sep 2020 13:14:48 +0200 Subject: [PATCH 3/3] tag normalisation includes lower case conversion --- Hash2Pub.cabal | 2 +- src/Hash2Pub/PostService.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Hash2Pub.cabal b/Hash2Pub.cabal index 5e8d25d..f7a1676 100644 --- a/Hash2Pub.cabal +++ b/Hash2Pub.cabal @@ -47,7 +47,7 @@ extra-source-files: CHANGELOG.md common deps build-depends: base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, stm, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order, safe, iproute, mtl, random, servant, servant-server, servant-client, warp, text, unordered-containers, hashable, unicode-transforms, http-client, http-types, unbounded-delays, dlist - ghc-options: -Wall -Wpartial-fields -O2 + ghc-options: -Wall -Wpartial-fields diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index d84b58b..7a082d0 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -559,9 +559,9 @@ lookupTagSubscriptions :: Hashtag -> RingMap NodeID a -> Maybe a lookupTagSubscriptions tag = rMapLookup (hashtagToId tag) --- normalise the unicode representation of a string to NFC +-- normalise the unicode representation of a string to NFC and convert to lower case normaliseTag :: Text -> Text -normaliseTag = Txt.fromStrict . normalize NFC . Txt.toStrict +normaliseTag = Txt.toLower . Txt.fromStrict . normalize NFC . Txt.toStrict -- | convert a hashtag to its representation on the DHT