{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | OpenAPI 3 description of 'Arbiter.Servant.API.ArbiterAPI'. The route types
-- define paths, methods, parameters, bodies, success responses, and the declared
-- error responses. @RegistryToAPI@ expands to the server route tree and includes
-- each queue by its registry name with its payload and result schemas.
--
-- Each payload and result type requires a 'ToSchema' instance. For generic JSON, use
-- @deriving anyclass (ToSchema)@. This module defines a 'Data.Aeson.Value'
-- instance for free-form payloads.
module Arbiter.Servant.OpenApi
  ( -- * The document
    openApiSpec

    -- * Serving it
  , OpenApiAPI
  , openApiServer
  ) where

import Arbiter.Core.Concurrency.Spec (ConcurrencyKey (ConcurrencyKey))
import Arbiter.Core.Job.Archive qualified as Archive
import Arbiter.Core.Job.DLQ qualified as DLQ
import Arbiter.Core.Job.Dedup (DedupKey (IgnoreDuplicate))
import Arbiter.Core.Job.TraceContext (toTraceContext)
import Arbiter.Core.Job.Types
  ( JobRead
  , JobStatus
  , PayloadKeys (PayloadKeys)
  , Stored
  , defaultJob
  , jobStatusToText
  , setArchiveFor
  , setDedupKey
  , setGroupKey
  , setMaxAttempts
  , setNotVisibleUntil
  , setPriority
  )
import Arbiter.Core.Job.Types.Internal (JobRecord (Job))
import Arbiter.Core.RateLimit.Spec (RateLimitKey (RateLimitKey))
import Arbiter.Core.Sql.Jobs
  ( ArchiveSortColumn
  , DLQSortColumn
  , JobSortColumn
  , SortDir
  , archiveSortColumnName
  , dlqSortColumnName
  , jobSortColumnName
  , sortDirName
  )
import Arbiter.Core.Worker (WorkerHealth, workerHealthToText)
import Arbiter.Servant.API (ArbiterAPI, Throws')
import Arbiter.Servant.Types
import Control.Applicative ((<|>))
import Data.Aeson (ToJSON (..), Value (Null))
import Data.Char (isAsciiLower, isDigit, ord, toUpper)
import Data.HashMap.Strict.InsOrd qualified as InsOrd
import Data.HashSet.InsOrd qualified as InsOrdSet
import Data.Int (Int32, Int64)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.OpenApi
  ( Definitions
  , HttpStatusCode
  , Info (..)
  , MediaTypeObject (..)
  , NamedSchema (..)
  , OpenApi (..)
  , OpenApiType (..)
  , Operation (..)
  , PathItem (..)
  , Referenced (Inline)
  , Response (..)
  , Responses (..)
  , Schema (..)
  , Tag (..)
  , TagName
  , ToParamSchema (..)
  , ToSchema (..)
  , declareSchemaRef
  , defaultSchemaOptions
  , genericDeclareNamedSchema
  , setResponseWith
  )
import Data.OpenApi qualified as OpenApi
import Data.OpenApi.Declare (Declare)
import Data.OpenApi.Internal.Schema (GToSchema)
import Data.Proxy (Proxy (..))
import Data.Ratio (denominator, numerator)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (UTCTime)
import Data.Typeable (Typeable)
import Data.UUID.Types (UUID)
import GHC.Generics (Generic, Rep)
import GHC.TypeLits (ErrorMessage (Text), KnownNat, KnownSymbol, TypeError, natVal, symbolVal)
import Numeric (showHex)
import Servant (Accept (contentType), Get, JSON, Server, (:>))
import Servant.OpenApi (HasOpenApi, toOpenApi)

-- | The document's own route, for mounting beside 'Arbiter.Servant.API.ArbiterAPI'.
-- Mount it before @Arbiter.Servant.UI.AdminUI@. That route is a @Raw@ catch-all.
-- Give the registry by type application and the document version as an argument:
--
-- @
-- type MyApp = ArbiterAPI MyRegistry :\<|\> OpenApiAPI :\<|\> AdminUI
-- run port $ serve (Proxy \@MyApp) (arbiterServer config :\<|\> openApiServer \@MyRegistry \"1.0.0\" :\<|\> adminUIServer)
-- @
type OpenApiAPI = "openapi.json" :> Get '[JSON] Value

-- | Serve the description of a registry's API at a given document version.
openApiServer :: forall registry. (HasOpenApi (ArbiterAPI registry)) => Text -> Server OpenApiAPI
openApiServer :: forall (registry :: JobPayloadRegistry).
HasOpenApi (ArbiterAPI registry) =>
Text -> Server OpenApiAPI
openApiServer = Value -> Handler Value
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Handler Value)
-> (Text -> Value) -> Text -> Handler Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (registry :: JobPayloadRegistry).
HasOpenApi (ArbiterAPI registry) =>
Text -> Value
openApiSpec @registry

-- | The description of a registry's API, from its route types. The version
-- goes to @info.version@. The document also describes the registry's queues
-- and payloads, so the caller owns its version.
openApiSpec :: forall registry. (HasOpenApi (ArbiterAPI registry)) => Text -> Value
openApiSpec :: forall (registry :: JobPayloadRegistry).
HasOpenApi (ArbiterAPI registry) =>
Text -> Value
openApiSpec Text
docVersion = OpenApi -> Value
forall a. ToJSON a => a -> Value
toJSON (OpenApi -> OpenApi
sectioned OpenApi
described)
  where
    described :: OpenApi
described =
      (Proxy (ArbiterAPI registry) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ArbiterAPI registry)))
        { _openApiInfo =
            mempty
              { _infoTitle = "Arbiter"
              , _infoVersion = docVersion
              , _infoDescription = Just apiDescription
              }
        }

-- | Group operations by section. Queue routes use the queue name. Other routes use
-- the first path segment below the mount point.
sectioned :: OpenApi -> OpenApi
sectioned :: OpenApi -> OpenApi
sectioned OpenApi
spec =
  OpenApi
spec
    { _openApiPaths = fmap snd annotated
    , _openApiTags = InsOrdSet.fromList (map fst (InsOrd.elems annotated))
    }
  where
    routed :: InsOrdHashMap FilePath (Maybe (Text, [Text]), PathItem)
routed =
      (FilePath -> PathItem -> (Maybe (Text, [Text]), PathItem))
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath (Maybe (Text, [Text]), PathItem)
forall k v1 v2.
(k -> v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
InsOrd.mapWithKey
        (\FilePath
path PathItem
item -> (FilePath -> Maybe (Text, [Text])
queueRoute FilePath
path, PathItem
item))
        ((PathItem -> PathItem)
-> FilePath
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrd.adjust PathItem -> PathItem
describeStream FilePath
eventStreamPath (OpenApi -> InsOrdHashMap FilePath PathItem
_openApiPaths OpenApi
spec))
    shared :: Set Text
shared = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath -> Text
sharedSection FilePath
path | (FilePath
path, (Maybe (Text, [Text])
Nothing, PathItem
_)) <- InsOrdHashMap FilePath (Maybe (Text, [Text]), PathItem)
-> [(FilePath, (Maybe (Text, [Text]), PathItem))]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrd.toList InsOrdHashMap FilePath (Maybe (Text, [Text]), PathItem)
routed]
    annotated :: InsOrdHashMap FilePath (Tag, PathItem)
annotated =
      (FilePath -> (Maybe (Text, [Text]), PathItem) -> (Tag, PathItem))
-> InsOrdHashMap FilePath (Maybe (Text, [Text]), PathItem)
-> InsOrdHashMap FilePath (Tag, PathItem)
forall k v1 v2.
(k -> v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
InsOrd.mapWithKey
        (\FilePath
path (Maybe (Text, [Text])
route, PathItem
item) -> let tag :: Tag
tag = Maybe (Text, [Text]) -> Set Text -> FilePath -> Tag
section Maybe (Text, [Text])
route Set Text
shared FilePath
path in (Tag
tag, Maybe (Text, [Text]) -> Tag -> FilePath -> PathItem -> PathItem
annotatePath Maybe (Text, [Text])
route Tag
tag FilePath
path PathItem
item))
        InsOrdHashMap FilePath (Maybe (Text, [Text]), PathItem)
routed

-- | A queue route's queue name and the segments after it.
queueRoute :: FilePath -> Maybe (TagName, [Text])
queueRoute :: FilePath -> Maybe (Text, [Text])
queueRoute FilePath
path =
  case FilePath -> [Text]
mounted FilePath
path of
    Text
segment : Text
queue : rest :: [Text]
rest@(Text
_ : [Text]
_) | Text
segment Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
queuesSegment -> (Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
queue, [Text]
rest)
    [Text]
_ -> Maybe (Text, [Text])
forall a. Maybe a
Nothing

-- | The path's section. A queue with the name of a shared section gets the heading @<name> queue@.
section :: Maybe (TagName, [Text]) -> Set TagName -> FilePath -> Tag
section :: Maybe (Text, [Text]) -> Set Text -> FilePath -> Tag
section Maybe (Text, [Text])
route Set Text
shared FilePath
path =
  case Maybe (Text, [Text])
route of
    Just (Text
queue, [Text]
_) ->
      Text -> Maybe Text -> Tag
tag
        (if Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
queue Set Text
shared then Text
queue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" queue" else Text
queue)
        (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Jobs, leases, dead letters, archive, groups, kinds, stats and pause state for the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
queue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" queue."))
    Maybe (Text, [Text])
Nothing ->
      let name :: Text
name = FilePath -> Text
sharedSection FilePath
path in Text -> Maybe Text -> Tag
tag Text
name (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [(Text, Text)]
sectionDescriptions)
  where
    tag :: Text -> Maybe Text -> Tag
tag Text
name Maybe Text
description = Tag {_tagName :: Text
_tagName = Text
name, _tagDescription :: Maybe Text
_tagDescription = Maybe Text
description, _tagExternalDocs :: Maybe ExternalDocs
_tagExternalDocs = Maybe ExternalDocs
forall a. Maybe a
Nothing}

-- | The section of a path outside the queue routes.
sharedSection :: FilePath -> TagName
sharedSection :: FilePath -> Text
sharedSection FilePath
path = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"api" ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe (FilePath -> [Text]
mounted FilePath
path))

-- | The path's segments below the mount point.
mounted :: FilePath -> [Text]
mounted :: FilePath -> [Text]
mounted FilePath
path = HttpStatusCode -> [Text] -> [Text]
forall a. HttpStatusCode -> [a] -> [a]
drop ([Text] -> HttpStatusCode
forall a. [a] -> HttpStatusCode
forall (t :: * -> *) a. Foldable t => t a -> HttpStatusCode
length [Text]
mountSegments) ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" (FilePath -> Text
T.pack FilePath
path)))

