Compare commits
3 commits
f8d30d0cc4
...
8f917130c4
Author | SHA1 | Date | |
---|---|---|---|
8f917130c4 | |||
3ac89d301c | |||
3c76544afb |
2 changed files with 13 additions and 6 deletions
|
@ -47,7 +47,7 @@ extra-source-files: CHANGELOG.md
|
||||||
|
|
||||||
common deps
|
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
|
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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -121,8 +121,8 @@ instance DHT d => Service PostService d where
|
||||||
-- web server
|
-- web server
|
||||||
(Warp.runSettings warpSettings $ postServiceApplication thisService)
|
(Warp.runSettings warpSettings $ postServiceApplication thisService)
|
||||||
$ concurrently
|
$ concurrently
|
||||||
-- post queue processing
|
-- background processing workers
|
||||||
(processIncomingPosts thisService)
|
(launchWorkerThreads thisService)
|
||||||
-- statistics/ measurements
|
-- statistics/ measurements
|
||||||
(launchStatsThreads thisService)
|
(launchStatsThreads thisService)
|
||||||
-- update thread ID after fork
|
-- update thread ID after fork
|
||||||
|
@ -559,9 +559,9 @@ lookupTagSubscriptions :: Hashtag -> RingMap NodeID a -> Maybe a
|
||||||
lookupTagSubscriptions tag = rMapLookup (hashtagToId tag)
|
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 :: 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
|
-- | convert a hashtag to its representation on the DHT
|
||||||
|
@ -604,6 +604,13 @@ instance {-# OVERLAPPABLE #-} Read a => MimeUnrender PlainText a where
|
||||||
-- TODO: make configurable
|
-- TODO: make configurable
|
||||||
numParallelDeliveries = 10
|
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:
|
-- | 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
|
-- Look up responsible relay node for given hashtag and forward post to it
|
||||||
|
@ -636,7 +643,7 @@ processIncomingPosts serv = forever $ do
|
||||||
now <- getPOSIXTime
|
now <- getPOSIXTime
|
||||||
subscriptionStatus <- HMap.lookup (hashtagToId tag) <$> readTVarIO (ownSubscriptions serv)
|
subscriptionStatus <- HMap.lookup (hashtagToId tag) <$> readTVarIO (ownSubscriptions serv)
|
||||||
-- if not yet subscribed or subscription expires within 2 minutes, (re)subscribe to tag
|
-- 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
|
void $ clientSubscribeTo serv tag
|
||||||
|
|
||||||
-- for evaluation, return the tag of the successfully forwarded post
|
-- for evaluation, return the tag of the successfully forwarded post
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue