send fetchable post URIs as ID
This commit is contained in:
parent
5511026c8d
commit
75c1932ef6
|
@ -571,12 +571,13 @@ processIncomingPosts serv = forever $ do
|
|||
-- blocks until available
|
||||
-- TODO: process multiple in parallel
|
||||
(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)
|
||||
case lookupRes of
|
||||
-- no vserver active => wait and retry
|
||||
Nothing -> threadDelay $ 10 * 10^6
|
||||
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
|
||||
Left err -> do
|
||||
putStrLn $ "Error: " <> show err
|
||||
|
|
Loading…
Reference in a new issue