-- | An operation id from the method and the path below the mount point.
operationName :: Maybe (TagName, [Text]) -> Text -> FilePath -> Text
operationName :: Maybe (Text, [Text]) -> Text -> FilePath -> Text
operationName Maybe (Text, [Text])
route Text
method FilePath
path =
  Text -> ((Text, [Text]) -> Text) -> Maybe (Text, [Text]) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Text
method Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
word (FilePath -> [Text]
mounted FilePath
path))
    (\(Text
queue, [Text]
rest) -> Text -> Text
escapeQueue Text
queue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
upperFirst Text
method Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
word [Text]
rest)
    Maybe (Text, [Text])
route
  where
    escapeQueue :: Text -> Text
escapeQueue Text
queue = Text -> ((Char, Text) -> Text) -> Maybe (Char, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
queue (\(Char
c, Text
rest) -> (if Char -> Bool
isDigit Char
c then Char -> Text
hex Char
c else Char -> Text
escape Char
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escape Text
rest) (Text -> Maybe (Char, Text)
T.uncons Text
queue)
    escape :: Char -> Text
escape Char
c
      | Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = Char -> Text
T.singleton Char
c
      | Bool
otherwise = Char -> Text
hex Char
c
    hex :: Char -> Text
hex Char
c = Text
"X" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (HttpStatusCode -> FilePath -> FilePath
forall a. Integral a => a -> FilePath -> FilePath
showHex (Char -> HttpStatusCode
ord Char
c) FilePath
"")) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"X"
    word :: Text -> Text
word Text
segment = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Text
camel Text
segment) ((Text
"By" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
camel) (Text -> Text -> Maybe Text
T.stripPrefix Text
"{" (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
T.stripSuffix Text
"}" Text
segment)
    camel :: Text -> Text
camel = (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
upperFirst ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'-', Char
'_'])
    upperFirst :: Text -> Text
upperFirst Text
text = Text -> ((Char, Text) -> Text) -> Maybe (Char, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
text (\(Char
c, Text
rest) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
c) Text
rest) (Text -> Maybe (Char, Text)
T.uncons Text
text)

-- | The segments the API is mounted under.
mountSegments :: [Text]
mountSegments :: [Text]
mountSegments = [Text
"api"]

-- | The segment the queue routes are mounted under.
queuesSegment :: Text
queuesSegment :: Text
queuesSegment = Text
"queues"

-- | The event stream's @Raw@ route, which 'toOpenApi' gives no operation.
eventStreamPath :: FilePath
eventStreamPath :: FilePath
eventStreamPath = Text -> FilePath
T.unpack ([Text] -> Text
T.concat ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text]
mountSegments [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"events", Text
"stream"])))

describeStream :: PathItem -> PathItem
describeStream :: PathItem -> PathItem
describeStream PathItem
item = PathItem
item {_pathItemGet = Just streamOperation}

-- | Description of the continuous @text/event-stream@ response.
streamOperation :: Operation
streamOperation :: Operation
streamOperation =
  Operation
forall a. Monoid a => a
mempty
    { _operationSummary = Just "Server-sent stream of job events"
    , _operationDescription =
        Just
          "Streams an event per insert, update, delete and dead-letter, as they happen. A lease extend sends no event. \
          \Each event names its queue and the job id. A dead-letter event carries the id the \
          \job had in its queue and sets dlq. The stream starts with one \"connected\" event. \
          \Sends a periodic keepalive comment while no event arrives. A server with streaming off, \
          \or with no listener, answers one \"disabled\" event and closes."
    , _operationResponses =
        mempty
          { _responsesResponses =
              InsOrd.singleton
                200
                ( Inline
                    mempty
                      { _responseDescription = "An event stream."
                      , _responseContent =
                          InsOrd.singleton "text/event-stream" mempty {_mediaTypeObjectSchema = Just (Inline jobEventSchema)}
                      }
                )
          }
    }

-- | A declared error response. Reasons for the same status join into one description.
instance (HasOpenApi api, KnownNat status, KnownSymbol reason) => HasOpenApi (Throws' status reason 'Nothing :> api) where
  toOpenApi :: Proxy (Throws' status reason 'Nothing :> api) -> OpenApi
toOpenApi Proxy (Throws' status reason 'Nothing :> api)
_ = (Response -> Response -> Response)
-> HttpStatusCode
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseWith Response -> Response -> Response
joined (forall (status :: Nat). KnownNat status => HttpStatusCode
statusCode @status) (Response -> Declare (Definitions Schema) Response
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (reason :: Symbol). KnownSymbol reason => Response
reasonResponse @reason)) (Proxy api -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api))

-- | A declared error response with a JSON body.
instance
  (HasOpenApi api, KnownNat status, KnownSymbol reason, ToSchema body)
  => HasOpenApi (Throws' status reason ('Just body) :> api)
  where
  toOpenApi :: Proxy (Throws' status reason ('Just body) :> api) -> OpenApi
toOpenApi Proxy (Throws' status reason ('Just body) :> api)
_ =
    (Response -> Response -> Response)
-> HttpStatusCode
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseWith
      Response -> Response -> Response
joined
      (forall (status :: Nat). KnownNat status => HttpStatusCode
statusCode @status)
      ((\Referenced Schema
ref -> forall ctype.
Accept ctype =>
Referenced Schema -> Response -> Response
forall {k} (ctype :: k).
Accept ctype =>
Referenced Schema -> Response -> Response
withContent @JSON Referenced Schema
ref (forall (reason :: Symbol). KnownSymbol reason => Response
reasonResponse @reason)) (Referenced Schema -> Response)
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
-> Declare (Definitions Schema) Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy body
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall a.
ToSchema a =>
Proxy a
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @body))
      (Proxy api -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api))

-- | A response with one body of the given content type.
withContent :: forall ctype. (Accept ctype) => Referenced Schema -> Response -> Response
withContent :: forall {k} (ctype :: k).
Accept ctype =>
Referenced Schema -> Response -> Response
withContent Referenced Schema
schema Response
response =
  Response
response
    { _responseContent = InsOrd.singleton (contentType (Proxy @ctype)) mempty {_mediaTypeObjectSchema = Just schema}
    }

statusCode :: forall status. (KnownNat status) => HttpStatusCode
statusCode :: forall (status :: Nat). KnownNat status => HttpStatusCode
statusCode = Integer -> HttpStatusCode
forall a. Num a => Integer -> a
fromInteger (Proxy status -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @status))

reasonResponse :: forall reason. (KnownSymbol reason) => Response
reasonResponse :: forall (reason :: Symbol). KnownSymbol reason => Response
reasonResponse = Response
forall a. Monoid a => a
mempty {_responseDescription = T.pack (symbolVal (Proxy @reason))}

-- | Put the new reason first, each as its own sentence. Two bodies of one content type become alternatives.
joined :: Response -> Response -> Response
joined :: Response -> Response -> Response
joined Response
old Response
new =
  Response
old
    { _responseDescription =
        T.unwords (map sentence (filter (not . T.null) [_responseDescription new, _responseDescription old]))
    , _responseContent = InsOrd.unionWith merged (_responseContent old) (_responseContent new)
    }
  where
    sentence :: Text -> Text
sentence Text
text = if Text
"." Text -> Text -> Bool
`T.isSuffixOf` Text
text then Text
text else Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    merged :: MediaTypeObject -> MediaTypeObject -> MediaTypeObject
merged MediaTypeObject
first MediaTypeObject
second =
      let (Maybe (Referenced Schema)
old', Maybe (Referenced Schema)
new') = (MediaTypeObject -> Maybe (Referenced Schema)
_mediaTypeObjectSchema MediaTypeObject
first, MediaTypeObject -> Maybe (Referenced Schema)
_mediaTypeObjectSchema MediaTypeObject
second)
       in MediaTypeObject
first {_mediaTypeObjectSchema = liftA2 alternatives new' old' <|> old' <|> new'}
    alternatives :: Referenced Schema -> Referenced Schema -> Referenced Schema
alternatives Referenced Schema
first Referenced Schema
second
      | Referenced Schema
first Referenced Schema -> Referenced Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Referenced Schema
second = Referenced Schema
first
      | Bool
otherwise = Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
forall a. Monoid a => a
mempty {_schemaOneOf = Just [first, second]}

-- | The JSON in one job event's data line.
jobEventSchema :: Schema
jobEventSchema :: Schema
jobEventSchema =
  ([Text] -> [(Text, Referenced Schema)] -> Schema
schemaOver [Text
"event"] [(Text, Referenced Schema)]
props)
    { _schemaDescription = Just "One job event. The connected and disabled events carry no job fields."
    }
  where
    props :: [(Text, Referenced Schema)]
props =
      [ (Text
"event", Schema -> Referenced Schema
forall a. a -> Referenced a
Inline ([Text] -> Schema
stringEnum [Text
"job_inserted", Text
"job_updated", Text
"job_deleted", Text
"job_dlq", Text
"connected", Text
"disabled"]))
      , (Text
"table", Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
forall a. Monoid a => a
mempty {_schemaType = Just OpenApiString, _schemaDescription = Just "The queue name."})
      ,
        ( Text
"job_id"
        , Schema -> Referenced Schema
forall a. a -> Referenced a
Inline
            Schema
forall a. Monoid a => a
mempty
              { _schemaType = Just OpenApiInteger
              , _schemaDescription = Just "The job id. A DLQ row gives the id of the job it holds."
              }
        )
      ,
        ( Text
"dlq"
        , Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
forall a. Monoid a => a
mempty {_schemaType = Just OpenApiBoolean, _schemaDescription = Just "The event comes from the DLQ table."}
        )
      , (Text
"message", Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
forall a. Monoid a => a
mempty {_schemaType = Just OpenApiString})
      ]

-- | Put every operation on a path into its section and give it an id.
annotatePath :: Maybe (TagName, [Text]) -> Tag -> FilePath -> PathItem -> PathItem
annotatePath :: Maybe (Text, [Text]) -> Tag -> FilePath -> PathItem -> PathItem
annotatePath Maybe (Text, [Text])
route Tag
tag FilePath
path PathItem
item =
  PathItem
item
    { _pathItemGet = annotated "get" (_pathItemGet item)
    , _pathItemPut = annotated "put" (_pathItemPut item)
    , _pathItemPost = annotated "post" (_pathItemPost item)
    , _pathItemDelete = annotated "delete" (_pathItemDelete item)
    , _pathItemOptions = annotated "options" (_pathItemOptions item)
    , _pathItemHead = annotated "head" (_pathItemHead item)
    , _pathItemPatch = annotated "patch" (_pathItemPatch item)
    , _pathItemTrace = annotated "trace" (_pathItemTrace item)
    }
  where
    annotated :: Text -> Maybe Operation -> Maybe Operation
annotated Text
method =
      (Operation -> Operation) -> Maybe Operation -> Maybe Operation
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Operation
operation ->
            Operation
