{-# 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 (type (:<|>) ((:<|>)))
import Servant.Client (ClientM, client, mkClientEnv, parseBaseUrl, runClientM)

import Helic.Data.Event (Event)
import Helic.Data.Host (Host (Host))
import Helic.Data.NetConfig (Timeout)
import Helic.Net.Api (Api)

get :: ClientM (Seq Event)
yank :: Event -> ClientM ()
ClientM (Seq Event)
get :<|> Event -> ClientM ()
yank = Proxy Api -> Client ClientM Api
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy Api
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 :: Maybe Timeout -> Host -> Event -> Sem r ()
sendTo Maybe Timeout
configTimeout (Host Text
addr) Event
event = do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|sending to #{addr}|]
  BaseUrl
url <- Text -> Maybe BaseUrl -> Sem r BaseUrl
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note Text
"bad url" (String -> Maybe BaseUrl
forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
parseBaseUrl (Text -> String
forall a. ToString a => a -> String
toString Text
addr))
  Manager
mgr <- Sem r Manager
forall (r :: EffectRow). Member Manager r => Sem r Manager
Manager.get
  let
    timeout :: MilliSeconds
timeout =
      Int64 -> MilliSeconds
MilliSeconds (Timeout -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Timeout -> Maybe Timeout -> Timeout
forall a. a -> Maybe a -> a
fromMaybe Timeout
300 Maybe Timeout
configTimeout))
    env :: ClientEnv
env =
      Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
mgr BaseUrl
url
    req :: IO (Either Text ())
req =
      (ClientError -> Text) -> Either ClientError () -> Either Text ()
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ClientError -> Text
forall b a. (Show a, IsString b) => a -> b
show (Either ClientError () -> Either Text ())
-> IO (Either ClientError ()) -> IO (Either Text ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientM () -> ClientEnv -> IO (Either ClientError ())
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Event -> ClientM ()
yank Event
event) ClientEnv
env
  Either Text () -> Sem r ()
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text () -> Sem r ()) -> Sem r (Either Text ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either Text ()
-> MilliSeconds -> Sem r (Either Text ()) -> Sem r (Either Text ())
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
Conc.timeoutAs_ (Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"timed out") MilliSeconds
timeout (IO (Either Text ()) -> Sem r (Either Text ())
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (Either Text ())
req)