schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

send fetchable post URIs as ID

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-08-21 23:47:42 +02:00
parent 5511026c8d
commit 75c1932ef6
1 changed files with 2 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/Hash2Pub/PostService.hs
View file

@ -571,12 +571,13 @@ processIncomingPosts serv = forever $ do
-- blocks until available -- blocks until available
-- TODO: process multiple in parallel -- TODO: process multiple in parallel
(tag, pID, pContent) <- atomically . readTQueue $ relayInQueue serv (tag, pID, pContent) <- atomically . readTQueue $ relayInQueue serv
let pIdUri = "http://" <> (Txt.pack . confServiceHost . serviceConf $ serv) <> ":" <> (fromString . show . confServicePort . serviceConf $ serv) <> "/post/" <> pID
lookupRes <- lookupKey (baseDHT serv) (Txt.unpack tag) lookupRes <- lookupKey (baseDHT serv) (Txt.unpack tag)
case lookupRes of case lookupRes of
-- no vserver active => wait and retry -- no vserver active => wait and retry
Nothing -> threadDelay $ 10 * 10^6 Nothing -> threadDelay $ 10 * 10^6
Just (responsibleHost, responsiblePort) -> do Just (responsibleHost, responsiblePort) -> do
resp <- runClientM (relayInboxClient tag $ pID <> "," <> pContent) (mkClientEnv (httpMan serv) (BaseUrl Http responsibleHost (fromIntegral responsiblePort) "")) resp <- runClientM (relayInboxClient tag $ pIdUri <> "," <> pContent) (mkClientEnv (httpMan serv) (BaseUrl Http responsibleHost (fromIntegral responsiblePort) ""))
case resp of case resp of
Left err -> do Left err -> do
putStrLn $ "Error: " <> show err putStrLn $ "Error: " <> show err