operation
              { _operationTags = InsOrdSet.insert (_tagName tag) (_operationTags operation)
              , _operationOperationId = Just (operationName route method path)
              }
        )

-- | What each schema-wide section is for.
sectionDescriptions :: [(TagName, Text)]
sectionDescriptions :: [(Text, Text)]
sectionDescriptions =
  [ (Text
"queues", Text
"The registered queues and their counters.")
  , (Text
"cron", Text
"Cron schedules, their overrides, and out-of-band runs.")
  , (Text
"workers", Text
"The worker registry, and pausing a worker.")
  , (Text
"rate-limits", Text
"Token-bucket policies, their live buckets, overrides, token grants and pruning.")
  , (Text
"concurrency", Text
"Concurrency policies, their live keys, overrides and pruning.")
  , (Text
"maintenance", Text
"The sweep a worker pool's reaper runs, on demand.")
  , (Text
"events", Text
"A server-sent stream of job events.")
  , (Text
"health", Text
"Liveness and readiness.")
  ]

apiDescription :: Text
apiDescription :: Text
apiDescription =
  Text
"The Arbiter job queue over HTTP. Each registered queue has its own section, and a \
  \service in any language can use all three sides of it: enqueue jobs, run them by \
  \claiming a lease and acking, nacking or extending it, and operate the queue itself. \
  \The schema-wide sections cover queues, cron, workers, rate limits, concurrency, \
  \maintenance, events and health.\n\nThe document is derived from the server's own route \
  \types. Every payload and result below is the queue's real schema. The server ships \
  \no authentication. Put it behind your own."

-- ---------------------------------------------------------------------------
-- Schema builders
--
-- A property combines a field name with the schema of its type. The applicative
-- instance combines properties into one field list.
-- ---------------------------------------------------------------------------

-- | Schema fields indexed by the described value type. The value is a runtime
-- phantom. Applying the record constructor checks the field count, order, and
-- types at compile time.
newtype Fields a = Fields (Declare (Definitions Schema) [(Text, Referenced Schema)])

instance Functor Fields where
  fmap :: forall a b. (a -> b) -> Fields a -> Fields b
fmap a -> b
_ (Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
declared) = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields b
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
declared

instance Applicative Fields where
  pure :: forall a. a -> Fields a
pure a
_ = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields ([(Text, Referenced Schema)]
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
left <*> :: forall a b. Fields (a -> b) -> Fields a -> Fields b
<*> Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
right = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields b
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields (([(Text, Referenced Schema)]
 -> [(Text, Referenced Schema)] -> [(Text, Referenced Schema)])
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
forall a b c.
(a -> b -> c)
-> DeclareT (Definitions Schema) Identity a
-> DeclareT (Definitions Schema) Identity b
-> DeclareT (Definitions Schema) Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [(Text, Referenced Schema)]
-> [(Text, Referenced Schema)] -> [(Text, Referenced Schema)]
forall a. Semigroup a => a -> a -> a
(<>) Declare (Definitions Schema) [(Text, Referenced Schema)]
left Declare (Definitions Schema) [(Text, Referenced Schema)]
right)

-- | One field, named here and typed by the schema of @a@. A 'Maybe' field takes 'opt'.
prop :: forall a. (ToSchema a) => Text -> Fields (NotMaybe a)
prop :: forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop Text
name = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields (NotMaybe a)
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
declared
  where
    Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
declared = forall payload. ToSchema payload => Text -> Fields payload
payloadProp @a Text
name

-- | Refuse a 'Maybe' field in 'prop'.
type family NotMaybe a where
  NotMaybe (Maybe _a) = TypeError ('Text "A Maybe field takes opt, not prop.")
  NotMaybe a = a

-- | One 'Maybe' field, which encodes 'Nothing' as null.
opt :: forall a. (ToSchema a) => Text -> Fields (Maybe a)
opt :: forall a. ToSchema a => Text -> Fields (Maybe a)
opt Text
name = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields (Maybe a)
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields ((Text, Referenced Schema) -> [(Text, Referenced Schema)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Referenced Schema) -> [(Text, Referenced Schema)])
-> (Referenced Schema -> (Text, Referenced Schema))
-> Referenced Schema
-> [(Text, Referenced Schema)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Text
name (Referenced Schema -> (Text, Referenced Schema))
-> (Referenced Schema -> Referenced Schema)
-> Referenced Schema
-> (Text, Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referenced Schema -> Referenced Schema
nullable (Referenced Schema -> [(Text, Referenced Schema)])
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall a.
ToSchema a =>
Proxy a
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))

-- | One payload field, typed by the payload's own schema.
payloadProp :: forall payload. (ToSchema payload) => Text -> Fields payload
payloadProp :: forall payload. ToSchema payload => Text -> Fields payload
payloadProp Text
name = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields payload
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields ((Text, Referenced Schema) -> [(Text, Referenced Schema)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Referenced Schema) -> [(Text, Referenced Schema)])
-> (Referenced Schema -> (Text, Referenced Schema))
-> Referenced Schema
-> [(Text, Referenced Schema)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Text
name (Referenced Schema -> [(Text, Referenced Schema)])
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy payload
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall a.
ToSchema a =>
Proxy a
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @payload))

-- | Admit null. A reference or untyped schema takes a null-only branch.
nullable :: Referenced Schema -> Referenced Schema
nullable :: Referenced Schema -> Referenced Schema
nullable (Inline Schema
schema)
  | Maybe OpenApiType -> Bool
forall a. Maybe a -> Bool
isJust (Schema -> Maybe OpenApiType
_schemaType Schema
schema) =
      Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
schema {_schemaNullable = Just True, _schemaEnum = (<> [Null]) <$> _schemaEnum schema}
nullable Referenced Schema
ref = Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
forall a. Monoid a => a
mempty {_schemaAnyOf = Just [ref, Inline nullOnly]}

nullOnly :: Schema
nullOnly :: Schema
nullOnly =
  Schema
forall a. Monoid a => a
mempty {_schemaType = Just OpenApiObject, _schemaNullable = Just True, _schemaEnum = Just [Null]}

-- | One patch field, whose value distinguishes an absent field from an explicit null.
patch :: forall a. (ToSchema a) => Text -> Fields (Maybe (Maybe a))
patch :: forall a. ToSchema a => Text -> Fields (Maybe (Maybe a))
patch Text
name = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a))
-> Fields (Maybe a) -> Fields (Maybe (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @a Text
name

-- | One field with an inline schema for a shape used in one location.
inlineProp :: forall a. Text -> Schema -> Fields a
inlineProp :: forall {k} (a :: k). Text -> Schema -> Fields a
inlineProp Text
name Schema
schema = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields ([(Text, Referenced Schema)]
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text
name, Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
schema)])

-- | A field the server clamps to a range, with an optional default.
within :: (Real n, ToJSON n) => (n, n) -> Maybe n -> Fields n -> Fields n
within :: forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields n -> Fields n
within = (n, n) -> Maybe n -> Fields n -> Fields n
forall {k} n (a :: k).
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields a -> Fields a
clampedFields

-- | An optional field the server clamps to a range, with an optional default.
optWithin :: (Real n, ToJSON n) => (n, n) -> Maybe n -> Fields (Maybe n) -> Fields (Maybe n)
optWithin :: forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields (Maybe n) -> Fields (Maybe n)
optWithin = (n, n) -> Maybe n -> Fields (Maybe n) -> Fields (Maybe n)
forall {k} n (a :: k).
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields a -> Fields a
clampedFields

clampedFields :: (Real n, ToJSON n) => (n, n) -> Maybe n -> Fields a -> Fields a
clampedFields :: forall {k} n (a :: k).
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields a -> Fields a
clampedFields (n, n)
range Maybe n
def (Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
declared) = Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
forall {k} (a :: k).
Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Fields a
Fields (((Text, Referenced Schema) -> (Text, Referenced Schema))
-> [(Text, Referenced Schema)] -> [(Text, Referenced Schema)]
forall a b. (a -> b) -> [a] -> [b]
map ((Referenced Schema -> Referenced Schema)
-> (Text, Referenced Schema) -> (Text, Referenced Schema)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Schema -> Schema) -> Referenced Schema -> Referenced Schema
forall a b. (a -> b) -> Referenced a -> Referenced b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((n, n) -> Maybe n -> Schema -> Schema
forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Schema -> Schema
clamped (n, n)
range Maybe n
def))) ([(Text, Referenced Schema)] -> [(Text, Referenced Schema)])
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declare (Definitions Schema) [(Text, Referenced Schema)]
declared)

-- | A numeric schema the server clamps to a range, with an optional default.
clamped :: (Real n, ToJSON n) => (n, n) -> Maybe n -> Schema -> Schema
clamped :: forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Schema -> Schema
clamped (n
low, n
high) Maybe n
def Schema
schema =
  Schema
schema
    { _schemaDescription = Just ("Clamped to " <> number low <> " to " <> number high <> ".")
    , _schemaDefault = toJSON <$> def
    , _schemaMinimum = Nothing
    , _schemaMaximum = Nothing
    }
  where
    number :: a -> Text
number a
n
      | Ratio Integer -> Integer
forall a. Ratio a -> a
denominator (a -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational a
n) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show (Ratio Integer -> Integer
forall a. Ratio a -> a
numerator (a -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational a
n)))
      | Bool
otherwise = FilePath -> Text
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show (Ratio Integer -> Double
forall a. Fractional a => Ratio Integer -> a
fromRational (a -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational a
n) :: Double))

-- | An object schema over some fields, naming which of them a value must carry.
objectSchema :: Text -> [Text] -> Fields a -> Declare (Definitions Schema) NamedSchema
objectSchema :: forall {k} (a :: k).
Text
-> [Text] -> Fields a -> Declare (Definitions Schema) NamedSchema
objectSchema Text
name [Text]
required (Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
declared) =
  Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) (Schema -> NamedSchema)
-> ([(Text, Referenced Schema)] -> Schema)
-> [(Text, Referenced Schema)]
-> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [(Text, Referenced Schema)] -> Schema
schemaOver [Text]
required ([(Text, Referenced Schema)] -> NamedSchema)
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declare (Definitions Schema) [(Text, Referenced Schema)]
declared

-- | 'objectSchema' where every field is required.
closedSchema :: Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema :: forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
name (Fields Declare (Definitions Schema) [(Text, Referenced Schema)]
declared) = [(Text, Referenced Schema)] -> NamedSchema
named ([(Text, Referenced Schema)] -> NamedSchema)
-> Declare (Definitions Schema) [(Text, Referenced Schema)]
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declare (Definitions Schema) [(Text, Referenced Schema)]
declared
  where
    named :: [(Text, Referenced Schema)] -> NamedSchema
