schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

include port in Origin header

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-08-13 21:57:28 +02:00
parent e9ae258dde
commit e646045ab2
1 changed files with 2 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/Hash2Pub/PostService.hs
View file

@ -359,10 +359,11 @@ clientDeliverSubscriptions serv fromTag toTag (toHost, toPort) = do
clientSubscribeTo :: DHT d => PostService d -> Hashtag -> IO (Either String Integer) clientSubscribeTo :: DHT d => PostService d -> Hashtag -> IO (Either String Integer)
clientSubscribeTo serv tag = do clientSubscribeTo serv tag = do
lookupRes <- lookupKey (baseDHT serv) (Txt.unpack tag) lookupRes <- lookupKey (baseDHT serv) (Txt.unpack tag)
let origin = "http://" <> Txt.pack (confServiceHost $ serviceConf serv) <> ":" <> Txt.pack (show (getListeningPortFromService serv :: Integer))
maybe maybe
(pure . Left $ "No node found") (pure . Left $ "No node found")
(\(foundHost, foundPort) -> do (\(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 case resp of
Left err -> pure . Left . show $ err Left err -> pure . Left . show $ err
Right lease -> pure . Right $ lease Right lease -> pure . Right $ lease