diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 76dab47..e9144df 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -271,6 +271,18 @@ clientAPI = Proxy relayInboxClient :<|> subscriptionDeliveryClient :<|> postFetchClient :<|> postMultiFetchClient :<|> postInboxClient :<|> tagDeliveryClient :<|> tagSubscribeClient :<|> tagUnsubscribeClient = client clientAPI + + +-- currently this is unused code +getClients :: String -> Int -> HTTP.Manager -> Client IO PostServiceAPI +getClients hostname' port' httpMan = hoistClient clientAPI + (fmap (either (error . show) id) + . flip runClientM clientEnv + ) + (client clientAPI) + where + clientEnv = mkClientEnv httpMan (BaseUrl Http hostname' port' "") + -- ======= data structure manipulations ========= -- | Write all pending posts of a subscriber-tag-combination to its queue. @@ -372,11 +384,14 @@ processIncomingPosts :: DHT d => PostService d -> IO () processIncomingPosts serv = forever $ do -- blocks until available -- TODO: process multiple in parallel - (t, pID, pC) <- atomically . readTQueue $ relayInQueue serv - lookupRes <- lookupKey (baseDHT serv) (Txt.unpack t) + (tag, pID, pContent) <- atomically . readTQueue $ relayInQueue serv + 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 - -- TODO: do actual HTTP requests - pure () + httpMan <- HTTP.newManager HTTP.defaultManagerSettings + resp <- runClientM (relayInboxClient tag (pID <> "," <> pContent)) (mkClientEnv httpMan (BaseUrl Http responsibleHost (fromIntegral responsiblePort) "")) + case resp of + Left err -> putStrLn $ "Error: " <> show err + Right yay -> putStrLn $ "Yay! " <> show yay