-- |HTTP API of the Daemon, Internal
module Helic.Net.Api where

import qualified Polysemy.Conc as Conc
import Polysemy.Conc (Events, Interrupt, Sync)
import Polysemy.Log (Log)
import Servant (Get, JSON, PostCreated, ReqBody, type (:<|>) ((:<|>)), type (:>))
import Servant.Server (Context (EmptyContext), ServerT)

import Helic.Data.Event (Event (Event, sender, source))
import Helic.Data.InstanceName (InstanceName)
import qualified Helic.Data.NetConfig as NetConfig
import Helic.Data.NetConfig (NetConfig)
import Helic.Effect.Agent (agentIdNet)
import Helic.Net.Server (ServerReady, runServerWithContext)

-- |The Servant API of the daemon, providing endpoints for getting all events and creating one.
type Api =
  "event" :> (
    Get '[JSON] (Seq Event)
    :<|>
    ReqBody '[JSON] Event :> PostCreated '[JSON] ()
  )

-- |Publish a received event unless it was sent by the network agent of this instance.
receiveEvent ::
  Members [Events resource Event, Reader InstanceName] r =>
  Event ->
  Sem r ()
receiveEvent :: Event -> Sem r ()
receiveEvent e :: Event
e@Event {InstanceName
sender :: InstanceName
$sel:sender:Event :: Event -> InstanceName
sender, AgentId
source :: AgentId
$sel:source:Event :: Event -> AgentId
source} = do
  InstanceName
name <- Sem r InstanceName
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (InstanceName
name InstanceName -> InstanceName -> Bool
forall a. Eq a => a -> a -> Bool
== InstanceName
sender Bool -> Bool -> Bool
&& AgentId
source AgentId -> AgentId -> Bool
forall a. Eq a => a -> a -> Bool
== AgentId
agentIdNet) do
    Event -> Sem r ()
forall e resource (r :: EffectRow).
Member (Events resource e) r =>
e -> Sem r ()
Conc.publish Event
e

-- |The server implementation.
server ::
  Members [Events resource Event, AtomicState (Seq Event), Reader InstanceName] r =>
  ServerT Api (Sem r)
server :: ServerT Api (Sem r)
server =
  Sem r (Seq Event)
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet
  Sem r (Seq Event)
-> (Event -> Sem r ())
-> Sem r (Seq Event) :<|> (Event -> Sem r ())
forall a b. a -> b -> a :<|> b
:<|>
  Event -> Sem r ()
forall resource (r :: EffectRow).
Members '[Events resource Event, Reader InstanceName] r =>
Event -> Sem r ()
receiveEvent

-- |The default port, 9500.
defaultPort :: Int
defaultPort :: Int
defaultPort =
  Int
9500

-- |Run the daemon API.
serve ::
  Members [Events resource Event, Reader NetConfig] r =>
  Members [AtomicState (Seq Event), Reader InstanceName, Sync ServerReady, Log, Interrupt, Final IO] r =>
  Sem r ()
serve :: Sem r ()
serve = 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
  ServerT Api (Sem (Stop ApiError : Stop ServerError : r))
-> Context '[] -> Int -> Sem r ()
forall api (context :: [*]) (r :: EffectRow).
(HasServer api context,
 HasContextEntry
   (context .++ DefaultErrorFormatters) ErrorFormatters,
 Members '[Sync ServerReady, Log, Interrupt, Final IO] r) =>
ServerT api (Sem (Stop ApiError : Stop ServerError : r))
-> Context context -> Int -> Sem r ()
runServerWithContext @Api ServerT Api (Sem (Stop ApiError : Stop ServerError : r))
forall resource (r :: EffectRow).
Members
  '[Events resource Event, AtomicState (Seq Event),
    Reader InstanceName]
  r =>
ServerT Api (Sem r)
server Context '[]
EmptyContext (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultPort Maybe Int
port)