From 75c1932ef67a38adbeaa0c9c32172b080c0b78fa Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Fri, 21 Aug 2020 23:47:42 +0200 Subject: [PATCH] send fetchable post URIs as ID --- 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 348c9a1..c7300db 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -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