forked from schmittlauch/Hash2Pub
subscribe to tag
This commit is contained in:
parent
375014812a
commit
e9ae258dde
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue