Client.hs

{-# options_haddock prune #-}

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

import qualified Conc
import Exon (exon)
import qualified Log
import Polysemy.Http (Manager)
import qualified Polysemy.Http.Effect.Manager as Manager
import Servant (NoContent, type (:<|>) ((:<|>)))
import Servant.Client (BaseUrl, ClientM, client, mkClientEnv, parseBaseUrl, runClientM)
import Time (MilliSeconds (MilliSeconds))

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