{-# options_haddock prune #-} -- |HTTP Client, Internal module Helic.Net.Client where import Exon (exon) import qualified Polysemy.Conc as Conc import Polysemy.Http (Manager) import qualified Polysemy.Http.Effect.Manager as Manager import qualified Polysemy.Log as Log import Polysemy.Time (MilliSeconds (MilliSeconds)) import Servant (NoContent, type (:<|>) ((:<|>))) import Servant.Client (BaseUrl, ClientM, client, mkClientEnv, parseBaseUrl, runClientM) import Helic.Data.Event (Event) import Helic.Data.Host (Host (Host)) import qualified Helic.Data.NetConfig as NetConfig import Helic.Data.NetConfig (NetConfig, Timeout) import Helic.Net.Api (Api, defaultPort) get :: ClientM [Event] yank :: Event -> ClientM NoContent load :: Int -> ClientM (Maybe Event) get :<|> yank :<|> load = client (Proxy @Api) sendTo :: Members [Manager, Log, Race, Error Text, Embed IO] r => Maybe Timeout -> Host -> Event -> Sem r () sendTo configTimeout (Host addr) event = do Log.debug [exon|sending to #{addr}|] url <- note [exon|Invalid host name: #{addr}|] (parseBaseUrl (toString addr)) mgr <- Manager.get let timeout = MilliSeconds (fromIntegral (fromMaybe 300 configTimeout)) env = mkClientEnv mgr url req = fmap (first show) <$> tryAny (runClientM (yank event) env) void . fromEither =<< fromEither =<< Conc.timeoutAs_ (Left "timed out") timeout req localhost :: Member (Reader NetConfig) r => Sem r Host localhost = do port <- asks NetConfig.port pure (Host [exon|localhost:#{show (fromMaybe defaultPort port)}|]) localhostUrl :: Members [Reader NetConfig, Error Text] r => Sem r BaseUrl localhostUrl = do Host host <- localhost note [exon|Invalid server port: #{host}|] (parseBaseUrl (toString host))