{-# 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)
ClientM [Event]
get :<|> Event -> ClientM NoContent
yank :<|> Int -> ClientM (Maybe Event)
load = 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 [exon|Invalid host name: #{addr}|] (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 :: Sem r (Either Text (Either Text NoContent))
req =
      (Either ClientError NoContent -> Either Text NoContent)
-> Either Text (Either ClientError NoContent)
-> Either Text (Either Text NoContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClientError -> Text)
-> Either ClientError NoContent -> Either Text NoContent
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 Text (Either ClientError NoContent)
 -> Either Text (Either Text NoContent))
-> Sem r (Either Text (Either ClientError NoContent))
-> Sem r (Either Text (Either Text NoContent))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ClientError NoContent)
-> Sem r (Either Text (Either ClientError NoContent))
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny (ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Event -> ClientM NoContent
yank Event
event) ClientEnv
env)
  Sem r NoContent -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r NoContent -> Sem r ())
-> (Either Text NoContent -> Sem r NoContent)
-> Either Text NoContent
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text NoContent -> Sem r NoContent
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text NoContent -> Sem r ())
-> Sem r (Either Text NoContent) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either Text (Either Text NoContent)
-> Sem r (Either Text NoContent)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either Text (Either Text NoContent)
 -> Sem r (Either Text NoContent))
-> Sem r (Either Text (Either Text NoContent))
-> Sem r (Either Text NoContent)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either Text (Either Text NoContent)
-> MilliSeconds
-> Sem r (Either Text (Either Text NoContent))
-> Sem r (Either Text (Either Text NoContent))
forall u (r :: EffectRow) a.
(TimeUnit u, Member Race r) =>
a -> u -> Sem r a -> Sem r a
Conc.timeoutAs_ (Text -> Either Text (Either Text NoContent)
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 :: Sem r Host
localhost = do
  Maybe Int
port <- (NetConfig -> Maybe Int) -> Sem r (Maybe Int)
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks NetConfig -> Maybe Int
NetConfig.port
  pure (Text -> Host
Host [exon|localhost:#{show (fromMaybe defaultPort port)}|])

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