named [(Text, Referenced Schema)]
props = Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) ([Text] -> [(Text, Referenced Schema)] -> Schema
schemaOver (((Text, Referenced Schema) -> Text)
-> [(Text, Referenced Schema)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Referenced Schema) -> Text
forall a b. (a, b) -> a
fst [(Text, Referenced Schema)]
props) [(Text, Referenced Schema)]
props)

schemaOver :: [Text] -> [(Text, Referenced Schema)] -> Schema
schemaOver :: [Text] -> [(Text, Referenced Schema)] -> Schema
schemaOver [Text]
required [(Text, Referenced Schema)]
props =
  Schema
forall a. Monoid a => a
mempty
    { _schemaType = Just OpenApiObject
    , _schemaProperties = InsOrd.fromList props
    , _schemaRequired = required
    }

-- | Qualify a schema name with its payload type. Different payload types use
-- different job definitions. A payload with no name leaves the schema inline.
carrying
  :: forall payload
   . (ToSchema payload)
  => Declare (Definitions Schema) NamedSchema
  -> Declare (Definitions Schema) NamedSchema
carrying :: forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying = (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b.
(a -> b)
-> DeclareT (Definitions Schema) Identity a
-> DeclareT (Definitions Schema) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedSchema -> NamedSchema
qualify
  where
    qualify :: NamedSchema -> NamedSchema
qualify (NamedSchema Maybe Text
base Schema
schema) =
      Maybe Text -> Schema -> NamedSchema
NamedSchema ((Text -> Text -> Text) -> Maybe Text -> Maybe Text -> Maybe Text
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\Text
b Text
p -> Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p) Maybe Text
base (Proxy payload -> Maybe Text
forall a. ToSchema a => Proxy a -> Maybe Text
OpenApi.schemaName (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @payload))) Schema
schema

-- | A string schema accepting exactly the names an enum round-trips through.
enumSchema :: forall a p. (Bounded a, Enum a) => (a -> Text) -> p a -> Schema
enumSchema :: forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema a -> Text
name p a
_ = [Text] -> Schema
stringEnum [a -> Text
name a
value | a
value <- [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound :: a]]

-- | A string schema accepting exactly the given values.
stringEnum :: [Text] -> Schema
stringEnum :: [Text] -> Schema
stringEnum [Text]
values =
  Schema
forall a. Monoid a => a
mempty {_schemaType = Just OpenApiString, _schemaEnum = Just (map toJSON values)}

-- ---------------------------------------------------------------------------
-- Parameter schemas
-- ---------------------------------------------------------------------------

instance ToParamSchema JobStatus where
  toParamSchema :: Proxy JobStatus -> Schema
toParamSchema = (JobStatus -> Text) -> Proxy JobStatus -> Schema
forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema JobStatus -> Text
jobStatusToText

instance ToParamSchema JobSortColumn where
  toParamSchema :: Proxy JobSortColumn -> Schema
toParamSchema = (JobSortColumn -> Text) -> Proxy JobSortColumn -> Schema
forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema JobSortColumn -> Text
jobSortColumnName

instance ToParamSchema DLQSortColumn where
  toParamSchema :: Proxy DLQSortColumn -> Schema
toParamSchema = (DLQSortColumn -> Text) -> Proxy DLQSortColumn -> Schema
forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema DLQSortColumn -> Text
dlqSortColumnName

instance ToParamSchema ArchiveSortColumn where
  toParamSchema :: Proxy ArchiveSortColumn -> Schema
toParamSchema = (ArchiveSortColumn -> Text) -> Proxy ArchiveSortColumn -> Schema
forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema ArchiveSortColumn -> Text
archiveSortColumnName

instance ToParamSchema SortDir where
  toParamSchema :: Proxy SortDir -> Schema
toParamSchema = (SortDir -> Text) -> Proxy SortDir -> Schema
forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema SortDir -> Text
sortDirName

instance (KnownNat def) => ToParamSchema (PageSize def) where
  toParamSchema :: Proxy (PageSize def) -> Schema
toParamSchema Proxy (PageSize def)
_ = (HttpStatusCode, HttpStatusCode)
-> Maybe HttpStatusCode -> Schema -> Schema
forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Schema -> Schema
clamped (HttpStatusCode, HttpStatusCode)
pageLimitRange (HttpStatusCode -> Maybe HttpStatusCode
forall a. a -> Maybe a
Just (Proxy def -> HttpStatusCode
forall (def :: Nat) (proxy :: Nat -> *).
KnownNat def =>
proxy def -> HttpStatusCode
pageSizeDefault (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @def))) (Proxy HttpStatusCode -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Int))

-- ---------------------------------------------------------------------------
-- Hand-encoded types
-- ---------------------------------------------------------------------------

-- | A caller-defined payload or result.
instance ToSchema Value where
  declareNamedSchema :: Proxy Value -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Value
_ =
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> NamedSchema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"AnyJson") (Schema -> Declare (Definitions Schema) NamedSchema)
-> Schema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Schema
forall a. Monoid a => a
mempty {_schemaDescription = Just "Caller-defined JSON."}

instance ToSchema JobStatus where
  declareNamedSchema :: Proxy JobStatus -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy JobStatus -> NamedSchema)
-> Proxy JobStatus
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"JobStatus") (Schema -> NamedSchema)
-> (Proxy JobStatus -> Schema) -> Proxy JobStatus -> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy JobStatus -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema

instance ToSchema WorkerHealth where
  declareNamedSchema :: Proxy WorkerHealth -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy WorkerHealth -> NamedSchema)
-> Proxy WorkerHealth
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"WorkerHealth") (Schema -> NamedSchema)
-> (Proxy WorkerHealth -> Schema)
-> Proxy WorkerHealth
-> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkerHealth -> Text) -> Proxy WorkerHealth -> Schema
forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema WorkerHealth -> Text
workerHealthToText

instance ToSchema HealthStatus where
  declareNamedSchema :: Proxy HealthStatus -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Proxy HealthStatus -> NamedSchema)
-> Proxy HealthStatus
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"HealthStatus") (Schema -> NamedSchema)
-> (Proxy HealthStatus -> Schema)
-> Proxy HealthStatus
-> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HealthStatus -> Text) -> Proxy HealthStatus -> Schema
forall a (p :: * -> *).
(Bounded a, Enum a) =>
(a -> Text) -> p a -> Schema
enumSchema HealthStatus -> Text
healthStatusToText

instance ToSchema DedupKey where
  declareNamedSchema :: Proxy DedupKey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy DedupKey
_ =
    Text -> Fields DedupKey -> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"DedupKey" (Fields DedupKey -> Declare (Definitions Schema) NamedSchema)
-> Fields DedupKey -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      -- Use the strategy field to select the constructor for this tagged pair.
      (\Text
key Text
_strategy -> Text -> DedupKey
IgnoreDuplicate Text
key)
        (Text -> Text -> DedupKey)
