{-# LANGUAGE DataKinds #-}

module Hercules.API.Agent where

import Data.Proxy
import Hercules.API.Agent.Build
  ( BuildAPI,
  )
import Hercules.API.Agent.Evaluate
  ( EvalAPI,
  )
import Hercules.API.Agent.LifeCycle
  ( LifeCycleAPI,
  )
import Hercules.API.Agent.State
  ( StateAPI,
  )
import Hercules.API.Agent.Tasks
  ( TasksAPI,
  )
import Hercules.API.Prelude
import Servant.API
import Servant.API.Generic
import Servant.Auth

data AgentAPI auth f = AgentAPI
  { AgentAPI auth f -> f :- ToServantApi (TasksAPI auth)
tasks :: f :- ToServantApi (TasksAPI auth),
    AgentAPI auth f -> f :- ToServantApi (EvalAPI auth)
eval :: f :- ToServantApi (EvalAPI auth),
    AgentAPI auth f -> f :- ToServantApi (BuildAPI auth)
build :: f :- ToServantApi (BuildAPI auth),
    AgentAPI auth f -> f :- ToServantApi (LifeCycleAPI auth)
lifeCycle :: f :- ToServantApi (LifeCycleAPI auth),
    AgentAPI auth f -> f :- ToServantApi (StateAPI auth)
state :: f :- ToServantApi (StateAPI auth)
  }
  deriving ((forall x. AgentAPI auth f -> Rep (AgentAPI auth f) x)
-> (forall x. Rep (AgentAPI auth f) x -> AgentAPI auth f)
-> Generic (AgentAPI auth f)
forall x. Rep (AgentAPI auth f) x -> AgentAPI auth f
forall x. AgentAPI auth f -> Rep (AgentAPI auth f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x. Rep (AgentAPI auth f) x -> AgentAPI auth f
forall auth f x. AgentAPI auth f -> Rep (AgentAPI auth f) x
$cto :: forall auth f x. Rep (AgentAPI auth f) x -> AgentAPI auth f
$cfrom :: forall auth f x. AgentAPI auth f -> Rep (AgentAPI auth f) x
Generic)

-- TODO check that we don't have overlapping endpoints and remove cookie
type ClientAuth = Auth '[JWT, Cookie] ()

type AgentServantAPI auth = AddAPIVersion (ToServantApi (AgentAPI auth))

type AddAPIVersion api = "api" :> "v1" :> api

servantApi :: Proxy (AgentServantAPI auth)
servantApi :: Proxy (AgentServantAPI auth)
servantApi = Proxy (AgentServantAPI auth)
forall k (t :: k). Proxy t
Proxy

type API auth =
  AgentServantAPI auth

api :: Proxy (API auth)
api :: Proxy (API auth)
api = Proxy (API auth)
forall k (t :: k). Proxy t
Proxy