-- |Agent Interpreter for Network, Internal
module Helic.Interpreter.AgentNet where

import Polysemy.Conc (Events, Interrupt, interpretSync, withAsync_)
import Polysemy.Http (Manager)
import qualified Polysemy.Log as Log
import Polysemy.Log (Log)
import Polysemy.Tagged (Tagged, untag)

import Helic.Data.Event (Event (source))
import Helic.Data.InstanceName (InstanceName)
import Helic.Data.NetConfig (NetConfig (NetConfig))
import Helic.Effect.Agent (Agent (Update), AgentNet, agentIdNet)
import Helic.Net.Api (serve)
import Helic.Net.Client (sendTo)

-- |Interpret 'Agent' using remote hosts as targets.
-- This also starts the HTTP server that listens to network events, which are used both for remote hosts and CLI
-- events.
interpretAgentNet ::
  Members [Manager, Events resource Event, Reader InstanceName, Reader NetConfig] r =>
  Members [AtomicState (Seq Event), Log, Interrupt, Race, Resource, Async, Embed IO, Final IO] r =>
  InterpreterFor (Tagged AgentNet Agent) r
interpretAgentNet :: InterpreterFor (Tagged AgentNet Agent) r
interpretAgentNet Sem (Tagged AgentNet Agent : r) a
sem =
  Sem (Sync ServerReady : r) a -> Sem r a
forall d (r :: EffectRow).
Members '[Race, Embed IO] r =>
InterpreterFor (Sync d) r
interpretSync (Sem (Sync ServerReady : r) a -> Sem r a)
-> Sem (Sync ServerReady : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$
  Sem (Sync ServerReady : r) ()
-> Sem (Sync ServerReady : r) a -> Sem (Sync ServerReady : r) a
forall (r :: EffectRow) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ Sem (Sync ServerReady : r) ()
forall resource (r :: EffectRow).
(Members '[Events resource Event, Reader NetConfig] r,
 Members
   '[AtomicState (Seq Event), Reader InstanceName, Sync ServerReady,
     Log, Interrupt, Final IO]
   r) =>
Sem r ()
serve (Sem (Sync ServerReady : r) a -> Sem (Sync ServerReady : r) a)
-> Sem (Sync ServerReady : r) a -> Sem (Sync ServerReady : r) a
forall a b. (a -> b) -> a -> b
$
  Sem (Agent : Sync ServerReady : r) a
-> (forall (r0 :: EffectRow) x.
    Agent (Sem r0) x -> Sem (Sync ServerReady : r) x)
-> Sem (Sync ServerReady : r) a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
Sem (e : r) a
-> (forall (r0 :: EffectRow) x. e (Sem r0) x -> Sem r x) -> Sem r a
interpreting (Sem (Agent : r) a -> Sem (Agent : Sync ServerReady : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Tagged AgentNet Agent : r) a -> Sem (Agent : r) a
forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
untag Sem (Tagged AgentNet Agent : r) a
sem)) \case
    Update Event
e -> do
      NetConfig Maybe Int
_ Maybe Timeout
timeout Maybe [Host]
hosts <- Sem (Sync ServerReady : r) NetConfig
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
      [Host]
-> (Host -> Sem (Sync ServerReady : r) ())
-> Sem (Sync ServerReady : r) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Maybe [Host] -> [Host]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe [Host]
hosts) \ Host
host ->
        (Text -> Sem (Sync ServerReady : r) ())
-> Either Text () -> Sem (Sync ServerReady : r) ()
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
traverseLeft Text -> Sem (Sync ServerReady : r) ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug (Either Text () -> Sem (Sync ServerReady : r) ())
-> Sem (Sync ServerReady : r) (Either Text ())
-> Sem (Sync ServerReady : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Error Text : Sync ServerReady : r) ()
-> Sem (Sync ServerReady : r) (Either Text ())
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError (Maybe Timeout
-> Host -> Event -> Sem (Error Text : Sync ServerReady : r) ()
forall (r :: EffectRow).
Members '[Manager, Log, Race, Error Text, Embed IO] r =>
Maybe Timeout -> Host -> Event -> Sem r ()
sendTo Maybe Timeout
timeout Host
host Event
e { $sel:source:Event :: AgentId
source = AgentId
agentIdNet })