include port in Origin header

This commit is contained in:
Trolli Schmittlauch 2020-08-13 21:57:28 +02:00
parent e9ae258dde
commit e646045ab2

View file

@ -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