subscribe to tag

This commit is contained in:
Trolli Schmittlauch 2020-08-13 21:12:22 +02:00
parent 375014812a
commit e9ae258dde

View file

@ -354,6 +354,21 @@ clientDeliverSubscriptions serv fromTag toTag (toHost, toPort) = do
haveRead <- tryReadTChan chan haveRead <- tryReadTChan chan
maybe (pure acc) (\x -> channelGetAll' chan (x:acc)) haveRead maybe (pure acc) (\x -> channelGetAll' chan (x:acc)) haveRead
-- | Subscribe the client to the given hashtag. On success it returns the given lease time.
clientSubscribeTo :: DHT d => PostService d -> Hashtag -> IO (Either String Integer)
clientSubscribeTo serv tag = do
lookupRes <- lookupKey (baseDHT serv) (Txt.unpack tag)
maybe
(pure . Left $ "No node found")
(\(foundHost, foundPort) -> do
resp <- runClientM (tagSubscribeClient tag (Just . fromString . confServiceHost . serviceConf $ serv)) (mkClientEnv (httpMan serv) (BaseUrl Http foundHost (fromIntegral foundPort) ""))
case resp of
Left err -> pure . Left . show $ err
Right lease -> pure . Right $ lease
)
lookupRes
-- currently this is unused code -- currently this is unused code
getClients :: String -> Int -> HTTP.Manager -> Client IO PostServiceAPI getClients :: String -> Int -> HTTP.Manager -> Client IO PostServiceAPI
getClients hostname' port' httpMan = hoistClient clientAPI getClients hostname' port' httpMan = hoistClient clientAPI