{-# 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.Auth

data AgentAPI auth f = AgentAPI
  { forall auth f. AgentAPI auth f -> f :- ToServantApi (TasksAPI auth)
tasks :: f :- ToServantApi (TasksAPI auth),
    forall auth f. AgentAPI auth f -> f :- ToServantApi (EvalAPI auth)
eval :: f :- ToServantApi (EvalAPI auth),
    forall auth f. AgentAPI auth f -> f :- ToServantApi (BuildAPI auth)
build :: f :- ToServantApi (BuildAPI auth),
    forall auth f.
AgentAPI auth f -> f :- ToServantApi (LifeCycleAPI auth)
lifeCycle :: f :- ToServantApi (LifeCycleAPI auth),
    forall auth f. 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
$cfrom :: forall auth f x. AgentAPI auth f -> Rep (AgentAPI auth f) x
from :: forall x. AgentAPI auth f -> Rep (AgentAPI auth f) x
$cto :: forall auth f x. Rep (AgentAPI auth f) x -> AgentAPI auth f
to :: forall x. Rep (AgentAPI auth f) x -> AgentAPI auth f
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 :: forall auth. Proxy (AgentServantAPI auth)
servantApi = Proxy
  (AddAPIVersion
     (((("tasks" :> (auth :> Post '[JSON] (Maybe (Task Any))))
        :<|> (("tasks"
               :> (Capture "taskId" (Id (Task Any))
                   :> (ReqBody '[JSON] TaskStatus
                       :> (auth :> Post '[JSON] NoContent))))
              :<|> ("tasks"
                    :> ("log"
                        :> (ReqBody '[JSON] [Object]
                            :> (auth :> Post '[JSON] NoContent))))))
       :<|> ((("tasks"
               :> (Capture "taskId" (Id (Task EvaluateTask))
                   :> ("eval" :> (auth :> Get '[JSON] EvaluateTask))))
              :<|> ("tasks"
                    :> (Capture "taskId" (Id (Task EvaluateTask))
                        :> ("eval"
                            :> (ReqBody '[JSON] [EvaluateEvent]
                                :> (auth :> Post '[JSON] NoContent))))))
             :<|> (("agent"
                    :> ("build"
                        :> (Capture "derivationPath" Text
                            :> (auth :> Get '[JSON] (Maybe DerivationStatus)))))
                   :<|> ("agent"
                         :> ("eval-build"
                             :> (Capture "derivationPath" Text
                                 :> (auth :> Get '[JSON] (Maybe (UUID, DerivationStatus)))))))))
      :<|> ((("tasks"
              :> (Capture "taskId" (Id (Task BuildTask))
                  :> ("build" :> (auth :> Get '[JSON] BuildTask))))
             :<|> (("tasks"
                    :> (Capture "taskId" (Id (Task BuildTask))
                        :> ("build"
                            :> (ReqBody '[JSON] [BuildEvent]
                                :> (auth :> Post '[JSON] NoContent)))))
                   :<|> (Summary "DEPRECATED"
                         :> ("tasks"
                             :> (Capture "taskId" (Id (Task BuildTask))
                                 :> ("build"
                                     :> ("_log"
                                         :> (ReqBody '[OctetStream] ByteString
                                             :> (auth :> Post '[JSON] NoContent)))))))))
            :<|> ((((Summary "Create a new agent session."
                     :> (Description
                           "Authenticated using the cluster join token acquired through POST /accounts/:accountId/clusterJoinTokens"
                         :> ("agent"
                             :> ("session"
                                 :> (ReqBody '[JSON] CreateAgentSession
                                     :> (auth :> Post '[JSON] Text))))))
                    :<|> (Summary
                            "Update an agent session wrt features, versions, capabilities etc."
                          :> (Description
                                "Authenticated using the agent session token acquired through agentSessionCreate."
                              :> ("agent"
                                  :> ("hello"
                                      :> (ReqBody '[JSON] Hello
                                          :> (auth :> Post '[JSON] NoContent)))))))
                   :<|> ((Summary "Update an agent session to indicate liveness."
                          :> (Description
                                "Authenticated using the agent session token acquired through agentSessionCreate."
                              :> ("agent"
                                  :> ("heartbeat"
                                      :> (ReqBody '[JSON] StartInfo
                                          :> (auth :> Post '[JSON] NoContent))))))
                         :<|> ((Summary "Report that an agent has stopped."
                                :> (Description
                                      "Authenticated using the agent session token acquired through agentSessionCreate."
                                    :> ("agent"
                                        :> ("goodbye"
                                            :> (ReqBody '[JSON] StartInfo
                                                :> (auth :> Post '[JSON] NoContent))))))
                               :<|> (Summary "Service version and configuration."
                                     :> ("agent" :> ("service-info" :> Get '[JSON] ServiceInfo))))))
                  :<|> (("current-task"
                         :> ("state"
                             :> (Capture' '[Required] "name" Text
                                 :> ("data"
                                     :> (auth
                                         :> StreamGet
                                              NoFraming
                                              OctetStream
                                              (Headers '[ContentLength] (SourceIO ByteString)))))))
                        :<|> ("current-task"
                              :> ("state"
                                  :> (Capture' '[Required] "name" Text
                                      :> ("data"
                                          :> (StreamBody NoFraming OctetStream (SourceIO ByteString)
                                              :> (ContentLength
                                                  :> (auth :> Put '[JSON] NoContent))))))))))))
Proxy (AgentServantAPI auth)
forall {k} (t :: k). Proxy t
Proxy

type API auth =
  AgentServantAPI auth

api :: Proxy (API auth)
api :: forall auth. Proxy (AgentServantAPI auth)
api = Proxy
  (AddAPIVersion
     (((("tasks" :> (auth :> Post '[JSON] (Maybe (Task Any))))
        :<|> (("tasks"
               :> (Capture "taskId" (Id (Task Any))
                   :> (ReqBody '[JSON] TaskStatus
                       :> (auth :> Post '[JSON] NoContent))))
              :<|> ("tasks"
                    :> ("log"
                        :> (ReqBody '[JSON] [Object]
                            :> (auth :> Post '[JSON] NoContent))))))
       :<|> ((("tasks"
               :> (Capture "taskId" (Id (Task EvaluateTask))
                   :> ("eval" :> (auth :> Get '[JSON] EvaluateTask))))
              :<|> ("tasks"
                    :> (Capture "taskId" (Id (Task EvaluateTask))
                        :> ("eval"
                            :> (ReqBody '[JSON] [EvaluateEvent]
                                :> (auth :> Post '[JSON] NoContent))))))
             :<|> (("agent"
                    :> ("build"
                        :> (Capture "derivationPath" Text
                            :> (auth :> Get '[JSON] (Maybe DerivationStatus)))))
                   :<|> ("agent"
                         :> ("eval-build"
                             :> (Capture "derivationPath" Text
                                 :> (auth :> Get '[JSON] (Maybe (UUID, DerivationStatus)))))))))
      :<|> ((("tasks"
              :> (Capture "taskId" (Id (Task BuildTask))
                  :> ("build" :> (auth :> Get '[JSON] BuildTask))))
             :<|> (("tasks"
                    :> (Capture "taskId" (Id (Task BuildTask))
                        :> ("build"
                            :> (ReqBody '[JSON] [BuildEvent]
                                :> (auth :> Post '[JSON] NoContent)))))
                   :<|> (Summary "DEPRECATED"
                         :> ("tasks"
                             :> (Capture "taskId" (Id (Task BuildTask))
                                 :> ("build"
                                     :> ("_log"
                                         :> (ReqBody '[OctetStream] ByteString
                                             :> (auth :> Post '[JSON] NoContent)))))))))
            :<|> ((((Summary "Create a new agent session."
                     :> (Description
                           "Authenticated using the cluster join token acquired through POST /accounts/:accountId/clusterJoinTokens"
                         :> ("agent"
                             :> ("session"
                                 :> (ReqBody '[JSON] CreateAgentSession
                                     :> (auth :> Post '[JSON] Text))))))
                    :<|> (Summary
                            "Update an agent session wrt features, versions, capabilities etc."
                          :> (Description
                                "Authenticated using the agent session token acquired through agentSessionCreate."
                              :> ("agent"
                                  :> ("hello"
                                      :> (ReqBody '[JSON] Hello
                                          :> (auth :> Post '[JSON] NoContent)))))))
                   :<|> ((Summary "Update an agent session to indicate liveness."
                          :> (Description
                                "Authenticated using the agent session token acquired through agentSessionCreate."
                              :> ("agent"
                                  :> ("heartbeat"
                                      :> (ReqBody '[JSON] StartInfo
                                          :> (auth :> Post '[JSON] NoContent))))))
                         :<|> ((Summary "Report that an agent has stopped."
                                :> (Description
                                      "Authenticated using the agent session token acquired through agentSessionCreate."
                                    :> ("agent"
                                        :> ("goodbye"
                                            :> (ReqBody '[JSON] StartInfo
                                                :> (auth :> Post '[JSON] NoContent))))))
                               :<|> (Summary "Service version and configuration."
                                     :> ("agent" :> ("service-info" :> Get '[JSON] ServiceInfo))))))
                  :<|> (("current-task"
                         :> ("state"
                             :> (Capture' '[Required] "name" Text
                                 :> ("data"
                                     :> (auth
                                         :> StreamGet
                                              NoFraming
                                              OctetStream
                                              (Headers '[ContentLength] (SourceIO ByteString)))))))
                        :<|> ("current-task"
                              :> ("state"
                                  :> (Capture' '[Required] "name" Text
                                      :> ("data"
                                          :> (StreamBody NoFraming OctetStream (SourceIO ByteString)
                                              :> (ContentLength
                                                  :> (auth :> Put '[JSON] NoContent))))))))))))
Proxy (API auth)
forall {k} (t :: k). Proxy t
Proxy