Client.hs

{-# options_haddock prune #-}

-- |HTTP Client, Internal
module Helic.Net.Client where

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.Log (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 (mapLeft 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))