{-# 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)
ClientM [Event]
get :<|> Event -> ClientM NoContent
yank :<|> Int -> ClientM (Maybe Event)
load = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @Api)

sendTo ::
  Members [Manager, Log, Race, Error Text, Embed IO] r =>
  Maybe Timeout ->
  Host ->
  Event ->
  Sem r ()
sendTo :: forall (r :: EffectRow).
Members '[Manager, Log, Race, Error Text, Embed IO] r =>
Maybe Timeout -> Host -> Event -> Sem r ()
sendTo Maybe Timeout
configTimeout (Host Text
addr) Event
event = do
  forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|sending to #{addr}|]
  BaseUrl
url <- forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note [exon|Invalid host name: #{addr}|] (forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
parseBaseUrl (forall a. ToString a => a -> String
toString Text
addr))
  Manager
mgr <- forall (r :: EffectRow). Member Manager r => Sem r Manager
Manager.get
  let
    timeout :: MilliSeconds
timeout =
      Int64 -> MilliSeconds
MilliSeconds (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. a -> Maybe a -> a
fromMaybe Timeout
300 Maybe Timeout
configTimeout))
    env :: ClientEnv
env =
      Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
mgr BaseUrl
url
    req :: Sem r (Either Text (Either Text NoContent))
req =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall b a. (Show a, IsString b) => a -> b
show) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Event -> ClientM NoContent
yank Event
event) ClientEnv
env)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
Conc.timeoutAs_ (forall a b. a -> Either a b
Left Text
"timed out") MilliSeconds
timeout Sem r (Either Text (Either Text NoContent))
req

localhost ::
  Member (Reader NetConfig) r =>
  Sem r Host
localhost :: forall (r :: EffectRow). Member (Reader NetConfig) r => Sem r Host
localhost = do
  Maybe Int
port <- forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks (.port)
  pure (Text -> Host
Host [exon|localhost:#{show (fromMaybe defaultPort port)}|])

localhostUrl ::
  Members [Reader NetConfig, Error Text] r =>
  Sem r BaseUrl
localhostUrl :: forall (r :: EffectRow).
Members '[Reader NetConfig, Error Text] r =>
Sem r BaseUrl
localhostUrl = do
  Host Text
host <- forall (r :: EffectRow). Member (Reader NetConfig) r => Sem r Host
localhost
  forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note [exon|Invalid server port: #{host}|] (forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
parseBaseUrl (forall a. ToString a => a -> String
toString Text
host))