-> Fields Text -> Fields (Text -> DedupKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"key"
        Fields (Text -> DedupKey) -> Fields Text -> Fields DedupKey
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Text -> Schema -> Fields a
forall {k} (a :: k). Text -> Schema -> Fields a
inlineProp @Text Text
"strategy" ([Text] -> Schema
stringEnum [Text
"ignore", Text
"replace"])

instance ToSchema RateLimitKey where
  declareNamedSchema :: Proxy RateLimitKey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy RateLimitKey
_ = (Text -> Text -> RateLimitKey)
-> Text -> Declare (Definitions Schema) NamedSchema
forall a.
(Text -> Text -> a)
-> Text -> Declare (Definitions Schema) NamedSchema
admissionKeySchema Text -> Text -> RateLimitKey
RateLimitKey Text
"RateLimitKey"

instance ToSchema ConcurrencyKey where
  declareNamedSchema :: Proxy ConcurrencyKey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ConcurrencyKey
_ = (Text -> Text -> ConcurrencyKey)
-> Text -> Declare (Definitions Schema) NamedSchema
forall a.
(Text -> Text -> a)
-> Text -> Declare (Definitions Schema) NamedSchema
admissionKeySchema Text -> Text -> ConcurrencyKey
ConcurrencyKey Text
"ConcurrencyKey"

-- | A gate key, split into the policy prefix and the per-job suffix.
admissionKeySchema
  :: (Text -> Text -> a) -> Text -> Declare (Definitions Schema) NamedSchema
admissionKeySchema :: forall a.
(Text -> Text -> a)
-> Text -> Declare (Definitions Schema) NamedSchema
admissionKeySchema Text -> Text -> a
mkKey Text
name =
  Text -> Fields a -> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
name (Text -> Text -> a
mkKey (Text -> Text -> a) -> Fields Text -> Fields (Text -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"prefix" Fields (Text -> a) -> Fields Text -> Fields a
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"suffix")

-- | Fields written by the 'JobRead' encoder. The record
-- constructor checks their types and order. Reconstruct the trace context and
-- payload keys from their flattened fields. The encoder derives @isRollup@.
jobFields :: forall payload. (ToSchema payload) => Fields (JobRead payload)
jobFields :: forall payload. ToSchema payload => Fields (JobRead payload)
jobFields =
  Int64
-> payload
-> Text
-> Maybe Text
-> UTCTime
-> Maybe UTCTime
-> Int32
-> Maybe Text
-> Int32
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe DedupKey
-> Maybe Int32
-> Maybe Int64
-> Maybe Value
-> Maybe TraceContext
-> Bool
-> Maybe UUID
-> Int64
-> Maybe Int32
-> PayloadKeys
-> JobRecord payload Int64 Text UTCTime PayloadKeys
forall payload key q insertedAt adm.
key
-> payload
-> q
-> Maybe Text
-> insertedAt
-> Maybe UTCTime
-> Int32
-> Maybe Text
-> Int32
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe DedupKey
-> Maybe Int32
-> Maybe Int64
-> Maybe Value
-> Maybe TraceContext
-> Bool
-> Maybe UUID
-> Int64
-> Maybe Int32
-> adm
-> JobRecord payload key q insertedAt adm
Job
    (Int64
 -> payload
 -> Text
 -> Maybe Text
 -> UTCTime
 -> Maybe UTCTime
 -> Int32
 -> Maybe Text
 -> Int32
 -> Maybe UTCTime
 -> Maybe UTCTime
 -> Maybe DedupKey
 -> Maybe Int32
 -> Maybe Int64
 -> Maybe Value
 -> Maybe TraceContext
 -> Bool
 -> Maybe UUID
 -> Int64
 -> Maybe Int32
 -> PayloadKeys
 -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields Int64
-> Fields
     (payload
      -> Text
      -> Maybe Text
      -> UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"primaryKey"
    Fields
  (payload
   -> Text
   -> Maybe Text
   -> UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields payload
-> Fields
     (Text
      -> Maybe Text
      -> UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall payload. ToSchema payload => Text -> Fields payload
payloadProp @payload Text
"payload"
    Fields
  (Text
   -> Maybe Text
   -> UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields Text
-> Fields
     (Maybe Text
      -> UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"queueName"
    Fields
  (Maybe Text
   -> UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe Text)
-> Fields
     (UTCTime
      -> Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Text Text
"groupKey"
    Fields
  (UTCTime
   -> Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields UTCTime
-> Fields
     (Maybe UTCTime
      -> Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @UTCTime Text
"insertedAt"
    Fields
  (Maybe UTCTime
   -> Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe UTCTime)
-> Fields
     (Int32
      -> Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @UTCTime Text
"updatedAt"
    Fields
  (Int32
   -> Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields Int32
-> Fields
     (Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int32 Text
"attempts"
    Fields
  (Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe Text)
-> Fields
     (Int32
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Text Text
"lastError"
    Fields
  (Int32
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields Int32
-> Fields
     (Maybe UTCTime
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int32 Text
"priority"
    Fields
  (Maybe UTCTime
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe UTCTime)
-> Fields
     (Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @UTCTime Text
"lastAttemptedAt"
    Fields
  (Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe UTCTime)
-> Fields
     (Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @UTCTime Text
"notVisibleUntil"
    Fields
  (Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe DedupKey)
-> Fields
     (Maybe Int32
      -> Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @DedupKey Text
"dedupKey"
    Fields
  (Maybe Int32
   -> Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe Int32)
-> Fields
     (Maybe Int64
      -> Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Int32 Text
"maxAttempts"
    Fields
  (Maybe Int64
   -> Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe Int64)
-> Fields
     (Maybe Value
      -> Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Int64 Text
"parentId"
    Fields
  (Maybe Value
   -> Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe Value)
-> Fields
     (Maybe TraceContext
      -> Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Value Text
"parentState"
    Fields
  (Maybe TraceContext
   -> Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe TraceContext)
-> Fields
     (Bool
      -> Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Text -> Maybe Text -> Maybe TraceContext
toTraceContext (Maybe Text -> Maybe Text -> Maybe TraceContext)
-> Fields (Maybe Text) -> Fields (Maybe Text -> Maybe TraceContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Text Text
"traceparent" Fields (Maybe Text -> Maybe TraceContext)
-> Fields (Maybe Text) -> Fields (Maybe TraceContext)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Text Text
"tracestate")
    Fields
  (Bool
   -> Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields Bool
-> Fields
     (Maybe UUID
      -> Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Bool Text
"suspended"
    Fields
  (Maybe UUID
   -> Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe UUID)
-> Fields
     (Int64
      -> Maybe Int32
      -> PayloadKeys
      -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @UUID Text
"claimedBy"
    Fields
  (Int64
   -> Maybe Int32
   -> PayloadKeys
   -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields Int64
-> Fields
     (Maybe Int32
      -> PayloadKeys -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"claimSeq"
    Fields
  (Maybe Int32
   -> PayloadKeys -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields (Maybe Int32)
-> Fields
     (PayloadKeys -> JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Int32 Text
"archiveFor"
    Fields
  (PayloadKeys -> JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields PayloadKeys
-> Fields (JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Maybe Text
-> Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys
PayloadKeys
            (Maybe Text
 -> Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys)
-> Fields (Maybe Text)
-> Fields
     (Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Text Text
"kind"
            Fields (Maybe RateLimitKey -> Maybe ConcurrencyKey -> PayloadKeys)
-> Fields (Maybe RateLimitKey)
-> Fields (Maybe ConcurrencyKey -> PayloadKeys)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @RateLimitKey Text
"rateLimit"
            Fields (Maybe ConcurrencyKey -> PayloadKeys)
-> Fields (Maybe ConcurrencyKey) -> Fields PayloadKeys
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @ConcurrencyKey Text
"concurrency"
        )
    Fields (JobRecord payload Int64 Text UTCTime PayloadKeys)
-> Fields Bool
-> Fields (JobRecord payload Int64 Text UTCTime PayloadKeys)
forall a b. Fields a -> Fields b -> Fields a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Bool Text
"isRollup"

-- | A stored payload documents as the payload it decodes to.
instance (ToSchema payload) => ToSchema (Stored payload) where
  declareNamedSchema :: Proxy (Stored payload) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Stored payload)
_ = Proxy payload -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @payload)

instance (ToSchema payload) => ToSchema (JobRead payload) where
  declareNamedSchema :: Proxy (JobRead payload) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (JobRead payload)
_ = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> Fields (JobRead payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"Job" (forall payload. ToSchema payload => Fields (JobRead payload)
jobFields @payload)

instance (ToSchema payload) => ToSchema (ApiJobWithStatus payload) where
  declareNamedSchema :: Proxy (ApiJobWithStatus payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (ApiJobWithStatus payload)
_ =
    forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Text
-> Fields (JobRead payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema
        Text
"JobWithStatus"
        (forall payload. ToSchema payload => Fields (JobRead payload)
jobFields @payload Fields (JobRead payload)
-> Fields JobStatus -> Fields (JobRead payload)
forall a b. Fields a -> Fields b -> Fields a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @JobStatus Text
"status")

instance (ToSchema payload) => ToSchema (ApiJobWrite payload) where
  declareNamedSchema :: Proxy (ApiJobWrite payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (ApiJobWrite payload)
_ =
    forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload
      (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> [Text]
-> Fields (JobWrite payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text
-> [Text] -> Fields a -> Declare (Definitions Schema) NamedSchema
objectSchema Text
"JobWrite" [Text
"payload"]
      (Fields (JobWrite payload)
 -> Declare (Definitions Schema) NamedSchema)
-> Fields (JobWrite payload)
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ ( \payload
value Maybe Text
group Int32
priority Maybe UTCTime
visibleAt Maybe DedupKey
dedup Maybe Int32
attempts Maybe Int32
retention ->
            Maybe Int32 -> JobWrite payload -> JobWrite payload
forall payload. Maybe Int32 -> JobWrite payload -> JobWrite payload
setArchiveFor Maybe Int32
retention
              (JobWrite payload -> JobWrite payload)
-> (JobWrite payload -> JobWrite payload)
-> JobWrite payload
-> JobWrite payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int32 -> JobWrite payload -> JobWrite payload
forall payload. Maybe Int32 -> JobWrite payload -> JobWrite payload
setMaxAttempts Maybe Int32
attempts
              (JobWrite payload -> JobWrite payload)
-> (JobWrite payload -> JobWrite payload)
-> JobWrite payload
-> JobWrite payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DedupKey -> JobWrite payload -> JobWrite payload
forall payload.
Maybe DedupKey -> JobWrite payload -> JobWrite payload
setDedupKey Maybe DedupKey
dedup
              (JobWrite payload -> JobWrite payload)
-> (JobWrite payload -> JobWrite payload)
-> JobWrite payload
-> JobWrite payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime -> JobWrite payload -> JobWrite payload
forall payload.
Maybe UTCTime -> JobWrite payload -> JobWrite payload
setNotVisibleUntil Maybe UTCTime
visibleAt
              (JobWrite payload -> JobWrite payload)
-> (JobWrite payload -> JobWrite payload)
-> JobWrite payload
-> JobWrite payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> JobWrite payload -> JobWrite payload
forall payload. Int32 -> JobWrite payload -> JobWrite payload
setPriority Int32
priority
              (JobWrite payload -> JobWrite payload)
-> (JobWrite payload -> JobWrite payload)
-> JobWrite payload
-> JobWrite payload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> JobWrite payload -> JobWrite payload
forall payload. Maybe Text -> JobWrite payload -> JobWrite payload
setGroupKey Maybe Text
group
              (JobWrite payload -> JobWrite payload)
-> JobWrite payload -> JobWrite payload
forall a b. (a -> b) -> a -> b
$ payload -> JobWrite payload
forall payload. payload -> JobWrite payload
defaultJob payload
value
        )
        (payload
 -> Maybe Text
 -> Int32
 -> Maybe UTCTime
 -> Maybe DedupKey
 -> Maybe Int32
 -> Maybe Int32
 -> JobWrite payload)
-> Fields payload
-> Fields
     (Maybe Text
      -> Int32
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int32
      -> JobWrite payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall payload. ToSchema payload => Text -> Fields payload
payloadProp @payload Text
"payload"
        Fields
  (Maybe Text
   -> Int32
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int32
   -> JobWrite payload)
-> Fields (Maybe Text)
-> Fields
     (Int32
      -> Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int32
      -> JobWrite payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Text Text
"groupKey"
        Fields
  (Int32
   -> Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int32
   -> JobWrite payload)
-> Fields Int32
-> Fields
     (Maybe UTCTime
      -> Maybe DedupKey
      -> Maybe Int32
      -> Maybe Int32
      -> JobWrite payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int32 Text
"priority"
        Fields
  (Maybe UTCTime
   -> Maybe DedupKey
   -> Maybe Int32
   -> Maybe Int32
   -> JobWrite payload)
-> Fields (Maybe UTCTime)
-> Fields
     (Maybe DedupKey -> Maybe Int32 -> Maybe Int32 -> JobWrite payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @UTCTime Text
"notVisibleUntil"
        Fields
  (Maybe DedupKey -> Maybe Int32 -> Maybe Int32 -> JobWrite payload)
-> Fields (Maybe DedupKey)
-> Fields (Maybe Int32 -> Maybe Int32 -> JobWrite payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @DedupKey Text
"dedupKey"
        Fields (Maybe Int32 -> Maybe Int32 -> JobWrite payload)
-> Fields (Maybe Int32) -> Fields (Maybe Int32 -> JobWrite payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Int32 Text
"maxAttempts"
        Fields (Maybe Int32 -> JobWrite payload)
-> Fields (Maybe Int32) -> Fields (JobWrite payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Int32 Text
"archiveFor"

instance (ToSchema payload) => ToSchema (DLQ.DLQJob payload) where
  declareNamedSchema :: Proxy (DLQJob payload) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (DLQJob payload)
_ =
    forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload
      (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> Fields (DLQJob payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"DLQEntry"
      (Fields (DLQJob payload)
 -> Declare (Definitions Schema) NamedSchema)
-> Fields (DLQJob payload)
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime -> JobRead payload -> DLQJob payload
forall payload.
Int64 -> UTCTime -> JobSnapshot payload -> DLQJob payload
DLQ.DLQJob
        (Int64 -> UTCTime -> JobRead payload -> DLQJob payload)
-> Fields Int64
-> Fields (UTCTime -> JobRead payload -> DLQJob payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"dlqPrimaryKey"
        Fields (UTCTime -> JobRead payload -> DLQJob payload)
-> Fields UTCTime -> Fields (JobRead payload -> DLQJob payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @UTCTime Text
"failedAt"
        Fields (JobRead payload -> DLQJob payload)
-> Fields (JobRead payload) -> Fields (DLQJob payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @(JobRead payload) Text
"jobSnapshot"

instance (ToSchema payload) => ToSchema (Archive.ArchiveJob payload) where
  declareNamedSchema :: Proxy (ArchiveJob payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (ArchiveJob payload)
_ =
    forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload
      (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> Fields (ArchiveJob payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"ArchiveEntry"
      (Fields (ArchiveJob payload)
 -> Declare (Definitions Schema) NamedSchema)
-> Fields (ArchiveJob payload)
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Int64
-> UTCTime -> JobRead payload -> Maybe Value -> ArchiveJob payload
forall payload.
Int64
-> UTCTime
-> JobSnapshot payload
-> Maybe Value
-> ArchiveJob payload
Archive.ArchiveJob
        (Int64
 -> UTCTime -> JobRead payload -> Maybe Value -> ArchiveJob payload)
-> Fields Int64
-> Fields
     (UTCTime -> JobRead payload -> Maybe Value -> ArchiveJob payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"archivePrimaryKey"
        Fields
  (UTCTime -> JobRead payload -> Maybe Value -> ArchiveJob payload)
-> Fields UTCTime
-> Fields (JobRead payload -> Maybe Value -> ArchiveJob payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @UTCTime Text
"completedAt"
        Fields (JobRead payload -> Maybe Value -> ArchiveJob payload)
-> Fields (JobRead payload)
-> Fields (Maybe Value -> ArchiveJob payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @(JobRead payload) Text
"jobSnapshot"
        Fields (Maybe Value -> ArchiveJob payload)
-> Fields (Maybe Value) -> Fields (ArchiveJob payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Value Text
"result"

instance ToSchema JobLease where
  declareNamedSchema :: Proxy JobLease -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy JobLease
_ = Text -> Fields JobLease -> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"JobLease" Fields JobLease
leaseFields

-- | Ack request with an optional queue result.
instance (ToSchema result) => ToSchema (AckRequest result) where
  declareNamedSchema :: Proxy (AckRequest result)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (AckRequest result)
_ =
    forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @result (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Text
-> [Text]
-> Fields (AckRequest result)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text
-> [Text] -> Fields a -> Declare (Definitions Schema) NamedSchema
objectSchema
        Text
"AckRequest"
        [Text]
leaseRequired
        (JobLease -> Maybe result -> AckRequest result
forall result. JobLease -> Maybe result -> AckRequest result
AckRequest (JobLease -> Maybe result -> AckRequest result)
-> Fields JobLease -> Fields (Maybe result -> AckRequest result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fields JobLease
leaseFields Fields (Maybe result -> AckRequest result)
-> Fields (Maybe result) -> Fields (AckRequest result)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @result Text
"result")

instance ToSchema ExtendRequest where
  declareNamedSchema :: Proxy ExtendRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ExtendRequest
_ =
    Text
-> Fields ExtendRequest -> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema
      Text
"ExtendRequest"
      (JobLease -> Double -> ExtendRequest
ExtendRequest (JobLease -> Double -> ExtendRequest)
-> Fields JobLease -> Fields (Double -> ExtendRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fields JobLease
leaseFields Fields (Double -> ExtendRequest)
-> Fields Double -> Fields ExtendRequest
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double, Double) -> Maybe Double -> Fields Double -> Fields Double
forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields n -> Fields n
within (Double, Double)
leaseSecondsRange Maybe Double
forall a. Maybe a
Nothing (forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Double Text
"leaseSeconds"))

-- | Lease fields at the top level of the request body.
leaseFields :: Fields JobLease
leaseFields :: Fields JobLease
leaseFields = Int64 -> UUID -> JobLease
JobLease (Int64 -> UUID -> JobLease)
-> Fields Int64 -> Fields (UUID -> JobLease)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"claimSeq" Fields (UUID -> JobLease) -> Fields UUID -> Fields JobLease
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @UUID Text
"claimedBy"

leaseRequired :: [Text]
leaseRequired :: [Text]
leaseRequired = [Text
"claimSeq", Text
"claimedBy"]

instance (ToSchema payload) => ToSchema (PayloadEdit payload) where
  declareNamedSchema :: Proxy (PayloadEdit payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (PayloadEdit payload)
_ =
    forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> Fields (PayloadEdit payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"PayloadEdit" (payload -> PayloadEdit payload
forall payload. payload -> PayloadEdit payload
PayloadEdit (payload -> PayloadEdit payload)
-> Fields payload -> Fields (PayloadEdit payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall payload. ToSchema payload => Text -> Fields payload
payloadProp @payload Text
"payload")

instance ToSchema ClaimRequest where
  declareNamedSchema :: Proxy ClaimRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ClaimRequest
_ =
    Text
-> [Text]
-> Fields ClaimRequest
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text
-> [Text] -> Fields a -> Declare (Definitions Schema) NamedSchema
objectSchema Text
"ClaimRequest" [] (Fields ClaimRequest -> Declare (Definitions Schema) NamedSchema)
-> Fields ClaimRequest -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe HttpStatusCode -> Maybe Double -> ClaimRequest
ClaimRequest
        (Maybe HttpStatusCode -> Maybe Double -> ClaimRequest)
-> Fields (Maybe HttpStatusCode)
-> Fields (Maybe Double -> ClaimRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HttpStatusCode, HttpStatusCode)
-> Maybe HttpStatusCode
-> Fields (Maybe HttpStatusCode)
-> Fields (Maybe HttpStatusCode)
forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields (Maybe n) -> Fields (Maybe n)
optWithin (HttpStatusCode, HttpStatusCode)
claimJobsRange (HttpStatusCode -> Maybe HttpStatusCode
forall a. a -> Maybe a
Just HttpStatusCode
defaultClaimJobs) (forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Int Text
"maxJobs")
        Fields (Maybe Double -> ClaimRequest)
-> Fields (Maybe Double) -> Fields ClaimRequest
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double, Double)
-> Maybe Double -> Fields (Maybe Double) -> Fields (Maybe Double)
forall n.
(Real n, ToJSON n) =>
(n, n) -> Maybe n -> Fields (Maybe n) -> Fields (Maybe n)
optWithin (Double, Double)
leaseSecondsRange (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
defaultLeaseSeconds) (forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Double Text
"leaseSeconds")

instance ToSchema AddTokensRequest where
  declareNamedSchema :: Proxy AddTokensRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy AddTokensRequest
_ = Text
-> Fields AddTokensRequest
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"AddTokensRequest" (Double -> AddTokensRequest
AddTokensRequest (Double -> AddTokensRequest)
-> Fields Double -> Fields AddTokensRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Double Text
"tokens")

instance ToSchema GroupSummary where
  declareNamedSchema :: Proxy GroupSummary -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy GroupSummary
_ =
    Text
-> Fields GroupSummary -> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"GroupSummary" (Fields GroupSummary -> Declare (Definitions Schema) NamedSchema)
-> Fields GroupSummary -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Text
-> Int64
-> Int64
-> Maybe UTCTime
-> Maybe UTCTime
-> Bool
-> Maybe Int64
-> Maybe JobStatus
-> Bool
-> GroupSummary
GroupSummary
        (Text
 -> Int64
 -> Int64
 -> Maybe UTCTime
 -> Maybe UTCTime
 -> Bool
 -> Maybe Int64
 -> Maybe JobStatus
 -> Bool
 -> GroupSummary)
-> Fields Text
-> Fields
     (Int64
      -> Int64
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Maybe Int64
      -> Maybe JobStatus
      -> Bool
      -> GroupSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"groupKey"
        Fields
  (Int64
   -> Int64
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Maybe Int64
   -> Maybe JobStatus
   -> Bool
   -> GroupSummary)
-> Fields Int64
-> Fields
     (Int64
      -> Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Maybe Int64
      -> Maybe JobStatus
      -> Bool
      -> GroupSummary)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"jobCount"
        Fields
  (Int64
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Maybe Int64
   -> Maybe JobStatus
   -> Bool
   -> GroupSummary)
-> Fields Int64
-> Fields
     (Maybe UTCTime
      -> Maybe UTCTime
      -> Bool
      -> Maybe Int64
      -> Maybe JobStatus
      -> Bool
      -> GroupSummary)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"readyCount"
        Fields
  (Maybe UTCTime
   -> Maybe UTCTime
   -> Bool
   -> Maybe Int64
   -> Maybe JobStatus
   -> Bool
   -> GroupSummary)
-> Fields (Maybe UTCTime)
-> Fields
     (Maybe UTCTime
      -> Bool -> Maybe Int64 -> Maybe JobStatus -> Bool -> GroupSummary)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @UTCTime Text
"nextDue"
        Fields
  (Maybe UTCTime
   -> Bool -> Maybe Int64 -> Maybe JobStatus -> Bool -> GroupSummary)
-> Fields (Maybe UTCTime)
-> Fields
     (Bool -> Maybe Int64 -> Maybe JobStatus -> Bool -> GroupSummary)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @UTCTime Text
"inFlightUntil"
        Fields
  (Bool -> Maybe Int64 -> Maybe JobStatus -> Bool -> GroupSummary)
-> Fields Bool
-> Fields (Maybe Int64 -> Maybe JobStatus -> Bool -> GroupSummary)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Bool Text
"inFlight"
        Fields (Maybe Int64 -> Maybe JobStatus -> Bool -> GroupSummary)
-> Fields (Maybe Int64)
-> Fields (Maybe JobStatus -> Bool -> GroupSummary)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Int64 Text
"headJobId"
        Fields (Maybe JobStatus -> Bool -> GroupSummary)
-> Fields (Maybe JobStatus) -> Fields (Bool -> GroupSummary)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @JobStatus Text
"headStatus"
        Fields (Bool -> GroupSummary) -> Fields Bool -> Fields GroupSummary
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Bool Text
"headBlocked"

instance ToSchema MaintenanceResponse where
  declareNamedSchema :: Proxy MaintenanceResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy MaintenanceResponse
_ =
    Text
-> Fields MaintenanceResponse
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"MaintenanceResponse" (Fields MaintenanceResponse
 -> Declare (Definitions Schema) NamedSchema)
-> Fields MaintenanceResponse
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Map Text Int64 -> [Text] -> MaintenanceResponse
MaintenanceResponse (Map Text Int64 -> [Text] -> MaintenanceResponse)
-> Fields (Map Text Int64)
-> Fields ([Text] -> MaintenanceResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @(Map Text Int64) Text
"ops" Fields ([Text] -> MaintenanceResponse)
-> Fields [Text] -> Fields MaintenanceResponse
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @[Text] Text
"failed"

instance ToSchema CronScheduleView where
  declareNamedSchema :: Proxy CronScheduleView -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CronScheduleView
_ = do
    row <- Proxy CronScheduleRow
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
forall a.
ToSchema a =>
Proxy a
-> DeclareT (Definitions Schema) Identity (Referenced Schema)
declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @CronScheduleRow)
    NamedSchema _ added <- closedSchema "" (opt @UTCTime "nextRunAt")
    pure . NamedSchema (Just "CronScheduleView") $
      mempty
        { _schemaAllOf = Just [row, Inline added]
        , _schemaDescription =
            Just "A schedule row plus the next tick it fires at. It is null when the schedule is disabled or has no next tick."
        }

instance ToSchema QueueStats where
  declareNamedSchema :: Proxy QueueStats -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy QueueStats
_ =
    Text
-> Fields QueueStats -> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"QueueStats" (Fields QueueStats -> Declare (Definitions Schema) NamedSchema)
-> Fields QueueStats -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Maybe Double
-> Maybe Double
-> Int64
-> Map Text Int64
-> Map Text Int64
-> QueueStats
QueueStats
        (Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int64
 -> Int64
 -> Maybe Double
 -> Maybe Double
 -> Int64
 -> Map Text Int64
 -> Map Text Int64
 -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"totalJobs"
        Fields
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"readyJobs"
        Fields
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"inFlightJobs"
        Fields
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"scheduledJobs"
        Fields
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"backoffJobs"
        Fields
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"throttledJobs"
        Fields
  (Int64
   -> Int64
   -> Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"suspendedJobs"
        Fields
  (Int64
   -> Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"cancelledJobs"
        Fields
  (Int64
   -> Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Int64
      -> Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"exhaustedJobs"
        Fields
  (Int64
   -> Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields Int64
-> Fields
     (Maybe Double
      -> Maybe Double
      -> Int64
      -> Map Text Int64
      -> Map Text Int64
      -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"blockedJobs"
        Fields
  (Maybe Double
   -> Maybe Double
   -> Int64
   -> Map Text Int64
   -> Map Text Int64
   -> QueueStats)
-> Fields (Maybe Double)
-> Fields
     (Maybe Double
      -> Int64 -> Map Text Int64 -> Map Text Int64 -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Double Text
"oldestReadyAgeSeconds"
        Fields
  (Maybe Double
   -> Int64 -> Map Text Int64 -> Map Text Int64 -> QueueStats)
-> Fields (Maybe Double)
-> Fields (Int64 -> Map Text Int64 -> Map Text Int64 -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Double Text
"oldestInFlightAgeSeconds"
        Fields (Int64 -> Map Text Int64 -> Map Text Int64 -> QueueStats)
-> Fields Int64
-> Fields (Map Text Int64 -> Map Text Int64 -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"dlqJobs"
        Fields (Map Text Int64 -> Map Text Int64 -> QueueStats)
-> Fields (Map Text Int64) -> Fields (Map Text Int64 -> QueueStats)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @(Map Text Int64) Text
"kindCounts"
        Fields (Map Text Int64 -> QueueStats)
-> Fields (Map Text Int64) -> Fields QueueStats
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @(Map Text Int64) Text
"dlqKindCounts"

instance ToSchema QueueOverview where
  declareNamedSchema :: Proxy QueueOverview -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy QueueOverview
_ =
    Text
-> Fields QueueOverview -> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"QueueOverview" (Fields QueueOverview -> Declare (Definitions Schema) NamedSchema)
-> Fields QueueOverview -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Text -> QueueStats -> Bool -> Int64 -> Int64 -> QueueOverview
QueueOverview
        (Text -> QueueStats -> Bool -> Int64 -> Int64 -> QueueOverview)
-> Fields Text
-> Fields (QueueStats -> Bool -> Int64 -> Int64 -> QueueOverview)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"queue"
        Fields (QueueStats -> Bool -> Int64 -> Int64 -> QueueOverview)
-> Fields QueueStats
-> Fields (Bool -> Int64 -> Int64 -> QueueOverview)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @QueueStats Text
"stats"
        Fields (Bool -> Int64 -> Int64 -> QueueOverview)
-> Fields Bool -> Fields (Int64 -> Int64 -> QueueOverview)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Bool Text
"paused"
        Fields (Int64 -> Int64 -> QueueOverview)
-> Fields Int64 -> Fields (Int64 -> QueueOverview)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"workersLive"
        Fields (Int64 -> QueueOverview)
-> Fields Int64 -> Fields QueueOverview
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int64 Text
"workersPaused"

instance ToSchema RateLimitBucketView where
  declareNamedSchema :: Proxy RateLimitBucketView
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy RateLimitBucketView
_ =
    Text
-> Fields RateLimitBucketView
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"RateLimitBucketView" (Fields RateLimitBucketView
 -> Declare (Definitions Schema) NamedSchema)
-> Fields RateLimitBucketView
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Text
-> Text
-> Double
-> Double
-> Maybe Double
-> UTCTime
-> RateLimitBucketView
RateLimitBucketView
        (Text
 -> Text
 -> Double
 -> Double
 -> Maybe Double
 -> UTCTime
 -> RateLimitBucketView)
-> Fields Text
-> Fields
     (Text
      -> Double
      -> Double
      -> Maybe Double
      -> UTCTime
      -> RateLimitBucketView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"key"
        Fields
  (Text
   -> Double
   -> Double
   -> Maybe Double
   -> UTCTime
   -> RateLimitBucketView)
-> Fields Text
-> Fields
     (Double
      -> Double -> Maybe Double -> UTCTime -> RateLimitBucketView)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"prefix"
        Fields
  (Double
   -> Double -> Maybe Double -> UTCTime -> RateLimitBucketView)
-> Fields Double
-> Fields
     (Double -> Maybe Double -> UTCTime -> RateLimitBucketView)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Double Text
"tokens"
        Fields (Double -> Maybe Double -> UTCTime -> RateLimitBucketView)
-> Fields Double
-> Fields (Maybe Double -> UTCTime -> RateLimitBucketView)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Double Text
"maxTokens"
        Fields (Maybe Double -> UTCTime -> RateLimitBucketView)
-> Fields (Maybe Double) -> Fields (UTCTime -> RateLimitBucketView)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Double Text
"fillFraction"
        Fields (UTCTime -> RateLimitBucketView)
-> Fields UTCTime -> Fields RateLimitBucketView
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @UTCTime Text
"lastRefill"

instance ToSchema RateLimitPolicyUpdate where
  declareNamedSchema :: Proxy RateLimitPolicyUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy RateLimitPolicyUpdate
_ =
    -- A patch field is Maybe (Maybe a). An absent field leaves the override alone.
    -- A null clears it. The schema describes the inner value.
    Text
-> [Text]
-> Fields RateLimitPolicyUpdate
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text
-> [Text] -> Fields a -> Declare (Definitions Schema) NamedSchema
objectSchema Text
"RateLimitPolicyUpdate" [] (Fields RateLimitPolicyUpdate
 -> Declare (Definitions Schema) NamedSchema)
-> Fields RateLimitPolicyUpdate
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe (Maybe Double)
-> Maybe (Maybe Double)
-> Maybe (Maybe Double)
-> RateLimitPolicyUpdate
RateLimitPolicyUpdate
        (Maybe (Maybe Double)
 -> Maybe (Maybe Double)
 -> Maybe (Maybe Double)
 -> RateLimitPolicyUpdate)
-> Fields (Maybe (Maybe Double))
-> Fields
     (Maybe (Maybe Double)
      -> Maybe (Maybe Double) -> RateLimitPolicyUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (Maybe (Maybe a))
patch @Double Text
"overrideMaxTokens"
        Fields
  (Maybe (Maybe Double)
   -> Maybe (Maybe Double) -> RateLimitPolicyUpdate)
-> Fields (Maybe (Maybe Double))
-> Fields (Maybe (Maybe Double) -> RateLimitPolicyUpdate)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe (Maybe a))
patch @Double Text
"overrideRefillAmount"
        Fields (Maybe (Maybe Double) -> RateLimitPolicyUpdate)
-> Fields (Maybe (Maybe Double)) -> Fields RateLimitPolicyUpdate
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe (Maybe a))
patch @Double Text
"overrideInterval"

instance ToSchema ConcurrencyKeyView where
  declareNamedSchema :: Proxy ConcurrencyKeyView
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ConcurrencyKeyView
_ =
    Text
-> Fields ConcurrencyKeyView
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"ConcurrencyKeyView" (Fields ConcurrencyKeyView
 -> Declare (Definitions Schema) NamedSchema)
-> Fields ConcurrencyKeyView
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Text
-> Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView
ConcurrencyKeyView
        (Text
 -> Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Fields Text
-> Fields
     (Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"key"
        Fields
  (Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Fields Text
-> Fields (Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Text Text
"prefix"
        Fields (Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Fields Int32
-> Fields (Int32 -> Maybe Double -> ConcurrencyKeyView)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int32 Text
"inFlight"
        Fields (Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Fields Int32 -> Fields (Maybe Double -> ConcurrencyKeyView)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int32 Text
"effectiveLimit"
        Fields (Maybe Double -> ConcurrencyKeyView)
-> Fields (Maybe Double) -> Fields ConcurrencyKeyView
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (Maybe a)
opt @Double Text
"fillFraction"

instance ToSchema ConcurrencyPolicyUpdate where
  declareNamedSchema :: Proxy ConcurrencyPolicyUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ConcurrencyPolicyUpdate
_ =
    Text
-> [Text]
-> Fields ConcurrencyPolicyUpdate
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text
-> [Text] -> Fields a -> Declare (Definitions Schema) NamedSchema
objectSchema Text
"ConcurrencyPolicyUpdate" [] (Fields ConcurrencyPolicyUpdate
 -> Declare (Definitions Schema) NamedSchema)
-> Fields ConcurrencyPolicyUpdate
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe (Maybe Int32) -> ConcurrencyPolicyUpdate
ConcurrencyPolicyUpdate (Maybe (Maybe Int32) -> ConcurrencyPolicyUpdate)
-> Fields (Maybe (Maybe Int32)) -> Fields ConcurrencyPolicyUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (Maybe (Maybe a))
patch @Int32 Text
"overrideLimit"

-- ---------------------------------------------------------------------------
-- Generic schemas, matching the generic JSON these types derive
-- ---------------------------------------------------------------------------

-- | A generic schema under a name of its own. A type applied to its payload is named
-- after its constructor alone. 'carrying' adds the payload back.
renamed
  :: forall a
   . (GToSchema (Rep a), Generic a, Typeable a)
  => Text
  -> Proxy a
  -> Declare (Definitions Schema) NamedSchema
renamed :: forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
name Proxy a
proxy = NamedSchema -> NamedSchema
rename (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic Proxy a
proxy
  where
    rename :: NamedSchema -> NamedSchema
rename (NamedSchema Maybe Text
_ Schema
schema) = Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) Schema
schema

-- | A generic schema whose optional fields accept null, as generic JSON encodes 'Nothing'.
generic
  :: forall a
   . (GToSchema (Rep a), Generic a, Typeable a)
  => Proxy a
  -> Declare (Definitions Schema) NamedSchema
generic :: forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic Proxy a
proxy = NamedSchema -> NamedSchema
orNull (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a), Typeable a) =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema SchemaOptions
defaultSchemaOptions Proxy a
proxy
  where
    orNull :: NamedSchema -> NamedSchema
orNull (NamedSchema Maybe Text
name Schema
schema) =
      Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
name Schema
schema {_schemaProperties = InsOrd.mapWithKey (optional schema) (_schemaProperties schema)}
    optional :: Schema -> Text -> Referenced Schema -> Referenced Schema
optional Schema
schema Text
field Referenced Schema
ref
      | Text
field Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Schema -> [Text]
_schemaRequired Schema
schema = Referenced Schema
ref
      | Bool
otherwise = Referenced Schema -> Referenced Schema
nullable Referenced Schema
ref

instance ToSchema QueueRow where declareNamedSchema :: Proxy QueueRow -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy QueueRow -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema WorkerRow where declareNamedSchema :: Proxy WorkerRow -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy WorkerRow -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema CronScheduleRow where declareNamedSchema :: Proxy CronScheduleRow -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy CronScheduleRow -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema CronScheduleUpdate where declareNamedSchema :: Proxy CronScheduleUpdate
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy CronScheduleUpdate
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema PgDbHealth where declareNamedSchema :: Proxy PgDbHealth -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy PgDbHealth -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema RateLimitPolicyView where declareNamedSchema :: Proxy RateLimitPolicyView
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy RateLimitPolicyView
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema ConcurrencyPolicyView where declareNamedSchema :: Proxy ConcurrencyPolicyView
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy ConcurrencyPolicyView
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic

instance ToSchema BatchDeleteRequest where declareNamedSchema :: Proxy BatchDeleteRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy BatchDeleteRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema BatchDeleteResponse where declareNamedSchema :: Proxy BatchDeleteResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy BatchDeleteResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema BatchRetryRequest where declareNamedSchema :: Proxy BatchRetryRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy BatchRetryRequest -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema BatchRetryResponse where declareNamedSchema :: Proxy BatchRetryResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy BatchRetryResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema StatsResponse where declareNamedSchema :: Proxy StatsResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy StatsResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema AllStatsResponse where declareNamedSchema :: Proxy AllStatsResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy AllStatsResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema QueuesResponse where declareNamedSchema :: Proxy QueuesResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy QueuesResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema CronSchedulesResponse where declareNamedSchema :: Proxy CronSchedulesResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy CronSchedulesResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema WorkersResponse where declareNamedSchema :: Proxy WorkersResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy WorkersResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema RateLimitPoliciesResponse where declareNamedSchema :: Proxy RateLimitPoliciesResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy RateLimitPoliciesResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema RateLimitBucketsResponse where declareNamedSchema :: Proxy RateLimitBucketsResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Text
-> Proxy RateLimitBucketsResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
"RateLimitBucketsResponse"
instance ToSchema RateLimitResetResponse where declareNamedSchema :: Proxy RateLimitResetResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy RateLimitResetResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema ConcurrencyPoliciesResponse where declareNamedSchema :: Proxy ConcurrencyPoliciesResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy ConcurrencyPoliciesResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema ConcurrencyKeysResponse where declareNamedSchema :: Proxy ConcurrencyKeysResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Text
-> Proxy ConcurrencyKeysResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
"ConcurrencyKeysResponse"
instance ToSchema ConcurrencyReconcileResponse where declareNamedSchema :: Proxy ConcurrencyReconcileResponse
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy ConcurrencyReconcileResponse
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema HealthResponse where declareNamedSchema :: Proxy HealthResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy HealthResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema LivenessResponse where declareNamedSchema :: Proxy LivenessResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy LivenessResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema RescheduleRequest where declareNamedSchema :: Proxy RescheduleRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy RescheduleRequest -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema DLQRetentionRequest where declareNamedSchema :: Proxy DLQRetentionRequest
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy DLQRetentionRequest
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema AddTokensResponse where declareNamedSchema :: Proxy AddTokensResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy AddTokensResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic
instance ToSchema PruneResponse where declareNamedSchema :: Proxy PruneResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy PruneResponse -> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Proxy a -> Declare (Definitions Schema) NamedSchema
generic

instance ToSchema GroupsResponse where
  declareNamedSchema :: Proxy GroupsResponse -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy GroupsResponse
_ = Text
-> Fields GroupsResponse
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"GroupsResponse" (forall a. ToSchema [a] => Fields (Page a)
pageFields @GroupSummary)

-- | The keys every paged response shares.
pageFields :: forall a. (ToSchema [a]) => Fields (Page a)
pageFields :: forall a. ToSchema [a] => Fields (Page a)
pageFields = [a] -> HttpStatusCode -> HttpStatusCode -> HttpStatusCode -> Page a
forall a.
[a] -> HttpStatusCode -> HttpStatusCode -> HttpStatusCode -> Page a
Page ([a]
 -> HttpStatusCode -> HttpStatusCode -> HttpStatusCode -> Page a)
-> Fields [a]
-> Fields
     (HttpStatusCode -> HttpStatusCode -> HttpStatusCode -> Page a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @[a] Text
"items" Fields
  (HttpStatusCode -> HttpStatusCode -> HttpStatusCode -> Page a)
-> Fields HttpStatusCode
-> Fields (HttpStatusCode -> HttpStatusCode -> Page a)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int Text
"total" Fields (HttpStatusCode -> HttpStatusCode -> Page a)
-> Fields HttpStatusCode -> Fields (HttpStatusCode -> Page a)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int Text
"offset" Fields (HttpStatusCode -> Page a)
-> Fields HttpStatusCode -> Fields (Page a)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @Int Text
"limit"

instance (ToSchema payload) => ToSchema (JobsResponse payload) where
  declareNamedSchema :: Proxy (JobsResponse payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (JobsResponse payload)
_ =
    forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload
      (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> Fields (JobsResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"JobsResponse"
      (Fields (JobsResponse payload)
 -> Declare (Definitions Schema) NamedSchema)
-> Fields (JobsResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ forall payload.
Page (ApiJobWithStatus (Stored payload))
-> Map Int64 Int64
-> [Int64]
-> Map Int64 Int64
-> JobsResponse payload
JobsResponse @payload
        (Page (ApiJobWithStatus (Stored payload))
 -> Map Int64 Int64
 -> [Int64]
 -> Map Int64 Int64
 -> JobsResponse payload)
-> Fields (Page (ApiJobWithStatus (Stored payload)))
-> Fields
     (Map Int64 Int64
      -> [Int64] -> Map Int64 Int64 -> JobsResponse payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fields (Page (ApiJobWithStatus (Stored payload)))
forall a. ToSchema [a] => Fields (Page a)
pageFields
        Fields
  (Map Int64 Int64
   -> [Int64] -> Map Int64 Int64 -> JobsResponse payload)
-> Fields (Map Int64 Int64)
-> Fields ([Int64] -> Map Int64 Int64 -> JobsResponse payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @(Map Int64 Int64) Text
"childCounts"
        Fields ([Int64] -> Map Int64 Int64 -> JobsResponse payload)
-> Fields [Int64]
-> Fields (Map Int64 Int64 -> JobsResponse payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @[Int64] Text
"pausedParents"
        Fields (Map Int64 Int64 -> JobsResponse payload)
-> Fields (Map Int64 Int64) -> Fields (JobsResponse payload)
forall a b. Fields (a -> b) -> Fields a -> Fields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ToSchema a => Text -> Fields (NotMaybe a)
prop @(Map Int64 Int64) Text
"dlqChildCounts"

instance (ToSchema payload) => ToSchema (JobResponse (JobRead payload)) where
  declareNamedSchema :: Proxy (JobResponse (JobRead payload))
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> (Proxy (JobResponse (JobRead payload))
    -> Declare (Definitions Schema) NamedSchema)
-> Proxy (JobResponse (JobRead payload))
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Proxy (JobResponse (JobRead payload))
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
"JobResponse"

instance (ToSchema payload) => ToSchema (ClaimResponse payload) where
  declareNamedSchema :: Proxy (ClaimResponse payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> (Proxy (ClaimResponse payload)
    -> Declare (Definitions Schema) NamedSchema)
-> Proxy (ClaimResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Proxy (ClaimResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
"ClaimResponse"

instance (ToSchema payload) => ToSchema (JobResponse (ApiJobWithStatus payload)) where
  declareNamedSchema :: Proxy (JobResponse (ApiJobWithStatus payload))
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> (Proxy (JobResponse (ApiJobWithStatus payload))
    -> Declare (Definitions Schema) NamedSchema)
-> Proxy (JobResponse (ApiJobWithStatus payload))
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Proxy (JobResponse (ApiJobWithStatus payload))
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
"JobWithStatusResponse"

instance (ToSchema payload) => ToSchema (BatchInsertRequest payload) where
  declareNamedSchema :: Proxy (BatchInsertRequest payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> (Proxy (BatchInsertRequest payload)
    -> Declare (Definitions Schema) NamedSchema)
-> Proxy (BatchInsertRequest payload)
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Proxy (BatchInsertRequest payload)
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
"BatchInsertRequest"

instance (ToSchema payload) => ToSchema (BatchInsertResponse payload) where
  declareNamedSchema :: Proxy (BatchInsertResponse payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> (Proxy (BatchInsertResponse payload)
    -> Declare (Definitions Schema) NamedSchema)
-> Proxy (BatchInsertResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Proxy (BatchInsertResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall a.
(GToSchema (Rep a), Generic a, Typeable a) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
renamed Text
"BatchInsertResponse"

instance (ToSchema payload) => ToSchema (DLQResponse payload) where
  declareNamedSchema :: Proxy (DLQResponse payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (DLQResponse payload)
_ = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> Fields (DLQResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"DLQResponse" (forall a. ToSchema [a] => Fields (Page a)
pageFields @(DLQ.DLQJob (Stored payload)))

instance (ToSchema payload) => ToSchema (ArchiveResponse payload) where
  declareNamedSchema :: Proxy (ArchiveResponse payload)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (ArchiveResponse payload)
_ = forall payload.
ToSchema payload =>
Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
carrying @payload (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Text
-> Fields (ArchiveResponse payload)
-> Declare (Definitions Schema) NamedSchema
forall {k} (a :: k).
Text -> Fields a -> Declare (Definitions Schema) NamedSchema
closedSchema Text
"ArchiveResponse" (forall a. ToSchema [a] => Fields (Page a)
pageFields @(Archive.ArchiveJob (Stored payload)))