{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Servant API type definitions for Arbiter job queue admin interface.
--
-- The API is generated from the registry, creating separate endpoints for each table.
module Arbiter.Servant.API
  ( ArbiterAPI
  , RegistryToAPI
  , TableAPI (..)
  , JobsAPI (..)
  , DLQAPI (..)
  , StatsAPI (..)
  , QueuesAPI (..)
  , EventsAPI
  , CronAPI (..)
  ) where

import Arbiter.Core.QueueRegistry (JobPayloadRegistry)
import Arbiter.Core.SqlTemplates
  ( DLQSortColumn
  , JobSortColumn
  , SortDir
  , dlqSortColumnName
  , jobSortColumnName
  , sortDirSql
  )
import Data.Int (Int64)
import Data.Kind (Type)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import GHC.TypeLits (Symbol)
import Servant.API

import Arbiter.Servant.Types

-- | Case-insensitive lookup of an enum value by its canonical name.
parseEnum :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
parseEnum :: forall a.
(Bounded a, Enum a) =>
(a -> Text) -> Text -> Either Text a
parseEnum a -> Text
toName Text
t =
  let lower :: Text
lower = Text -> Text
T.toLower Text
t
      table :: [(Text, a)]
table = [(Text -> Text
T.toLower (a -> Text
toName a
x), a
x) | a
x <- [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]]
   in case Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
lower [(Text, a)]
table of
        Just a
x -> a -> Either Text a
forall a b. b -> Either a b
Right a
x
        Maybe a
Nothing -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"unknown value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

instance FromHttpApiData JobSortColumn where
  parseQueryParam :: Text -> Either Text JobSortColumn
parseQueryParam = (JobSortColumn -> Text) -> Text -> Either Text JobSortColumn
forall a.
(Bounded a, Enum a) =>
(a -> Text) -> Text -> Either Text a
parseEnum JobSortColumn -> Text
jobSortColumnName

instance ToHttpApiData JobSortColumn where
  toUrlPiece :: JobSortColumn -> Text
toUrlPiece = JobSortColumn -> Text
jobSortColumnName

instance FromHttpApiData DLQSortColumn where
  parseQueryParam :: Text -> Either Text DLQSortColumn
parseQueryParam = (DLQSortColumn -> Text) -> Text -> Either Text DLQSortColumn
forall a.
(Bounded a, Enum a) =>
(a -> Text) -> Text -> Either Text a
parseEnum DLQSortColumn -> Text
dlqSortColumnName

instance ToHttpApiData DLQSortColumn where
  toUrlPiece :: DLQSortColumn -> Text
toUrlPiece = DLQSortColumn -> Text
dlqSortColumnName

instance FromHttpApiData SortDir where
  parseQueryParam :: Text -> Either Text SortDir
parseQueryParam = (SortDir -> Text) -> Text -> Either Text SortDir
forall a.
(Bounded a, Enum a) =>
(a -> Text) -> Text -> Either Text a
parseEnum SortDir -> Text
sortDirSql

instance ToHttpApiData SortDir where
  toUrlPiece :: SortDir -> Text
toUrlPiece = SortDir -> Text
sortDirSql

-- | Jobs API routes - manage jobs in a specific table
data JobsAPI payload mode = JobsAPI
  { -- GET /:table/jobs?limit=N&offset=N&group_key=X&parent_id=N&suspended=B&roots_only&in_flight&sort_by=...&sort_dir=...
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode
   :- (QueryParam "limit" Int
       :> (QueryParam "offset" Int
           :> (QueryParam "group_key" Text
               :> (QueryParam "parent_id" Int64
                   :> (QueryParam "suspended" Bool
                       :> (QueryFlag "roots_only"
                           :> (QueryFlag "in_flight"
                               :> (QueryParam "sort_by" JobSortColumn
                                   :> (QueryParam "sort_dir" SortDir
                                       :> Get '[JSON] (JobsResponse payload))))))))))
listJobs
      :: mode
        :- QueryParam "limit" Int
          :> QueryParam "offset" Int
          :> QueryParam "group_key" Text
          :> QueryParam "parent_id" Int64
          :> QueryParam "suspended" Bool
          :> QueryFlag "roots_only"
          :> QueryFlag "in_flight"
          :> QueryParam "sort_by" JobSortColumn
          :> QueryParam "sort_dir" SortDir
          :> Get '[JSON] (JobsResponse payload)
  , -- POST /:table/jobs (insert new job)
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode
   :- (ReqBody '[JSON] (ApiJobWrite payload)
       :> Post '[JSON] (JobResponse payload))
insertJob
      :: mode
        :- ReqBody '[JSON] (ApiJobWrite payload)
          :> Post '[JSON] (JobResponse payload)
  , -- POST /:table/jobs/batch (insert multiple jobs)
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode
   :- ("batch"
       :> (ReqBody '[JSON] (BatchInsertRequest payload)
           :> Post '[JSON] (BatchInsertResponse payload)))
insertJobsBatch
      :: mode
        :- "batch"
          :> ReqBody '[JSON] (BatchInsertRequest payload)
          :> Post '[JSON] (BatchInsertResponse payload)
  , -- GET /:table/jobs/:id
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode
   :- (Capture "id" Int64 :> Get '[JSON] (JobResponse payload))
getJob
      :: mode
        :- Capture "id" Int64
          :> Get '[JSON] (JobResponse payload)
  , -- DELETE /:table/jobs/:id (cancel job)
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode :- (Capture "id" Int64 :> DeleteNoContent)
cancelJob
      :: mode
        :- Capture "id" Int64
          :> DeleteNoContent
  , -- POST /:table/jobs/:id/promote
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode :- (Capture "id" Int64 :> ("promote" :> PostNoContent))
promoteJob
      :: mode
        :- Capture "id" Int64
          :> "promote"
          :> PostNoContent
  , -- POST /:table/jobs/:id/move-to-dlq
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode :- (Capture "id" Int64 :> ("move-to-dlq" :> PostNoContent))
moveToDLQ
      :: mode
        :- Capture "id" Int64
          :> "move-to-dlq"
          :> PostNoContent
  , -- POST /:table/jobs/:id/pause-children
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode
   :- (Capture "id" Int64 :> ("pause-children" :> PostNoContent))
pauseChildren
      :: mode
        :- Capture "id" Int64
          :> "pause-children"
          :> PostNoContent
  , -- POST /:table/jobs/:id/resume-children
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode
   :- (Capture "id" Int64 :> ("resume-children" :> PostNoContent))
resumeChildren
      :: mode
        :- Capture "id" Int64
          :> "resume-children"
          :> PostNoContent
  , -- POST /:table/jobs/:id/suspend
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode :- (Capture "id" Int64 :> ("suspend" :> PostNoContent))
suspendJob
      :: mode
        :- Capture "id" Int64
          :> "suspend"
          :> PostNoContent
  , -- POST /:table/jobs/:id/resume
    forall {k} payload (mode :: k).
JobsAPI payload mode
-> mode :- (Capture "id" Int64 :> ("resume" :> PostNoContent))
resumeJob
      :: mode
        :- Capture "id" Int64
          :> "resume"
          :> PostNoContent
  }
  deriving stock ((forall x. JobsAPI payload mode -> Rep (JobsAPI payload mode) x)
-> (forall x. Rep (JobsAPI payload mode) x -> JobsAPI payload mode)
-> Generic (JobsAPI payload mode)
forall x. Rep (JobsAPI payload mode) x -> JobsAPI payload mode
forall x. JobsAPI payload mode -> Rep (JobsAPI payload mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload k (mode :: k) x.
Rep (JobsAPI payload mode) x -> JobsAPI payload mode
forall payload k (mode :: k) x.
JobsAPI payload mode -> Rep (JobsAPI payload mode) x
$cfrom :: forall payload k (mode :: k) x.
JobsAPI payload mode -> Rep (JobsAPI payload mode) x
from :: forall x. JobsAPI payload mode -> Rep (JobsAPI payload mode) x
$cto :: forall payload k (mode :: k) x.
Rep (JobsAPI payload mode) x -> JobsAPI payload mode
to :: forall x. Rep (JobsAPI payload mode) x -> JobsAPI payload mode
Generic)

-- | DLQ API routes - manage failed jobs in a specific table
data DLQAPI payload mode = DLQAPI
  { -- GET /:table/dlq?limit=N&offset=N&parent_id=N&group_key=X&sort_by=...&sort_dir=...
    forall {k} payload (mode :: k).
DLQAPI payload mode
-> mode
   :- (QueryParam "limit" Int
       :> (QueryParam "offset" Int
           :> (QueryParam "parent_id" Int64
               :> (QueryParam "group_key" Text
                   :> (QueryParam "sort_by" DLQSortColumn
                       :> (QueryParam "sort_dir" SortDir
                           :> Get '[JSON] (DLQResponse payload)))))))
listDLQ
      :: mode
        :- QueryParam "limit" Int
          :> QueryParam "offset" Int
          :> QueryParam "parent_id" Int64
          :> QueryParam "group_key" Text
          :> QueryParam "sort_by" DLQSortColumn
          :> QueryParam "sort_dir" SortDir
          :> Get '[JSON] (DLQResponse payload)
  , -- POST /:table/dlq/:id/retry (move back to main queue)
    forall {k} payload (mode :: k).
DLQAPI payload mode
-> mode :- (Capture "id" Int64 :> ("retry" :> PostNoContent))
retryFromDLQ
      :: mode
        :- Capture "id" Int64
          :> "retry"
          :> PostNoContent
  , -- DELETE /:table/dlq/:id (permanently delete)
    forall {k} payload (mode :: k).
DLQAPI payload mode
-> mode :- (Capture "id" Int64 :> DeleteNoContent)
deleteDLQ
      :: mode
        :- Capture "id" Int64
          :> DeleteNoContent
  , -- POST /:table/dlq/batch-delete
    forall {k} payload (mode :: k).
DLQAPI payload mode
-> mode
   :- ("batch-delete"
       :> (ReqBody '[JSON] BatchDeleteRequest
           :> Post '[JSON] BatchDeleteResponse))
deleteDLQBatch
      :: mode
        :- "batch-delete"
          :> ReqBody '[JSON] BatchDeleteRequest
          :> Post '[JSON] BatchDeleteResponse
  }
  deriving stock ((forall x. DLQAPI payload mode -> Rep (DLQAPI payload mode) x)
-> (forall x. Rep (DLQAPI payload mode) x -> DLQAPI payload mode)
-> Generic (DLQAPI payload mode)
forall x. Rep (DLQAPI payload mode) x -> DLQAPI payload mode
forall x. DLQAPI payload mode -> Rep (DLQAPI payload mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload k (mode :: k) x.
Rep (DLQAPI payload mode) x -> DLQAPI payload mode
forall payload k (mode :: k) x.
DLQAPI payload mode -> Rep (DLQAPI payload mode) x
$cfrom :: forall payload k (mode :: k) x.
DLQAPI payload mode -> Rep (DLQAPI payload mode) x
from :: forall x. DLQAPI payload mode -> Rep (DLQAPI payload mode) x
$cto :: forall payload k (mode :: k) x.
Rep (DLQAPI payload mode) x -> DLQAPI payload mode
to :: forall x. Rep (DLQAPI payload mode) x -> DLQAPI payload mode
Generic)

-- | Stats API routes - queue statistics for a specific table
data StatsAPI mode = StatsAPI
  { -- GET /:table/stats
    forall {k} (mode :: k).
StatsAPI mode -> mode :- Get '[JSON] StatsResponse
getStats
      :: mode
        :- Get '[JSON] StatsResponse
  }
  deriving stock ((forall x. StatsAPI mode -> Rep (StatsAPI mode) x)
-> (forall x. Rep (StatsAPI mode) x -> StatsAPI mode)
-> Generic (StatsAPI mode)
forall x. Rep (StatsAPI mode) x -> StatsAPI mode
forall x. StatsAPI mode -> Rep (StatsAPI mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (mode :: k) x. Rep (StatsAPI mode) x -> StatsAPI mode
forall k (mode :: k) x. StatsAPI mode -> Rep (StatsAPI mode) x
$cfrom :: forall k (mode :: k) x. StatsAPI mode -> Rep (StatsAPI mode) x
from :: forall x. StatsAPI mode -> Rep (StatsAPI mode) x
$cto :: forall k (mode :: k) x. Rep (StatsAPI mode) x -> StatsAPI mode
to :: forall x. Rep (StatsAPI mode) x -> StatsAPI mode
Generic)

-- | API routes for a specific table
data TableAPI payload mode = TableAPI
  { forall {k} payload (mode :: k).
TableAPI payload mode
-> mode :- ("jobs" :> NamedRoutes (JobsAPI payload))
jobs :: mode :- "jobs" :> NamedRoutes (JobsAPI payload)
  , forall {k} payload (mode :: k).
TableAPI payload mode
-> mode :- ("dlq" :> NamedRoutes (DLQAPI payload))
dlq :: mode :- "dlq" :> NamedRoutes (DLQAPI payload)
  , forall {k} payload (mode :: k).
TableAPI payload mode -> mode :- ("stats" :> NamedRoutes StatsAPI)
stats :: mode :- "stats" :> NamedRoutes StatsAPI
  }
  deriving stock ((forall x. TableAPI payload mode -> Rep (TableAPI payload mode) x)
-> (forall x.
    Rep (TableAPI payload mode) x -> TableAPI payload mode)
-> Generic (TableAPI payload mode)
forall x. Rep (TableAPI payload mode) x -> TableAPI payload mode
forall x. TableAPI payload mode -> Rep (TableAPI payload mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload k (mode :: k) x.
Rep (TableAPI payload mode) x -> TableAPI payload mode
forall payload k (mode :: k) x.
TableAPI payload mode -> Rep (TableAPI payload mode) x
$cfrom :: forall payload k (mode :: k) x.
TableAPI payload mode -> Rep (TableAPI payload mode) x
from :: forall x. TableAPI payload mode -> Rep (TableAPI payload mode) x
$cto :: forall payload k (mode :: k) x.
Rep (TableAPI payload mode) x -> TableAPI payload mode
to :: forall x. Rep (TableAPI payload mode) x -> TableAPI payload mode
Generic)

-- | Queues API routes - list available queues
data QueuesAPI mode = QueuesAPI
  { -- GET /queues
    forall {k} (mode :: k).
QueuesAPI mode -> mode :- Get '[JSON] QueuesResponse
listQueues
      :: mode
        :- Get '[JSON] QueuesResponse
  }
  deriving stock ((forall x. QueuesAPI mode -> Rep (QueuesAPI mode) x)
-> (forall x. Rep (QueuesAPI mode) x -> QueuesAPI mode)
-> Generic (QueuesAPI mode)
forall x. Rep (QueuesAPI mode) x -> QueuesAPI mode
forall x. QueuesAPI mode -> Rep (QueuesAPI mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (mode :: k) x. Rep (QueuesAPI mode) x -> QueuesAPI mode
forall k (mode :: k) x. QueuesAPI mode -> Rep (QueuesAPI mode) x
$cfrom :: forall k (mode :: k) x. QueuesAPI mode -> Rep (QueuesAPI mode) x
from :: forall x. QueuesAPI mode -> Rep (QueuesAPI mode) x
$cto :: forall k (mode :: k) x. Rep (QueuesAPI mode) x -> QueuesAPI mode
to :: forall x. Rep (QueuesAPI mode) x -> QueuesAPI mode
Generic)

-- | Events API type - raw WAI handler for SSE streaming
type EventsAPI = "stream" :> Raw

-- | Cron API routes - manage cron schedules
data CronAPI mode = CronAPI
  { -- GET /cron/schedules
    forall {k} (mode :: k).
CronAPI mode
-> mode :- ("schedules" :> Get '[JSON] CronSchedulesResponse)
listSchedules
      :: mode
        :- "schedules"
          :> Get '[JSON] CronSchedulesResponse
  , -- PATCH /cron/schedules/:name
    forall {k} (mode :: k).
CronAPI mode
-> mode
   :- ("schedules"
       :> (Capture "name" Text
           :> (ReqBody '[JSON] CronScheduleUpdate
               :> Patch '[JSON] CronScheduleRow)))
updateSchedule
      :: mode
        :- "schedules"
          :> Capture "name" Text
          :> ReqBody '[JSON] CronScheduleUpdate
          :> Patch '[JSON] CronScheduleRow
  }
  deriving stock ((forall x. CronAPI mode -> Rep (CronAPI mode) x)
-> (forall x. Rep (CronAPI mode) x -> CronAPI mode)
-> Generic (CronAPI mode)
forall x. Rep (CronAPI mode) x -> CronAPI mode
forall x. CronAPI mode -> Rep (CronAPI mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (mode :: k) x. Rep (CronAPI mode) x -> CronAPI mode
forall k (mode :: k) x. CronAPI mode -> Rep (CronAPI mode) x
$cfrom :: forall k (mode :: k) x. CronAPI mode -> Rep (CronAPI mode) x
from :: forall x. CronAPI mode -> Rep (CronAPI mode) x
$cto :: forall k (mode :: k) x. Rep (CronAPI mode) x -> CronAPI mode
to :: forall x. Rep (CronAPI mode) x -> CronAPI mode
Generic)

-- | Generates a 'TableAPI' route for each entry in the registry, followed by
-- the shared 'QueuesAPI', 'EventsAPI', and 'CronAPI' routes. The expansion is
-- in the equations below.
type family RegistryToAPI (registry :: [(Symbol, Type)]) :: Type where
  RegistryToAPI '[] =
    "queues" :> NamedRoutes QueuesAPI
      :<|> "events" :> EventsAPI
      :<|> "cron" :> NamedRoutes CronAPI
  RegistryToAPI ('(tableName, payload) ': '[]) =
    tableName :> NamedRoutes (TableAPI payload)
      :<|> "queues" :> NamedRoutes QueuesAPI
      :<|> "events" :> EventsAPI
      :<|> "cron" :> NamedRoutes CronAPI
  RegistryToAPI ('(tableName, payload) ': rest) =
    (tableName :> NamedRoutes (TableAPI payload)) :<|> RegistryToAPI rest

-- | Top-level Arbiter API, mounted at @\/api\/v1@. The route tree under that
-- prefix is generated from the registry; see 'RegistryToAPI' for the shape
-- and the per-route data types ('TableAPI', 'QueuesAPI', 'EventsAPI',
-- 'CronAPI') for what each one exposes.
type ArbiterAPI :: JobPayloadRegistry -> Type
type ArbiterAPI registry = "api" :> "v1" :> RegistryToAPI registry