include port in Origin header
This commit is contained in:
parent
e9ae258dde
commit
e646045ab2
|
@ -359,10 +359,11 @@ clientDeliverSubscriptions serv fromTag toTag (toHost, toPort) = do
|
|||
clientSubscribeTo :: DHT d => PostService d -> Hashtag -> IO (Either String Integer)
|
||||
clientSubscribeTo serv tag = do
|
||||
lookupRes <- lookupKey (baseDHT serv) (Txt.unpack tag)
|
||||
let origin = "http://" <> Txt.pack (confServiceHost $ serviceConf serv) <> ":" <> Txt.pack (show (getListeningPortFromService serv :: Integer))
|
||||
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) ""))
|
||||
resp <- runClientM (tagSubscribeClient tag (Just origin)) (mkClientEnv (httpMan serv) (BaseUrl Http foundHost (fromIntegral foundPort) ""))
|
||||
case resp of
|
||||
Left err -> pure . Left . show $ err
|
||||
Right lease -> pure . Right $ lease
|
||||
|
|
Loading…
Reference in a new issue